;; -----------------------------------------------------------------
;; EVEN stream
(define-module stream
  (export stream-null?
          stream-cons
          stream-car
          stream-cdr
          stream-ref
          stream-define
          list->stream
          port->stream
          stream-iterate
          stream-map
          stream-for-each
          stream-filter
          stream-from
          stream-from-to
          stream-take
          stream->list
          stream-cutoff)

  (define stream-null (delay '()))

  (define (stream-null? strm)
    (null? (force strm)))

  (define-syntax stream-cons
    (syntax-rules ()
      ((_ car cdr) (delay (cons car cdr)))))

  (define (stream-car strm)
    (car (force strm)))

  (define (stream-cdr strm)
    (cdr (force strm)))

  (define (stream-ref strm n)
    (if (zero? n)
        (stream-car strm)
        (stream-ref (stream-cdr strm) (- n 1))))

  ;; All functions returning streams must use this lingo:
  ;; (define (stream-fn strm)
  ;;   (delay (force
  ;;      ...)))
  ;; Encapsulate this with syntax:
  (define-syntax stream-define
    (syntax-rules ()
      ((stream-define (name args ...)
                      body0 body1 ...)
       (define (name args ...)
         (delay (force
                 (begin body0 body1 ...)))))))

  (stream-define (list->stream lst)
                 (let loop ((lst lst))
                   (if (null? lst)
                       stream-null
                       (stream-cons (car lst) (loop (cdr lst))))))

  ;; stream of objects returned by reader from port (from srfi-40)
  (stream-define (port->stream reader port)
                 (let ((obj (reader port)))
                   (if (eof-object? obj)
                       stream-null
                       (stream-cons obj (port->stream reader port)))))

  ;; FIXME needs stream-define enhancement
;;   (stream-define (stream-repeat objs)
;;                  (if (null? objs)
;;                      stream-null
;;                      (stream-cons (car objs)
;;                                   (apply stream-repeat
;;                                          (append (cdr objs)
;;                                                  (list (car objs)))))))

  (stream-define (stream-iterate proc obj)
                 (stream-cons obj (stream-iterate proc (proc obj))))

  ;; map only one stream
  (stream-define (stream-map func strm)
                 (if (stream-null? strm)
                     stream-null
                     (stream-cons
                      (func (stream-car strm))
                      (stream-map func (stream-cdr strm)))))

;; non-stream implementation for multiple map
;; (define (map. fn first . lists)
;;   (if (null? lists)
;;       (map1 fn first)
;;       (map2+ fn (cons first lists))))
;;
;; (define (map1 fn xs)
;;   (cond ((null? xs) '())
;;         (else (cons (fn (car xs))
;;                     (map1 fn (cdr xs))))))
;;
;; (define (map2+ fn lists)
;;   (cond ((member '() lists) '())
;;         (else (cons (apply fn (map1 car lists))
;;                     (map2+ fn (map1 cdr lists))))))

;;   ;; ANY pred? list -- first non-#f (pred? list-item), else #f
;;   (define (any pred? lst)
;;     (cond ((null? lst) #f)
;;           ((null? (cdr lst)) (pred? (car lst)))
;;           (else (or (pred? (car lst)) (any pred? (cdr lst))))))
;;
;;   ;; ALL pred? list -- #f if any (pred? list-item) is #f, or last pred?
;;   (define (all pred? lst)
;;     (cond ((null? lst) #t)
;;           ((null? (cdr lst)) (pred? (car lst)))
;;           (else (and (pred? (car lst)) (all pred? (cdr lst))))))
;;
;;   ;; map multiple streams FIXME not working; see srfi-40.scm
;;   (define (stream-map-multiple func . strms)
;;     (delay (force
;;             (let loop ((strms strms))
;;               (when (not (any stream-null? strms))
;;                 (apply func (map stream-car strms))
;;                 (loop (map stream-cdr strms)))))))

  (define (stream-for-each proc strm)
    (if (stream-null? strm)
        'done
        (begin (proc (stream-car strm))
               (stream-for-each proc (stream-cdr strm)))))

  (stream-define (stream-filter pred stream)
                 (cond ((stream-null? stream) stream-null)
                       ((pred (stream-car stream))
                        (stream-cons (stream-car stream)
                                     (stream-filter pred
                                                    (stream-cdr stream))))
                       (else (stream-filter pred (stream-cdr stream)))))

  (stream-define (stream-from start)
                 (stream-cons start (stream-from (+ start 1))))

  (stream-define (stream-from-to low high)
                 (if (> low high)
                     stream-null
                     (stream-cons
                      low
                      (stream-from-to (+ low 1) high))))

  (stream-define (stream-take n stream)
                 (if (or (stream-null? stream) (zero? n))
                     stream-null
                     (stream-cons (stream-car stream)
                                  (stream-take (- n 1) (stream-cdr stream)))))

  (define (stream->list stream)
    (let loop ((s stream))
      (if (stream-null? s)
          '()
          (cons (stream-car s)
                (loop (stream-cdr s))))))

  (define (stream-cutoff n strm)
    (cond
     ((zero? n) '())
     ((stream-null? strm) '())
     (else (cons (stream-car strm)
                 (stream-cutoff (- n 1) (stream-cdr strm)))))))