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