scheme + lazy streams?

Застрял с реализацией потоков на схеме :( 

Основные определения у меня такие:

(define-macro (stream-cons p q)
  (let
    ((pv (gensym)) (qv (gensym)))
    `(let
         ((,pv (lambda () ,p)) (,qv (lambda () ,q)))
         (lambda (f) (f ,pv ,qv)))))

(define stream-car
  (lambda (s) (s (lambda (p q) (p)))))

(define stream-cdr
  (lambda (s) (s (lambda (p q) (q)))))

(define stream-for-each
  (lambda (func stream)
    (if (null? stream)
      'done
      (begin
        (func (stream-car stream))
        (stream-for-each func (stream-cdr stream))))))

(частично спер из sicp, частично подогнал под свои нужды). 
Простенький поток типа (define ones (stream-cons 1 ones)) работает
отлично, stream-for-each можно пустить по нему навечно. 
Однако что-нибудь чуток посложнее, почему-то, начинает жрать память:

(define stream-map
  (lambda (func . streams)
    (if (or
          (null? streams)
          (< 0
            (apply +
              (map (lambda (s) (if (null? s) 1 0)) streams))))
      '()
      (stream-cons
        (apply func (map stream-car streams))
        (apply
          stream-map
          (cons func (map stream-cdr streams)))))))

(define nums (stream-cons 1 (stream-map + ones nums)))

или даже

(define number-stream
  (lambda (number) (stream-cons number (number-stream number))))

Стоит пустить по такому потоку stream-for-each, рано или поздно он
сломается от того, что сожрет всю оперативку. 

Второй день уже не могу разобраться. Есть подозрение, что где-то я
скосячил в определениях. Возможно, кто-нибудь сможет мне помочь?