Source

lazy-seq / lazy-seq.scm

Full commit
(module lazy-seq

(lazy-seq make-lazy-seq
 lazy-seq? lazy-seq-realized?
 lazy-null lazy-null?
 lazy-seq->list list->lazy-seq
 lazy-head lazy-tail
 lazy-take lazy-drop lazy-ref
 lazy-map lazy-filter
 lazy-numbers



 realized-lazy-seq)

(import chicken scheme)
(use srfi-1)

(define-record lazy-seq
  body value)

(define %make-lazy-seq
  make-lazy-seq)

(define lazy-null
  (let ((null (%make-lazy-seq #f #f)))
    (lazy-seq-value-set! null null)
    null))

(define (lazy-null? seq)
  (eq? lazy-null (realized-lazy-seq seq)))

(define (make-lazy-seq body)
  (%make-lazy-seq body #f))

(define-syntax lazy-seq
  (syntax-rules ()
    ((_ body ...)
     (make-lazy-seq
      (lambda () body ...)))))

(define-record-printer (lazy-seq seq out)
  (display "#<lazy-" out)
  (if (lazy-null? seq)
      (display "null>" out)
      (fprintf out "seq ~S ...>" (lazy-head seq))))

(define (lazy-seq-realized? seq)
  (not (lazy-seq-body seq)))

(define (realized-lazy-seq seq)
  (or (lazy-seq-value seq)
      (and-let* ((body (lazy-seq-body seq)))
        (let loop ((value (body)))
          (lazy-seq-body-set! seq #f)
          (if (and (lazy-seq? value) (not (eq? lazy-null value)))
              (loop (realized-lazy-seq value))
              (begin
                (lazy-seq-value-set! seq value)
                value))))))

(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)
  (lazy-seq
    (if (or (zero? n) (lazy-null? seq))
        lazy-null
        (cons (lazy-head seq)
              (lazy-take (- n 1) (lazy-tail seq))))))

(define (lazy-drop n seq)
  (lazy-seq
    (let loop ((n n) (seq seq))
      (if (or (zero? n) (lazy-null? seq))
          seq
          (loop (- n 1) (lazy-tail seq))))))

(define (lazy-numbers #!key (step 1) (start 0) count)
  (if (and count (zero? count))
      lazy-null
      (lazy-seq
        (cons start
              (lazy-numbers count: (and count (- count 1))
                            start: (+ start step)
                            step:  step)))))

(define (lazy-map proc . seqs)
  (lazy-seq
    (if (any lazy-null? seqs)
        lazy-null
        (cons (apply proc (map lazy-head seqs))
              (apply lazy-map proc (map lazy-tail seqs))))))

(define (lazy-filter pred? seq)
  (lazy-seq
    (cond ((lazy-null? seq)
           lazy-null)
          ((pred? (lazy-head seq))
           (cons (lazy-head seq)
                 (lazy-filter pred? (lazy-tail seq))))
          (else (lazy-filter pred? (lazy-tail seq))))))

(define (lazy-ref n seq)
  (if (zero? n)
      (lazy-head seq)
      (lazy-ref (- n 1) (lazy-tail seq))))

)