Commits

Moritz Heidkamp  committed 88390cd

Initial commit

  • Participants

Comments (0)

Files changed (4)

File lazy-seq.meta

+((synopsis "Clojure-like lazy sequences")
+ (author "Moritz Heidkamp")
+ (category data)
+ (license "BSD")
+ (test-depends test))

File lazy-seq.scm

+(module lazy-seq
+
+(lazy-seq make-lazy-seq
+ lazy-seq? lazy-seq-realized?
+ lazy-null lazy-null?
+ lazy-head lazy-tail
+ lazy-take lazy-drop lazy-iota
+ lazy-seq->list list->lazy-seq)
+
+(import chicken scheme)
+
+(define-record lazy-seq
+  body value)
+
+(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 '()))
+
+(define-syntax lazy-seq
+  (syntax-rules ()
+    ((_ body ...)
+     (make-lazy-seq
+      (lambda () body ...)))))
+
+(define (lazy-seq-realized? seq)
+  (pair? (lazy-seq-value 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))
+
+(define (lazy-head seq)
+  (car (realized-lazy-seq seq)))
+
+(define (lazy-tail seq)
+  (cdr (realized-lazy-seq seq)))
+
+(define (lazy-seq->list seq)
+  (if (lazy-null? seq)
+      '()
+      (cons (lazy-head seq)
+            (lazy-seq->list
+             (lazy-tail seq)))))
+
+(define (list->lazy-seq list)
+  (if (null? list)
+      lazy-null
+      (%make-lazy-seq
+       #f (cons (car list)
+                (list->lazy-seq (cdr list))))))
+
+(define (lazy-take n seq)
+  (if (or (zero? n) (lazy-null? seq))
+      lazy-null
+      (lazy-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))))
+
+(define (lazy-iota count #!optional (start 0) (step 1))
+  (if (zero? count)
+      lazy-null
+      (lazy-seq
+        (cons start
+              (lazy-iota (- count 1)
+                         (+ start step)
+                         step)))))
+
+)

File lazy-seq.setup

+(compile -d0 -O2 -J -s "lazy-seq.scm")
+(compile -d0 -O2 -s "lazy-seq.import.scm")
+
+(install-extension
+ 'lazy-seq
+ '("lazy-seq.so" "lazy-seq.import.so")
+ '((version "0.0.1")))

File tests/run.scm

+(load-relative "../lazy-seq")
+(import lazy-seq)
+(use test)
+
+(test-group "custom lazy-seq"
+  (define calls 0)
+
+  (define natural-numbers
+    (case-lambda
+     (()  (natural-numbers 0))
+     ((n) (lazy-seq
+            (set! calls (+ calls 1))
+            (cons n (natural-numbers (+ n 1)))))))
+
+  (define first-three
+    (lazy-seq->list (lazy-take 3 (natural-numbers))))
+
+  (test first-three '(0 1 2))
+  (test calls 3))
+
+(test-group "lazy-seq-realized?"
+  (define even-numbers (lazy-iota 10000000 0 2))
+  (test-assert (not (lazy-seq-realized? even-numbers)))
+  (test 0 (lazy-head even-numbers))
+  (test-assert (lazy-seq-realized? even-numbers))
+  (test-assert (not (lazy-seq-realized? (lazy-tail even-numbers))))
+  (test 2 (lazy-head (lazy-tail even-numbers))))
+
+(test-group "list->lazy-seq"
+  (define seq
+    (list->lazy-seq '("foo" "bar")))
+
+  (test-assert (lazy-seq? seq))
+  (test-assert (lazy-seq-realized? seq))
+  (test '("foo" "bar") (lazy-seq->list seq))
+  (test-assert (lazy-null? (lazy-tail (lazy-tail seq)))))