;;; STREAMS:
;;; ========

(define STREAM-CONS
(mlambda [call]
’[,(arg 1 call) (delay ,(arg 2 call))]))

(set THE-EMPTY-STREAM (lambda [] []))

(define STREAM-FIRST first)
(define STREAM-REST (compose force second))

(define STREAM-NULL
(lambda [s]
(= ↑s ↑the-empty-stream)))

;;; Call by need:

(define MEMO
(lambda [procedure]
(let [[computed $false]
[result "not computed yet"]]
(lambda []
(if computed
result
(begin (set result (procedure))
(set computed $true)
result))))))

(define STREAM-CONS
(mlambda [call]
’[,(arg 1 call) (memo (delay ,(arg 2 call)))]))

(define STREAM-FIRST first)

(define STREAM-REST (compose force second))

;;; Examples:

(set x (stream-1-cons 1 [2 3 4]))

(set y (stream-2-cons (begin (print ps cr "Processing first arg" cr)
10)
(begin (print ps cr "Processing second arg" cr)
[20])))

(stream-2-first y)
(stream-2-first y)
(stream-2-rest y)
(stream-2-rest y)

(define FRINGE
(object [seq]
[]
[next (lambda []
(let [[nexts (first-leaf seq [])]]
(set seq (second nexts))
(first nexts)))]
[fringe-null (lambda [] (null-tree seq))]))

(define FIRST-LEAF
(lambda [seq residue]
(cond [(leaf seq) [seq residue]]
[(null seq)
(if (null residue)
(error "Leaf of a null sequence?" ↑seq)
(first-leaf (first residue) (rest residue)))]
[$t (first-leaf (first seq)
(if (null residue)
(rest seq)
(cons (rest seq) residue)))])))

(define LEAF
(lambda [e]
(not (or (sequence e) (rail e)))))

(define NULL-TREE
(lambda [tree]
(and (not (leaf tree))
(or (null tree)
(and (null-tree (first tree))
(null-tree (rest tree)))))))

;;; More modularly:

(letrec
[[FIRST-LEAF
(lambda [seq residue]
(cond [(leaf seq) [seq residue]]
[(null seq)
(if (null residue)
(error "Leaf of a null sequence?" ↑seq)
(first-leaf (first residue) (rest residue)))]
[$t (first-leaf (first seq)
(if (null residue)
(rest seq)
(cons (rest seq) residue)))]))]
[NULL-TREE (lambda [tree]
(and (not (leaf tree))
(or (null tree)
(and (null-tree (first tree))
(null-tree (rest tree))))))]]
(define FRINGE
(object [seq]
[]
[next (lambda []
(let [[nexts (first-leaf seq [])]]
(set seq (second nexts))
(first nexts)))]
[fringe-null (lambda [] (null-tree seq))])))

(define LEAF
(lambda [e]
(not (or (sequence e) (rail e)))))

(define SAME-FRINGE
(letrec [[helper
(lambda [f1 f2]
(cond [(fringe-null f1) (fringe-null f2)]
[(= (next f1) (next f2))
(helper f1 f2)]
[$true $false]))]]
(lambda [t1 t2]
(helper (fringe t1) (fringe t2)))))

(define FRINGE*
(lambda [x]
(if (leaf x)
[x]
(mappend fringe* x))))

(define SAME-FRINGE*
(lambda [t1 t2]
(= (fringe* t1) (fringe* t2))))

(set f1 (fringe [[[[1]]] [[[2]]] [3 4 5]]))
(set f2 (fringe [1 2 3 [4 5]]))

(set t1 [2 [[[[[[[[[[[[[[[[[[[[4 5]]]]]]]]]]]]]]]]]]]]])
(set t2 [3 [[[[[[[[[[[[[[[[[[[[4 5]]]]]]]]]]]]]]]]]]]]])

(define INFINITE-SEQUENCE
(object [initial function incrementer]
[[current initial]]
[next (lambda []
(let [[answer (function current)]]
(set current (incrementer current))
answer))]
[re-initialize (lambda args
(if (not (null args))
(set initial (first args)))
(set current initial))]))

(set s1 (infinite-sequence 1 (lambda [n] (* n n)) 1+))
(set s2 (infinite-sequence 1 (lambda [n] (* n 2)) 1+))
(set s3 (infinite-sequence 1 (lambda [n] (+ n n)) 1+))

(define STREAM-=
(lambda [s1 s2]
(and (= (next s1) (next s2))
(stream-= s1 s2))))

;;; note the side-effect on the streams!

-- catch/throw
-- delay/force (with memo’izing)
-- co-routines (same-fringe)
-- introduces multi-processing.
-- input/output (interactions)