diff -Naur old/srfi-40-base.scm new/srfi-40-base.scm
--- old/srfi-40-base.scm	2004-05-09 17:00:44.000000000 -0500
+++ new/srfi-40-base.scm	2004-07-02 12:34:08.000000000 -0500
@@ -2,6 +2,7 @@
 ;;;
 ;;; Based on the original SRFI 40 reference implementation by Philip
 ;;; L. Bewig and Andre von Tonder, modified for Chicken by Category 5.
+;;; Some fixes were applied by Alejandro Forero Cuervo.
 ;;;
 ;;; 29 December 2003  catfive/chaosnet.org
 
@@ -15,7 +16,7 @@
   (usual-integrations)
   (export stream-low-level-strict
 	  stream-low-level-delay stream-low-level-lazy stream-cons
-	  stream-delay
+	  stream-delay stream-error
           make-stream stream? stream-promise stream-null stream-null?
           stream-pair? stream-car stream-cdr stream stream-unfoldn
           stream-map stream-for-each stream-filter))
@@ -48,6 +49,10 @@
   (lambda (s)
     (##sys#check-structure s 'stream)
     (##sys#slot s 1)))
+(define stream-promise-set!
+  (lambda (s n)
+    (##sys#check-structure s 'stream)
+    (##sys#setslot s 1 n)))
 
 ;;; UTILITY FUNCTIONS
 
@@ -71,23 +76,31 @@
         ((null? (cdr lst)) (pred? (car lst)))
         (else (and (pred? (car lst)) (all pred? (cdr lst))))))
 
+(define box vector)
+(define (unbox s) (##sys#slot s 0))
+(define (set-box! s v) (##sys#setslot s 0 v))
 
 ;;; LOW-LEVEL STREAM FUNCTIONS by Andre von Tonder (private e-mail 13-SEP-2003)
 
+; Corrected by Alejandro Forero Cuervo, according to mail from 12 Jun 2004,
+; Message-ID: address@hidden
 
 ;; STREAM-LOW-LEVEL-STRICT -- make a value into a low-level promise
 (define (stream-low-level-strict x)
-  (make-stream (cons 'value x)))
-
+  (make-stream (box (cons 'value x))))
 
 ;; STREAM-LOW-LEVEL-FORCE -- force the value from a low-level promise
-(define (stream-low-level-force prom)
-    (case (car prom)
-      ((value)      (cdr prom))
-      ((suspension) (let ((val (stream-promise ((cdr prom)))))
-                      (set-car! prom (car val))
-                      (set-cdr! prom (cdr val))
-                      (stream-low-level-force prom)))))
+(define (stream-low-level-force promise)
+  (let ((content (unbox (stream-promise promise))))
+    (case (car content)
+      ((value)      (cdr content))
+      ((suspension) (let ((promise* ((cdr content)))
+                          (content (unbox (stream-promise promise))))
+                      (when (not (eqv? (car content) 'value))
+                        (set-box! (stream-promise promise) (unbox (stream-promise promise*)))
+                        (stream-promise-set! promise* (stream-promise promise)))
+                      (stream-low-level-force promise))))))
+
 
 ;;; STREAM SYNTAX AND FUNCTIONS
 
@@ -99,23 +112,23 @@
 
 ;; STREAM-NULL? object -- #t if object is the null stream, #f otherwise
 (define (stream-null? obj)
-  (and (stream? obj) (null? (stream-low-level-force (stream-promise obj)))))
+  (and (stream? obj) (null? (stream-low-level-force obj))))
 
 ;; STREAM-PAIR? object -- #t if object is a non-null stream, #f otherwise
 (define (stream-pair? obj)
-  (and (stream? obj) (not (null? (stream-low-level-force (stream-promise obj))))))
+  (and (stream? obj) (not (null? (stream-low-level-force obj)))))
 
 ;; STREAM-CAR stream -- first element of stream
 (define (stream-car strm)
   (cond ((not (stream? strm)) (stream-error "attempt to take stream-car of non-stream"))
         ((stream-null? strm) (stream-error "attempt to take stream-car of null stream"))
-        (else (car (stream-low-level-force (stream-promise strm))))))
+        (else (car (stream-low-level-force strm)))))
 
 ;; STREAM-CDR stream -- remaining elements of stream after first
 (define (stream-cdr strm)
   (cond ((not (stream? strm)) (stream-error "attempt to take stream-cdr of non-stream"))
         ((stream-null? strm) (stream-error "attempt to take stream-cdr of null stream"))
-        (else (cdr (stream-low-level-force (stream-promise strm))))))
+        (else (cdr (stream-low-level-force strm)))))
 
 ;; STREAM-DELAY object -- the essential stream mechanism
 ;; (moved to srfi-40-syntax.scm)
diff -Naur old/srfi-40.scm new/srfi-40.scm
--- old/srfi-40.scm	2004-05-09 16:55:18.000000000 -0500
+++ new/srfi-40.scm	2004-07-02 11:57:50.000000000 -0500
@@ -13,15 +13,19 @@
 ;;  (syntax-rules ()
 ;;    ((stream-low-level-lazy exp)
 ;;        (cons 'suspension (lambda () exp)))))
+
+; Use vector rather than box to avoid having to export box:
+
 (define-macro stream-low-level-lazy
   (lambda (exp)
-    `(cons 'suspension (lambda () ,exp))))
+    `(vector (cons 'suspension (lambda () ,exp)))))
 
 ;; STREAM-LOW-LEVEL-DELAY -- make an expression into a low-level promise
 ;;(define-syntax stream-low-level-delay
 ;;  (syntax-rules ()
 ;;    ((stream-low-level-delay exp)
 ;;      (stream-low-level-lazy (stream-low-level-strict exp)))))
+
 (define-macro stream-low-level-delay
   (lambda (exp)
     `(stream-low-level-lazy (stream-low-level-strict ,exp))))