Simpler implementation

[Andre van Tonder <andre@xxxxxxxxxxxxx>]

Inspired by Eli Barzilay's solutions, here is a simpler box-less 
implementation that should have much better performance than the reference 
implementation.

This implementation is still pretty much a verbatim statement of "naive graph 
reduction" as discussed, e.g., in the reference by Richard Jones in srfi-45, 
which is formally known to be safe for space.

I give two equivalent versions of it.  I find the first on more readable.  The 
second one uses a representation similar to Eli Barzilay's and is a little more 
concise.

 Version 1:
 ==========

;; <promise> ::= (lazy   . <thunk of promise>)    (delayed promise)
;;             | (value  . <object>)              (forced  promise)
;;             | (shared . <promise>)             (shared  promise)

(define-syntax lazy
  (syntax-rules ()
    ((lazy exp)
     (cons 'lazy (lambda () exp)))))

(define-syntax delay
  (syntax-rules ()
    ((delay exp) (lazy (cons 'value exp)))))

(define (force promise)
  (case (car promise)
    ((lazy)   (let ((promise* ((cdr promise))))
                (if (not (eq? (car promise) 'value))
                    (begin (set-car! promise (car promise*))
                           (set-cdr! promise (cdr promise*))
                           (set-car! promise* 'shared)
                           (set-cdr! promise* promise)))
                (force promise)))
    ((value)  (cdr promise))
    ((shared) (force (cdr promise)))
    (else (error "Not a promise"))))

This version can be spoofed, but it is obvious how to either convert it
to using unique tags or to using a record type.

 Version 2:
 ==========

;; <promise> ::= (make-promise <thunk of promise>)   (delayed promise)
;;             | (make-promise (list <object>))      (forced  promise)
;;             | (make-promise <promise>)            (shared  promise)

(define-struct promise (p))

(define-syntax lazy
  (syntax-rules ()
    ((lazy exp)
     (make-promise (lambda () exp)))))

(define-syntax delay
  (syntax-rules ()
    ((delay exp) (lazy (make-promise (list exp))))))

(define (force promise)
  (let ((p (promise-p promise)))
    (cond ((procedure? p) (let ((promise* (p)))
                            (if (not (pair? (promise-p promise)))
                                (begin (set-promise-p! promise (promise-p promise*))
                                       (set-promise-p! promise* promise)))
                            (force promise)))
          ((pair? p)      (car p))
          ((promise? p)   (force p))
          (else           (error "Not a promise")))))

Andre