trans-id.scm 922 B

12345678910111213141516171819202122232425262728293031323334
  1. ;; This replaces trans-id REF in Reppy's code
  2. (define-synchronized-record-type trans-id :trans-id
  3. (really-make-trans-id thread-cell value)
  4. (value)
  5. trans-id?
  6. (thread-cell trans-id-thread-cell)
  7. (value trans-id-value set-trans-id-value!))
  8. (define (make-trans-id)
  9. (really-make-trans-id (make-cell (current-thread))
  10. #f))
  11. (define (maybe-commit-and-trans-id-value trans-id)
  12. (cond
  13. ((trans-id-value trans-id)
  14. => (lambda (value)
  15. (and (maybe-commit)
  16. value)))
  17. (else
  18. (and (maybe-commit-and-block (trans-id-thread-cell trans-id))
  19. (trans-id-value trans-id)))))
  20. (define (trans-id-set-value! trans-id value)
  21. (cond
  22. ((not value) (error "trans-id value can't be #f" trans-id value))
  23. ((trans-id-value trans-id)
  24. (error "trans-id is already assigned"))
  25. (else
  26. (set-trans-id-value! trans-id value))))
  27. (define (trans-id-cancelled? trans-id)
  28. (and (trans-id-value trans-id) #t))