datatype intSeq = Cons of int * (unit -> intSeq);

(* ---------------------------------------------------- *)
(* Seqnent of ones ... *)
(* val oneSeq = fn : unit -> intSeq *)
fun oneSeq () = Cons(1, oneSeq)

(* Sequent of natural numbers *)
(* val numsSeq = fn : int -> unit -> intSeq *)
fun numsSeq n = fn () => Cons(n, numsSeq(n+1));
val natSeq = numsSeq 0;

fun fSeq n k = fn () => Cons(n, fSeq (n*k) k);

(* val taken = fn : intSeq * int -> int list *)
fun taken (xq, 0)         = []
  | taken (Cons(x,xf), n) = x :: taken (xf (), n-1);

(*
- taken (oneSeq(),5);
val it = [1,1,1,1,1] : int list
- taken (numsSeq 8 (),5);
val it = [8,9,10,11,12] : int list
- taken (natSeq (),5);
val it = [0,1,2,3,4] : int list
*)


(* ---------------------------------------------------- *)
(* Force the evaluation of the tail of the sequent *)
fun force(f) = f()

(* we can write our own hd and tl functions directly.
   Note: we always force the first element of our
   infinite sequent.
 *)

fun hd (Cons(x,xf)) = x;
fun tl (Cons(x,xf)) = force (xf);

(* Note: we are not that lazy, since we always expose the first
   element of the sequence. *)

fun add (Cons(x,xf),Cons(y,yf)): intSeq =
    Cons(x+y, fn () => add (force xf, force yf))

(*
- taken (add (natSeq (), natSeq ()), 10);
val it = [0,2,4,6,8,10,12,14,16,18] : int list
-
*)

val FibStream =
    let
    fun fib a b = Cons(a, (fn () => fib b (a+b)))
    in
    fib 0 1
    end

(* can also define fibs like this *)
fun fibs (): intSeq =
    Cons(0, fn () => Cons(1, fn () => add(force fibs,tl((force fibs)))))

(*

- taken (FibStream, 10);
val it = [0,1,1,2,3,5,8,13,21,34] : int list

*)


(* mapSeq: (int -> int) -> intSeq -> intSeq *)
fun mapSeq f (Cons(x,xs)) =
    Cons( f x, fn () => mapSeq f (force xs) )


(* filterSeq: (int -> bool) -> intSeq -> intSeq *)
fun filterSeq f (Cons (x, xs)) =
    if (f x) then Cons (x, fn () => filterSeq f (force xs))
    else filterSeq f (force xs)


val even = filterSeq (fn x => (x mod 2) = 0) (force natSeq)
val odd = filterSeq (fn x => (x mod 2) = 1) (force natSeq)

(*
- taken (even,  10);
val it = [0,2,4,6,8,10,12,14,16,18] : int list
- taken (odd,  10);
val it = [1,3,5,7,9,11,13,15,17,19] : int list
-
*)

(* intTreeFrom, creates full infinite binary trees *)
datatype intTree = Node of (unit -> intTree) * int * (unit -> intTree)

fun intTreeFrom (k:int) : intTree =
    Node (fn () => intTreeFrom (2*k), k, fn () => intTreeFrom (2*k+1))


(* Below is Friedman's stream assignment, Catalan numbers *)

datatype realSeq = Cons of real * (unit -> realSeq)

(* Calculate all the catalan numbers up to C_i *)
fun catalan (i : int) : int =
    let
    fun next_cat (n, prev_cat) = ((2.0 * (2.0 * (Real.fromInt n) + 1.0)) / ((Real.fromInt n) + 2.0)) * prev_cat
    val list_to_i = List.tabulate (i, (fn x => x))
    in
    Real.floor (foldl next_cat 1.0 list_to_i)
    end

(* Calculate the coefficient of the ith catalan number, and a lazy stream of future coefficients *)
fun helperSeq (i : int) : realSeq =
    let
    val x = (2.0 * (2.0 * (Real.fromInt i) + 1.0)) / ((Real.fromInt i) + 2.0)
    val xs = fn () => helperSeq (i + 1)
    in
    Cons (x, xs)
    end

(* Returns the first catalan number, and a lazy stream to evaluate the rest *)
val catalanStream =
    let
    (*  The idea here is to pass in the previous catalan number, and the stream of coefficients to
        multiply future catalan numbers by. *)
    fun cat prev_cat seq =
        let
        val Cons(coef, seq') = seq (* Grab the next value out of the stream of coefficients *)
        in
        (* Calculate the current catalan number, and pause computation with the sequence of coefs advanced *)
        Cons(coef * prev_cat, fn () => cat (coef * prev_cat) (seq' ()))
        end
    in
    Cons(1.0, fn () => cat 1.0 (helperSeq 0)) (* Tack on C_0 at the beginning, and stage computation of the rest of the stream *)
    end

(* -------------------------------------------------------------*)
(* Question 4 : Streams  and lazy programming (30 points)       *)
(* -------------------------------------------------------------*)

(* Suspended computation *)
datatype 'a stream' = Susp of unit -> 'a stream

(* Lazy stream construction *)
and 'a stream = Empty | Cons of 'a * 'a stream'

(* Lazy stream construction and exposure *)
fun delay (d) = Susp(d)
fun force (Susp(d)) = d ()

(* Eager stream construction *)
val empty = Susp (fn () => Empty)
fun cons (x, s) = Susp (fn () => Cons (x, s))


(* smap: ('a -> 'b) -> 'a stream' -> 'b stream' *)
fun smap f s =
    let
    fun mapStr (s) = mapStr'(force s)
    and mapStr'(Cons(x, s)) = delay(fn () => Cons((f x), mapStr(s)))
      | mapStr' Empty = empty
    in
    mapStr(s)
    end

(* Appending two streams

 append  : 'a stream' * 'a stream' -> 'a stream'
 append' : 'a stream * 'a stream' -> 'a stream'

 *)
fun append (s,s') = append'(force s, s')
and append' (Empty, yq) = yq
  | append' (Cons(x,xf),yq) =
    delay(fn () => Cons(x, append(xf, yq)));

(* Inspect a stream up to n elements
   take : int -> 'a stream' susp -> 'a list
   take': int -> 'a stream' -> 'a list
 *)
fun take 0 s = []
  | take n (s) = take' n (force s)
and take' 0 s = []
  | take' n (Cons(x,xs)) = x::(take (n-1) xs)


(* -------------------------------------------------------------*)
(* Q 4.1 Interleave (10 points)                                 *)
(* -------------------------------------------------------------*)
(* interleave: 'a -> 'a list -> 'a list stream' *)

fun interleave x [] =
    cons([x], empty)
  | interleave x (y::ys) =
    delay(fn () => Cons(x::y::ys, smap (fn l => y::l) (interleave x ys)))


(* -------------------------------------------------------------*)
(* Q 4.2 Flatten a stream (10 points)                           *)
(* -------------------------------------------------------------*)

(* flattenS: ('a stream') stream' -> 'a stream'
   flattenS': 'a stream' stream -> 'a stream'

 *)

fun flattenS s = flattenS' (force s)
and flattenS' (Empty) = empty
  | flattenS' (Cons(s1,s)) = append(s1, flattenS s)


(* -------------------------------------------------------------*)
(* Q 4.3 Permutations (10 points)                               *)
(* -------------------------------------------------------------*)
(* permute: 'a list -> 'a list stream' *)
fun permute [] = cons([], empty)
  | permute (x::xs) = flattenS (smap (fn l => interleave x l) (permute xs))