; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.

; Promises, promises.

(define-syntax delay
  (syntax-rules ()
    ((delay ?exp) (make-promise (lambda () ?exp)))))

; A slightly modified copy of the code from R4RS; the modification ensures
; that the thunk is GC'ed after the promise is evaluted.
; JAR writes: "It is not for us to judge the wisdom of the new definition."

(define (make-promise thunk-then-result)
  (let ((already-run? #f))
    (lambda ()
      (if already-run?                         ; can't be interrupted from now
	  thunk-then-result
	  (let ((result (thunk-then-result)))  ; until after this call
	    (cond ((not already-run?)
		   (set! already-run? #t)
		   (set! thunk-then-result result)))
	    thunk-then-result)))))

(define (force promise)
  (promise))
