trans-id.scm 1.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Mike Sperber
  3. ;; This replaces trans-id REF in Reppy's code
  4. (define-synchronized-record-type trans-id :trans-id
  5. (really-make-trans-id thread-cell value)
  6. (value)
  7. trans-id?
  8. (thread-cell trans-id-thread-cell)
  9. (value trans-id-value set-trans-id-value!))
  10. (define (make-trans-id)
  11. (really-make-trans-id (make-cell (current-thread))
  12. #f))
  13. (define (maybe-commit-and-trans-id-value trans-id)
  14. (cond
  15. ((trans-id-value trans-id)
  16. => (lambda (value)
  17. (and (maybe-commit)
  18. value)))
  19. (else
  20. (and (maybe-commit-and-block (trans-id-thread-cell trans-id))
  21. (trans-id-value trans-id)))))
  22. (define (trans-id-set-value! trans-id value)
  23. (cond
  24. ((not value)
  25. (assertion-violation 'trans-id-set-value! "trans-id value can't be #f"
  26. trans-id value))
  27. ((trans-id-value trans-id)
  28. (assertion-violation 'trans-id-set-value! "trans-id is already assigned"
  29. trans-id value))
  30. (else
  31. (set-trans-id-value! trans-id value)) ))
  32. (define (trans-id-cancelled? trans-id)
  33. (and (trans-id-value trans-id) #t))