Commits

Moritz Heidkamp  committed c239963

Replace lazy-null with regular null

  • Participants
  • Parent commits c8c4fc2

Comments (0)

Files changed (2)

File lazy-seq.scm

  lazy-head lazy-tail
  lazy-take lazy-drop lazy-ref
  lazy-map lazy-filter
- lazy-numbers)
+ lazy-numbers
+ realized-lazy-seq)
 
 (import chicken scheme)
 (use srfi-1)
 (define %make-lazy-seq
   make-lazy-seq)
 
-(define lazy-null
-  (%make-lazy-seq #f '()))
-
-(define (lazy-null? seq)
-  (eq? lazy-null seq))
-
 (define (make-lazy-seq body)
-  (%make-lazy-seq body '()))
+  (%make-lazy-seq body #f))
 
 (define-syntax lazy-seq
   (syntax-rules ()
      (make-lazy-seq
       (lambda () body ...)))))
 
+(define-record-printer (lazy-seq seq out)
+  (display "#<lazy-" out)
+  (cond ((lazy-null? seq)
+         (display "null>" out))
+        ((lazy-seq-realized? seq)
+         (display "seq ...>" out))
+        (else
+         (fprintf out "seq ~S ...>" (lazy-head seq)))))
+
 (define (lazy-seq-realized? seq)
-  (pair? (lazy-seq-value seq)))
+  (not (lazy-seq-body seq)))
+
+(define lazy-null
+  (%make-lazy-seq #f '()))
+
+(define (lazy-null? seq)
+  (null? (realized-lazy-seq seq)))
 
 (define (realized-lazy-seq seq)
-  (and-let* ((body (lazy-seq-body seq)))
-    (lazy-seq-value-set! seq (body))
-    (lazy-seq-body-set! seq #f))
-  (lazy-seq-value seq))
+  (or (lazy-seq-value seq)
+      (let* ((body (lazy-seq-body seq))
+             (value (body)))
+        (lazy-seq-body-set! seq #f)
+        (let loop ((value value))
+          (if (or (null? value) (pair? value))
+              (begin
+                (lazy-seq-value-set! seq value)
+                value)
+              (loop (realized-lazy-seq value)))))))
 
 (define (lazy-head seq)
   (car (realized-lazy-seq seq)))
                 (list->lazy-seq (cdr list))))))
 
 (define (lazy-take n seq)
-  (if (or (zero? n) (lazy-null? seq))
-      lazy-null
-      (lazy-seq
+  (lazy-seq
+    (if (or (zero? n) (lazy-null? seq))
+        '()
         (cons (lazy-head seq)
               (lazy-take (- n 1) (lazy-tail seq))))))
 
 (define (lazy-drop n seq)
-  (if (or (zero? n) (lazy-null? seq))
-      seq
-      (lazy-drop (- n 1) (lazy-tail seq))))
+
+  ;; (lazy-seq
+  ;;   (let loop ((n n) (seq seq))
+  ;;     (if (or (zero? n) (lazy-null? seq))
+  ;;         seq
+  ;;         (loop (- n 1) (lazy-tail seq)))))
+
+  (lazy-seq
+    (if (or (zero? n) (lazy-null? seq))
+        seq
+        (lazy-drop (- n 1) (lazy-tail seq)))))
 
 (define (lazy-numbers #!key (step 1) (start 0) count)
-  (if (and count (zero? count))
-      lazy-null
-      (lazy-seq
+  (lazy-seq
+    (if (and count (zero? count))
+        '()
         (cons start
               (lazy-numbers count: (and count (- count 1))
                             start: (+ start step)
                             step:  step)))))
 
 (define (lazy-map proc . seqs)
-  (if (any lazy-null? seqs)
-      lazy-null
-      (lazy-seq
+  (lazy-seq
+    (if (any lazy-null? seqs)
+        '()
         (cons (apply proc (map lazy-head seqs))
               (apply lazy-map proc (map lazy-tail seqs))))))
 
 (define (lazy-filter pred? seq)
-  (if (lazy-null? seq)
-      lazy-null
-      (lazy-seq
-        (let loop ((seq seq))
-          (cond ((lazy-null? seq)
-                 lazy-null)
-                ((pred? (lazy-head seq))
-                 (cons (lazy-head seq)
-                       (lazy-filter pred? (lazy-tail seq))))
-                (else (loop (lazy-tail seq))))))))
+  (lazy-seq
+    (if (lazy-null? seq)
+        '()
+        (let ((head (lazy-head seq))
+              (tail (lazy-filter pred? (lazy-tail seq))))
+          (if (pred? head)
+              (cons head tail)
+              tail)))))
 
 (define (lazy-ref n seq)
-  (lazy-head (lazy-drop n seq)))
+  (if (zero? n)
+      (lazy-head seq)
+      (lazy-ref (- n 1) (lazy-tail seq))))
 
 )

File tests/run.scm

         (lazy-seq->list
          (lazy-take 5 (lazy-filter
                        (lambda (x) (zero? (modulo x 2)))
-                       (lazy-numbers start: 2 step: 3))))))
+                       (lazy-numbers start: 2 step: 3)))))
+  (test '(2) (lazy-seq->list
+              (lazy-filter (lambda (x) (= x 2))
+                           (lazy-numbers count: 10)))))
 
 
 (test-group "lazy-ref"