(* Author: Carsten Schuermann *)
(* Streams *)

datatype 'a stream = Stream of unit -> 'a front
and 'a front = Empty | Cons of 'a * 'a stream

(* Two basic operations
   1. delay evaluation the tail of a stream 
   2. expose the head of a stream *)  
fun delay (d) = Stream(d)
fun expose (Stream(d)) = d ()

(* take n s = l 

   Invariant:
   l is a list of the first n objects in stream s   
*)
fun take  0 _ = []
  | take  n s = take' n (expose s)   
and take' n (Cons (x, s')) = x :: take (n-1) s' 


(* mkStream l = s 

   Invariant:
   If   l = [x0, x1, ... xn] is a list 
   then s = x0, x1 ... xn    is a finite stream 
*)
fun mkStream l = delay (fn () => mkStream' l)
and mkStream' [] = Empty
  | mkStream' (a :: l) = Cons (a, mkStream l)

(* zip f s1 s2 = s3 
  
   Invariant:
   If   s1 = x0, x1, x2 ...
   and  s2 = y0, y1, y2 ...
   then s3 = (f x0 y0), (f x1 y1), (f x2y2) ...
*)
fun zip f s1 s2 = delay (fn () => zip' f (expose s1) (expose s2) ())
and zip' f (Cons (x1, s1')) (Cons (x2, s2')) () = 
    Cons (f x1 x2, zip f s1' s2')

(* tail s = s' 
  
   Invariant:
   If   s1 = x0, x1, x2 ...
   then s' = x1, x2 ...
*)
fun tail s = tail' (expose s)
and tail' (Cons (x, s')) =  s'

(* head s = x 
  
   Invariant:
   If   s1 = x0, x1, x2 ...
   then x = x0
*)
fun head s = head' (expose s)
and head' (Cons (x, s')) = x




(* Example 1 : A stream of 1's *)
fun ones () = delay ones'
and ones' () = Cons (1, ones ())

(* Example 2 : A stream of natural numbers *)
fun add x y = x + y

fun nats () = delay nats'
and nats' () = Cons (1, zip add (nats ()) (ones ()))

(* Example 3 : A stream of Fibonacci numbers *)
fun fibs () = delay fibs'
and fibs' () = Cons (1, Stream (fn () => 
				Cons (1, zip add (fibs ()) (tail (fibs ())))))


(* Example 4 : Simulation of a 1 bit memory element *)
fun NAND 0 0 = 1
  | NAND 0 1 = 1
  | NAND 1 0 = 1
  | NAND 1 1 = 0

fun NOT 0 = 1
  | NOT 1 = 0

fun rsflipflop (x, y) (q', u') = 
    let 
      val q = NAND x u'
      val u = NAND y q'
    in 
      (q, u)
    end

fun memory1bit xy = 
      delay (fn () =>  memory1bit' xy)
and memory1bit' xy =
      Cons ((0, 1), zip rsflipflop xy (memory1bit xy))


(* Example 5:  Simulation of a register element *)

fun scflipflop (s, c) (q', u') = 
    let 
      val r = NOT s
      val x = NAND s c
      val y = NAND c r
      val q = NAND x u'
      val u = NAND y q'
    in 
      (q, u)
    end
 
fun register sc = 
      delay (fn () =>  register' sc)
and register' sc =
      Cons ((1, 1), zip scflipflop sc (register sc))


fun clock () = delay clock'
and clock' () = Cons (1, delay clock'')
and clock'' () = Cons (0, delay clock''')
and clock''' () = Cons (0, clock ())

fun stretch s = delay (fn () => stretch' s)
and stretch' s = Cons (head s, delay (fn () => stretch'' s))
and stretch'' s = Cons (head s, stretch (tail s))

val signal0 = mkStream [1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0]
val signal1 = clock ()
val signal2 = zip (fn a => fn b => (a, b)) signal0 signal1
val signal3 = stretch signal2
val signal4 = register signal3