(* CTM Chapter #04 Examples in Alice ML *)
(* syntactic sugar for solutions using promises/futures *)
open Promise
open Future
infix 3 ?=
val op?= = fulfill
val ? = future;

(* Unify functions used for examples (via chapter 2) *)
exception Unify
fun known x =
   let
      val p = promise()
   in
      fulfill(p, x); p
   end
fun unifyPromise unifyContent (p1, p2) =
   if (p1 = p2)
      then ()
      else
         case (isFulfilled p1, isFulfilled p2)
          of (false, _) => fulfill(p1, future p2)
           | (_, false) => fulfill(p2, future p1)
           | (true, true) => unifyContent(future p1, future p2)
fun unifySimple(x, y) = if x = y then () else raise Unify

(* 4.0 Declarative Concurrency *)
fun gen (i, n) if (i > n) = nil
  | gen (i, n) =
      let
         val _ = Thread.sleep(Time.fromMilliseconds(Int.toLarge 100))
      in
         i::gen(i+1, n)
      end
val xs = gen(1, 10);
inspect (map (fn x => x*x) xs);

fun gen (i, n, p) if (i > n) = ( p ?= nil; future p )
  | gen (i, n, p) =
      let
         val px = promise()
      in
         Thread.sleep(Time.fromMilliseconds(Int.toLarge 100));
         p ?= i::(future px);
         gen(i+1, n, px);
         future p
      end
val xs = promise();
spawn gen(1, 10, xs);

(* note that map will run concurrently but won't return a result until the function terminates *)
val ys = spawn map (fn x => x*x) (future xs);
inspect ys;

fun mapPromise f nil p = ( p ?= nil; future p )
  | mapPromise f (x::xs) p =
      let
         val px = promise()
      in
         p ?= (f x)::(future px);
         mapPromise f xs px;
         future p
      end;
val ys = promise();
spawn mapPromise (fn x => x*x) (future xs) ys;
inspect (future ys);

(* 4.1.3 The data-driven concurrent model - Semantics of threads *)
let
   val b = promise()
in
   spawn b ?= true;
   if (future b)
      then inspect "yes"
      else ()
end;

(* 4.1.4 The data-driven concurrent model - What is declarative concurrency *)
fun double (nil, p)   = ( p ?= nil; future p )
  | double (x::xs, p) =
      let
         val px = promise()
      in
         p ?= (2*x)::(future px);
         double(xs, px);
         future p
      end
val xs = promise()
val ys = promise()
val xr = promise();
spawn double(future xs, ys);
inspect (future ys);
xs ?= 1::2::3::(future xr);

val x = promise()
val y = promise();
unifyPromise unifySimple (x, known(1));
unifyPromise unifySimple (y, x);

val x = promise()
val y = promise();
unifyPromise unifySimple (y, x);
unifyPromise unifySimple (x, known(1));

datatype 'a foo = Foo of 'a * 'a
val y = promise()
val z = promise()
val w = promise()
val x = Foo (future y, future w);
unifyPromise unifySimple (y, z);

val y = promise()
val z = promise()
val w = promise()
val x = Foo (future z, future w);
unifyPromise unifySimple (y, z);

val x = promise()
val y = promise();
spawn unifyPromise unifySimple (x, known(1));
spawn unifyPromise unifySimple (y, known(2));
spawn unifyPromise unifySimple (x, y);
(future x = future y) handle Unify => false;

let
   datatype status = Ok | Err
   val x = promise()
   val y = promise()
   val x1 = promise()
   val y1 = promise()
   val s1 = promise()
   val s2 = promise()
   val s3 = promise()
in
   spawn ( unifyPromise unifySimple (x1, known(1)); s1 ?= Ok )
      handle Unify => s1 ?= Err;
   spawn ( unifyPromise unifySimple (y1, known(2)); s2 ?= Ok )
      handle Unify => s2 ?= Err;
   spawn ( unifyPromise unifySimple (x1, y1); s3 ?= Ok )
      handle Unify => s3 ?= Err;
   if (future s1 = Err) orelse (future s2 = Err) orelse (future s3 = Err)
      then ( x ?= 1; y ?= 1 )
      else ( x ?= future x1; y ?= future y1 )
end;

(* 4.2.1 Basic thread programming techniques - Creating threads *)
spawn
   let
      fun count n =
         if (n > 0)
            then count(n-1)
            else ()
   in
     count 1000000
   end;

val x = (spawn 10 * 10) + 100*100;

let
   val x = promise()
   val y = spawn 10*10
in
   x ?= y + 100*100
end;

(* 4.2.2 Basic thread programming techniques - Threads and the browser *)
spawn inspect 111;
inspect 222;

let
   val x1 = promise()
   val x2 = promise()
   val y1 = promise()
   val y2 = promise()
in
   spawn inspect (future x1);
   spawn inspect (future y1);
   spawn x1 ?= "all"::"roads"::(future x2);
   spawn y1 ?= "all"::"roams"::(future y2);
   spawn x2 ?= "lead"::"to"::"rome"::(future (promise()));
   spawn y2 ?= "lead"::"to"::"rhodes"::(future (promise()))
end;

(* 4.2.3 Basic thread programming techniques - Dataflow computation with threads *)

(* simple dataflow behavior *)
let
   val x0 = promise()
   val x1 = promise()
   val x2 = promise()
   val x3 = promise()
in
   spawn
      let
         val y0 = promise()
         val y1 = promise()
         val y2 = promise()
         val y3 = promise()
      in
        inspect (future y0, future y1, future y2, future y3);
        y0 ?= (future x0) + 1;
        y1 ?= (future x1) + (future y0);
        y2 ?= (future x2) + (future y1);
        y3 ?= (future x3) + (future y2);
        inspect "completed"
      end;
   inspect (future x0, future x1, future x2, future x3);
   x0 ?= 0;
   x1 ?= 1;
   x2 ?= 2;
   x3 ?= 3
end;

(* using a declarative program in a concurrent setting *)
fun forall nil f = ()
  | forall (x::xs) f = (f x; forall xs f);

let
   val xs = promise()
   val x1 = promise()
   val x2 = promise()
in
   spawn forall (future xs) inspect;
   spawn xs ?= 1::(future x1);
   spawn x1 ?= 2::3::(future x2);
   spawn x2 ?= 4::nil
end;

let
   val xs = promise()
in
   spawn forall (future xs) inspect;
   xs ?= [1,2,3,4]
end;

(* A concurrent map function *)
fun mapPromiseSpawn f nil p = ( p ?= nil; future p )
  | mapPromiseSpawn f (x::xs) p =
      let
         val px = promise()
      in
         p ?= (spawn (f x))::(future px);
         mapPromiseSpawn f xs px;
         future p
      end;

let
   val p = promise()
   val xs = promise()
   val ys = promise()
   val zs = promise()
   val f = promise()
in
   spawn mapPromiseSpawn (future f) (future xs) p;
   inspect (future p);
   xs ?= 1::2::(future ys);
   f ?= (fn x => x*x);
   ys ?= 3::(future zs);
   zs ?= nil
end;

(* A concurrent Fibonacci function *)
fun fib x if (x <= 2) = 1
  | fib x = (spawn fib (x-1)) + (fib (x-2));
inspect (fib 26);

(* Note: All Alice threads run at the same priority *)

(* 4.3.1 Streams - Basic producer/consumer *)

val xs = promise()
val xs2 = promise();
xs ?= 0::1::2::3::4::(future xs2);

val xs3 = promise();
xs2 ?= 5::6::7::(future xs3);

fun generate (n, limit, p) if (n >= limit) =
      ( p ?= nil; future p )
  | generate (n, limit, p) =
      let
         val px = promise()
      in
         p ?= n::(future px);
         generate(n+1, limit, px);
         future p
      end
fun sum (nil, a) = a
  | sum (x::xs, a) = sum(xs, a+x);

(* Note: I'm using smaller limit so as to fit in 31 bit int *)
(* Convert functions to IntInf if you want to use 150000    *)
let
   val xs = promise()
   val s = promise()
in
   spawn generate(0, 15000, xs);
   spawn s ?= sum(future xs, 0);
   inspect (future s)
end;

let
   val xs = promise()
   val s = promise()
in
   spawn generate(0, 15000, xs);
   spawn s ?= foldl (fn (x, y) => x+y) 0 (future xs);
   inspect (future s)
end;

let
   val xs = promise()
   val s1 = promise()
   val s2 = promise()
   val s3 = promise()
in
   spawn generate(0, 15000, xs);
   spawn s1 ?= sum(future xs, 0);
   spawn s2 ?= sum(future xs, 0);
   spawn s3 ?= sum(future xs, 0);
   inspect (future s1, future s2, future s3)
end;

(* 4.3.2 Streams - Transducers and pipelines *)

(* filtering a stream *)
fun filterPromise f nil p = ( p ?= nil; future p )
  | filterPromise f (x::xs) p =
      if (f x)
         then
            let
               val px = promise()
            in
               p ?= x::(future px);
               filterPromise f xs px;
               future p
            end
         else (filterPromise f xs p)

fun isOdd x = (x mod 2) <> 0;

let
   val xs = promise()
   val ys = promise()
   val s = promise()
in
   spawn generate(0, 15000, xs);
   spawn filterPromise isOdd (future xs) ys;
   spawn s ?= sum(future xs, 0);
   inspect (future s)
end;

(* Sieve of Eratosthenes *)
fun sieve (nil, p) = ( p ?= nil; future p )
  | sieve (x::xs, p) =
      let
         val ys = promise()
         val px = promise()
      in
         p ?= x::(future px);
         spawn ys ?= List.filter (fn y => (y mod x) <> 0) xs;
         sieve(future ys, px);
         future p
      end;

(* Note: Not sure it works for 100000 - takes a while *)
let
   val xs = promise()
   val ys = promise()
in
   spawn generate(2, 10000, xs);
   spawn sieve(future xs, ys);
   inspect (future ys)
end;

fun sieve (nil, m, p) = ( p ?= nil; future p )
  | sieve (x::xs, m, p) =
      let
         val ys = promise()
         val px = promise()
      in
         p ?= x::(future px);
         if (x <= m)
            then spawn ys ?= List.filter (fn y => (y mod x) <> 0) xs
            else ys ?= xs;
         sieve(future ys, m, px);
         future p
      end;

(* 4.3.3 Streams - Managing resources and improving throughput *)

(* Flow control with demand driven concurrency *)
fun dgenerate (n, nil)   = ()
  | dgenerate (n, x::xs) = ( x ?= n; dgenerate(n+1, xs) )

fun dsum (xs, a, limit) if (limit <= 0) = ( xs ?= nil; a )
  | dsum (xs, a, limit) =
      let
         val x = promise()
         val xr = promise()
      in
         xs ?= x::(future xr);
         dsum(xr, a+(future x), limit-1)
      end;

let
   val xs = promise()
   val s = promise()
in
   spawn dgenerate(0, future xs);
   spawn s ?= dsum(xs, 0, 15000);
   inspect (future s)
end;

(* Flow control with a bounded buffer *)
fun buffer (n, xs, ys) =
   let
      fun startup (n, xs) if (n = 0) = xs
        | startup (n, xs) =
            let
               val x = promise()
               val xr = promise()
            in
               xs ?= x::(future xr);
               startup(n-1, xr)
            end
      val endb = startup(n, xs)
      fun askLoop (y::ys, x::xs, endb) =
            let
               val end2 = promise()
            in
               y ?= future x;
               endb ?= promise()::(future end2);
               askLoop(ys, xs, end2)
            end
        | askLoop (_, _, _) = ()
   in
      spawn askLoop(ys, future xs, endb)
   end;

let
   val xs = promise()
   val ys = promise()
   val s = promise()
in
   spawn dgenerate(0, future xs);
   spawn buffer(4, xs, future ys);
   spawn s ?= dsum(ys, 0, 15000);
   inspect (future s)
end;

(* Flow control with thread priorities - priorities not supported by Alice *)
fun setThisPriority () = ();
let
   val xs = promise()
   val s = promise()
in
   spawn ( setThisPriority(); dgenerate(0, future xs) );
   spawn ( setThisPriority(); s ?= dsum(xs, 0, 15000) );
   inspect (future s)
end;

(* 4.3.4 Streams - Stream objects *)
fun nextState (m, x1, n, x2) = ()

fun streamObject (nil, x1, t1) = ( t1 ?= nil; future t1 )
  | streamObject (m::s2, x1, t1) =
      let
         val n = promise()
         val t2 = promise()
         val x2 = promise()
      in
         nextState(m, x1, n, x2);
         t1 ?= (future n)::(future t2);
         streamObject(s2, future x2, t2);
         future t1
      end;

let
   val s0 = promise()
   val x0 = promise()
   val t0 = promise()
in
   spawn streamObject(future s0, future x0, t0)
end;

let
   val s0 = promise()
   val t0 = promise()
   val u0 = promise()
   val v0 = promise()
in
   spawn streamObject(future s0, 0, t0);
   spawn streamObject(future t0, 0, u0);
   spawn streamObject(future u0, 0, v0)
end;

(* 4.3.5.1 Streams - Digital logic simulation - Combinatorial logic *)
fun notGate (nil, p)   = ( p ?= nil; future p )
  | notGate (x::xs, p) =
      let
         val px = promise()
      in
         p ?= (1-x)::(future px);
         notGate(xs, px);
         future p
      end

fun notG (xs, p) =
   let
      fun notLoop (nil, p)   = ( p ?= nil; future p )
        | notLoop (x::xs, p) =
            let
               val px = promise()
            in
               p ?= (1-x)::(future px);
               notLoop(xs, px);
               future p
            end
   in
      spawn notLoop(xs, p)
   end

fun gateMaker f =
   fn (xs, ys, p) =>
      let
         fun gateLoop (nil, _, p)       = ( p ?= nil; future p )
           | gateLoop (_, nil, p)       = ( p ?= nil; future p )
           | gateLoop (x::xr, y::yr, p) =
               let
                  val px = promise()
               in
                  p ?= f(x, y)::(future px);
                  gateLoop(xr, yr, px);
                  future p
               end
      in
         spawn gateLoop(xs, ys, p)
      end

val andG    = gateMaker (fn (x, y) => x*y)
val orG     = gateMaker (fn (x, y) => x+y-x*y)
val nandG   = gateMaker (fn (x, y) => 1-x*y)
val norG    = gateMaker (fn (x, y) => 1-x-y+x*y)
val xorG    = gateMaker (fn (x, y) => x+y-2*x*y)

fun fullAdder (x, y, z, c, s) =
   let
      val k = promise()
      val l = promise()
      val m = promise()
      val pc = promise()
      val ps = promise()
   in
      andG(x, y, k);
      andG(y, z, l);
      andG(x, z, m);
      orG(future l, future m, pc);
      orG(future k, future pc, c);
      xorG(x, y, ps);
      xorG(z, future ps, s);
      future s
   end;

let
   val x = [1, 1, 0, future (promise())]
   val y = [0, 1, 0, future (promise())]
   val z = [1, 1, 1, future (promise())]
   val c = promise()
   val s = promise()
in
   fullAdder(x, y, z, c, s);
   inspect ((x, y, x), (future c, future s))
end;

(* 4.3.5.2 Streams - Digital logic simulation - Sequential logic *)
fun delayG xs = 0::xs

fun latch (c, di, p) =
   let
      val d0 = promise()
      val x = promise()
      val y = promise()
      val z = promise()
      val f = promise()
   in
      p ?= future d0;
      andG(future f, c, x);
      notG(c, z);
      andG(future z, di, y);
      orG(future x, future y, d0);
      f ?= delayG(future d0);
      future d0
   end

(* 4.3.5.3 Streams - Digital logic simulation - Clocking *)

fun clock p =
   let
      fun loop b =
         let
            val px = promise()
         in
            p ?= b::future px;
            loop b;
            future p
         end
   in
      spawn (loop 1)
   end

fun clock p =
   let
      fun loop b =
         let
            val px = promise()
         in
            Thread.sleep(Time.fromMilliseconds(Int.toLarge(1000)));
            p ?= b::future px;
            loop b;
            future p
         end
   in
      spawn (loop 1)
   end

(* 4.3.5.4 Streams - Digital logic simulation - A linguistic abstraction for logic gates *)

(* Note: Not willing to tackle this at the current time *)

(* 4.4.1 Using the declarative concurrent model directly - Order-determining concurrency *)
datatype ('a, 'b, 'c) obtree = Leaf
                             | Tree of { key   : 'a,
                                         value : 'b,
                                         x     : 'c promise,
                                         y     : 'c promise,
                                         left  : ('a, 'b, 'c) obtree,
                                         right : ('a, 'b, 'c) obtree }

val scale = 30

fun depthFirst (Tree{x, y, left=Leaf, right=Leaf, ...}, level, leftLim, rootX, rightLim) =
      let
      in
         x ?= future leftLim;
         rootX ?= future x;
         rightLim ?= future x;
         spawn y ?= scale * level
      end
  | depthFirst (Tree{x, y, left, right=Leaf, ...}, level, leftLim, rootX, rightLim) =
      let
      in
         x ?= future rootX;
         spawn y ?= scale * level;
         depthFirst(left, level+1, leftLim, rootX, rightLim)
      end
  | depthFirst (Tree{x, y, left=Leaf, right, ...}, level, leftLim, rootX, rightLim) =
      let
      in
         x ?= future rootX;
         spawn y ?= scale * level;
         depthFirst(right, level+1, leftLim, rootX, rightLim)
      end
  | depthFirst (Tree{x, y, left, right, ...}, level, leftLim, rootX, rightLim) =
      let
         val lRootX = promise()
         val rRootX = promise()
         val lRightLim = promise()
         val rLeftLim = promise()
      in
         rootX ?= future x;
         spawn x ?= (future lRootX + future rRootX) div 2;
         spawn y ?= scale * level;
         spawn rLeftLim ?= (future lRightLim) + scale;
         depthFirst(left, level+1, leftLim, lRootX, lRightLim);
         depthFirst(right, level+1, rLeftLim, rRootX, rightLim)
      end
  | depthFirst (Leaf, _, _, _, _) = ();

(* 4.4.2 Using the declarative concurrent model directly - Coroutines *)
fun fspawn p =
   let
      val pid = promise()
   in
      spawn (
         pid ?= Thread.current();
         Thread.suspend(future pid);
         future p);
      future pid
   end

fun fresume id = (
   Thread.resume id;
   Thread.suspend(Thread.current()))

(* 4.4.3 Using the declarative concurrent model directly - Concurrent composition *)
fun barrier ps =
   let
      fun barrierLoop (nil, n) = n
        | barrierLoop (f::fs, n) =
            let
               val m = promise()
            in
               spawn ( f(); m ?= n );
               barrierLoop(fs, future m)
            end
      val s = promise()
   in
      spawn s ?= barrierLoop(ps, ());
      await s
   end

(* 4.5 Lazy execution *)
fun lazy f1 x = 1+x*(3+x*(3+x))
fun lazy f2 x = let val y = x*x in y*y end
fun lazy f3 x = (x+1)*(x+1)
val a = f1(10)
val b = f2(20)
val c = f3(30)
val d = a+b

(* 4.5.1 Lazy execution - The demand-driven concurrent model *)
val y = promise();
(fn a => a ?= (lazy 111 * 111)) y;
inspect (future y);
await (future y);

let
   val x = promise()
   val y = promise()
   val z = promise()
in
   spawn x ?= (lazy (fn () => 3) ());
   spawn y ?= (lazy (fn () => 4) ());
   spawn z ?= (future x) + (future y)
end;

let
   val x = promise()
   val z = promise()
in
   let
      val f = (fn () => 3) ()
      val t1 = spawn unifyPromise unifySimple (x, lazy known(f))
      val t2 = spawn unifyPromise unifySimple (x, lazy known(2))
      val t3 = spawn z ?= (future x) + 4
   in
      await t1;
      await t2;
      await t3
   end;
   inspect "Unify"
end
handle Unify => inspect "Unify Exception";

let
   val x = promise()
   val y = promise()
   val z = promise()
   val f = (fn () => 3) ()
in
   spawn unifyPromise unifySimple (x, lazy known(f));
   spawn unifyPromise unifySimple (x, y);
   spawn (if future x = future y then z ?= 10 else ());
   inspect (future x)
end;

fun lazy generate n = n::generate(n+1)
val x = generate 0;
inspect x;
inspect (hd (tl (tl x)));
fun generate n = lazy(n::generate(n+1))

(* 4.5.2 Lazy execution - Declarative computation models *)
val x = 11*11                                         (* (1)&(2)&(3) together *)

fun lazy lazyMul (a, b) = a*b
val x = lazyMul(11, 11);                              (* (1)&(2) together *)
await x;                                              (* (3) seperate *)

val x = lazy 11 * 11;                                 (* (1)&(2) together *)
await x;                                              (* (3) seperate *)

val x = promise();                                    (* (1) seperate *)
x ?= 11 * 11;                                         (* (2)&(3) together *)

val x = promise();                                    (* (1) seperate *)
spawn x ?= 11 * 11;                                   (* (2)&(3) together *)
spawn if (future x > 100) then inspect "big" else ();

val x = promise();                                    (* (1) seperate *)
x ?= (lazy 11 * 11);                                  (* (2) seperate *)
await x;                                              (* (3) seperate *)

val x = promise();                                    (* (1) seperate *)
spawn x ?= (lazy 11 * 11);                            (* (2) seperate *)
spawn await x;                                        (* (3) seperate *)

let
   val z = promise()
   fun lazy f1 x = x + future z
   fun lazy f2 y = (z ?= 1; y + future z)
in
   (* inspect (f1(1) + f2(2)) *)                      (* deadlock *)
   inspect (f2(1) + f1(2))
end;

(* 4.5.3 Lazy execution - Lazy streams *)
fun lazy generate n = n::generate(n+1)

fun sum (_, a, limit) if (limit <= 0) = a
  | sum (x::xs, a, limit) = sum(xs, a+x, limit-1)
  | sum (nil, _, _) = raise Empty;

let
   val xs = generate 0
   val s = sum(xs, 0, 15000)
in
   inspect s
end;

let
   val s1 = promise()
   val s2 = promise()
   val s3 = promise()
   val xs = generate 0
in
   s1 ?= (spawn sum(xs, 0, 15000));
   s2 ?= (spawn sum(xs, 0, 10000));
   s3 ?= (spawn sum(xs, 0, 5000))
end;

(* 4.5.4 Lazy execution - Bounded buffer *)
fun buffer1 (xin, n) =
   let
      val xend = List.drop(xin, n)
      fun lazy loop (x::xs, xend) = x::loop(xs, tl xend)
        |      loop (nil, xend)   = raise Empty
   in
      loop(xin, xend)
   end

fun buffer2 (xin, n) =
   let
      val xend = List.drop(xin, n)
      fun lazy loop (x::xs, xend) = x::loop(xs, spawn tl xend)
        |      loop (nil, xend)   = raise Empty
   in
      loop(xin, xend)
   end

fun lazy ints n =
   let
      val _ = Thread.sleep(Time.fromMilliseconds(Int.toLarge 1000))
   in
      n::ints(n+1)
   end;

let
   val xin = ints 1
   val out = buffer2(xin, 5)
in
   inspect out;
   inspect (hd out);
   inspect (tl(tl(tl(tl(tl(tl(tl(tl(tl(tl out))))))))))
end;

(* 4.5.5 Lazy execution - Reading a file lazily *)
fun readListLazy fname =
   let
      val infile = TextIO.openIn fname
      fun lazy readNext () =
         let
            val xs = explode(TextIO.inputN(infile, 100))
         in
            if (null xs)
               then TextIO.closeIn infile
               else ( readNext(); () );
            xs
         end
   in
      readNext()
   end

(* 4.5.6 Lazy execution - The Hamming problem *)
fun lazy times n []      = []
  |      times n (x::xs) = (n*x)::(times n xs)

fun lazy merge xs nil = xs
  | merge nil ys = ys
  | merge (xs as x::xr) (ys as y::yr) =
      if x < y
         then x::(merge xr ys)
         else
            if x > y
               then y::(merge xs yr)
               else x::(merge xr yr)

val h = promise();
h ?= 1 :: (merge (times 2 (future h))
                 (merge (times 3 (future h))
                        (times 5 (future h))));

inspect h;

fun touch (n, x::xs) if (n > 0) = touch(n-1, xs)
  | touch (_, _) = ();

touch(20-1, future h);

(* alternately, we could use take to accomplish the same end *)
List.take(future h, 20);

(* 4.5.7 Lazy execution - Lazy list operations *)

(* lazy append *)
fun lazy lazyAppend (nil, ys)   = ys
  |      lazyAppend (x::xs, ys) = x::lazyAppend(xs, ys)

val x = lazyAppend(explode "foo", explode "bar")

fun lazy makeLazy nil     = nil
  |      makeLazy (x::xs) = x::makeLazy xs

val x = lazyAppend(explode "foo", makeLazy(explode "bar"));

inspect (implode x);

(* lazy mapping *)
fun lazy lazyMap f nil     = nil
  |      lazyMap f (x::xs) = (f x)::(lazyMap f xs)

(* lazy integer lists *)
datatype 'a lazyfromtype = Infinite | Number of 'a
fun lazyFrom (i, j) =
   let
      fun lazy lazyFromLoop (i, j) if (i > j) = nil
        |      lazyFromLoop (i, j) = i::lazyFromLoop(i+1, j)
      fun lazy lazyFromInf i = i::lazyFromInf(i+1)
   in
      case j of
          Infinite => lazyFromInf i
        | Number x => lazyFromLoop(i, x)
   end

(* lazy flatten *)
datatype 'a nestedlist = Leaf of 'a
                       | Branch of 'a nestedlist list

fun lazyFlatten xs =
   let
      fun lazy lazyFlattenD (Branch nil, e) = e
        | lazyFlattenD (Branch ((Branch x)::xr), e) =
            lazyFlattenD(Branch x, lazyFlattenD(Branch xr, e))
        | lazyFlattenD (Branch ((Leaf   x)::xr), e) =
            x::lazyFlattenD(Branch xr, e)
        | lazyFlattenD (Leaf x, e) = x::e
   in
      lazyFlattenD(xs, [])
   end

(* lazy reverse *)
fun lazyReverse s =
   let
      fun lazy rev (nil, r) = r
        |      rev (x::xs, r) = rev(xs, x::r)
   in
      rev(s, nil)
   end

val x = lazyReverse [#"a", #"b", #"c"];
inspect x;
List.take(x, 1);

(* lazy filter *)
fun lazy lazyFilter f nil = nil
  | lazyFilter f (x::xs) =
      if (f x)
         then x::(lazyFilter f xs)
         else (lazyFilter f xs)

(* 4.5.8.1 Lazy execution - Persistent queues and algorithm design - Amortized persistent queue *)
datatype 'a queue = Queue of int * 'a list * int * 'a list

fun newQueue () = Queue(0, nil, 0, nil)

fun checkQ (q as Queue(lenf, f, lenr, r)) =
   if (lenf >= lenr)
      then q
      else Queue(lenf+lenr, lazyAppend(f, List.rev r), 0, nil)

fun insertQ (Queue(lenf, f, lenr, r), x) =
   checkQ(Queue(lenf, f, lenr+1, x::r))

fun deleteQ (q, px) =
      let
         val Queue(lenf, f, lenr, r)= checkQ(q)
      in
         px ?= hd f;
         checkQ(Queue(lenf-1, tl f, lenr, r))
      end

(* 4.5.8.2 Lazy execution - Persistent queues and algorithm design - Worst-case persistent queue *)
fun reverse r =
   let
      fun rev (nil, a)   = a
        | rev (x::xs, a) = rev(xs, x::a)
   in
      rev(r, nil)
   end

fun lazy lazyAppend (nil, b) = b
  |      lazyAppend (x::xs, b) = x::lazyAppend(xs, b)

fun lazy lazyAppRev (nil, y::nil, b)  = y::b
  |      lazyAppRev (x::xs, y::ys, b) = x::lazyAppRev(xs, ys, y::b)
  |      lazyAppRev (x::xs, nil, b)   = raise Empty

fun checkQ (q as Queue(lenf, f, lenr, r)) =
   if (lenf >= lenr)
      then q
      else Queue(lenf+lenr, lazyAppRev(f, r, nil), 0, nil)

(* 4.5.9 Lazy execution - List comprehensions *)
(* Note: Alice doesn't sport list comprehensions *)
fun eagerFrom (i, j) =
   let
      fun fromLoop (i, j) if (i > j) = nil
        | fromLoop (i, j) = i::fromLoop(i+1, j)
      fun fromInf i = i::fromInf(i+1)
   in
      case j of
          Infinite => fromInf i
        | Number x => fromLoop(i, x)
   end

val z = map (fn x =>(x, x)) (eagerFrom(1, Number 10))

val z = lazyMap (fn x =>(x, x)) (lazyFrom(1, Number 10))

val z = lazyFlatten (Branch (
            lazyMap
               (fn x => Branch (lazyMap (fn y => Leaf (x, y))
               (lazyFrom(1, Number x))))
            (lazyFrom(1, Number 10))))

fun fmap f xs = lazyFlatten(Branch (lazyMap f xs))

val z = fmap
         (fn x => Branch (lazyMap (fn y => Leaf (x, y)) (lazyFrom(1, Number x))))
         (lazyFrom(1, Number 10))

val z = lazyFilter
         (fn (x,y) => x+y <= 10)
         (fmap
            (fn x => Branch (lazyMap (fn y => Leaf (x, y)) (lazyFrom(1, Number x))))
            (lazyFrom(1, Number 10)))

val z = fmap
         (fn x => Branch (lazyMap (fn y => Leaf (x, y)) (lazyFrom(1, Number (10-x)))))
         (lazyFrom(1, Number 10))

(* 4.6.1 Soft real-time programming - Basic operations *)
fun for a b s f =
   let
      fun loopup c if (c <= b) = (f c; loopup (c+s))
        | loopup c = ()
      fun loopdown c if (c >= b) = (f c; loopdown (c+s))
        | loopdown c = ()
   in
      if (s > 0)
         then loopup a
         else
            if (s < 0)
               then loopdown a
               else ()
   end;

let
   fun ping n =
      if (n = 0)
         then inspect "ping terminated"
         else (
            Thread.sleep(Time.fromMilliseconds(Int.toLarge 500));
            inspect "ping";
            ping(n-1))
   fun pong n = (
      for 1 n 1 (fn i => ( Thread.sleep(Time.fromMilliseconds(Int.toLarge 600)); inspect "pong" ));
      inspect "pong terminated")
in
   inspect "game started";
   spawn ping 5;
   spawn pong 5
end;

functor PingPong () =
   struct
      fun ping n =
         if (n = 0)
            then inspect "ping terminated"
            else (
               Thread.sleep(Time.fromMilliseconds(Int.toLarge 500));
               inspect "ping";
               ping(n-1))
      fun pong n = (
         for 1 n 1  (fn i => ( Thread.sleep(Time.fromMilliseconds(Int.toLarge 600)); inspect "pong" ));
         inspect "pong terminated")

      fun run () =
         let
            val _ = inspect "game started"
            val t1 = spawn ping 50
            val t2 = spawn pong 50
         in
            await t1;
            await t2;
            OS.Process.exit OS.Process.success
         end

      val _ = run()
end

(* 4.6.2 Soft real-time programming - Ticking *)
fun forall nil f = ()
  | forall (x::xs) f = (f x; forall xs f)

fun newTicker p =
   let
      fun loop p =
         let
            val x = Time.now()
            val px = promise()
         in
            Thread.sleep(Time.fromMilliseconds(Int.toLarge 1000));
            p ?= x::(future px);
            loop px
         end
   in
      spawn loop p
   end;

val px = promise();
(* spawn newTicker px; *)      (* Uncomment to run *)
spawn forall (future px) (fn x => inspect x);

fun newTicker p =
   let
      fun loop (p, t) =
         let
            val x = Time.now()
            val px = promise()
         in
            Thread.sleep(Time.fromMilliseconds(Int.toLarge 900));
            if (Time.toSeconds(t) <> Time.toSeconds(x))
               then p ?= x::(future px)
               else ();
            loop(px, x)
         end
   in
      spawn loop(p, Time.now())
   end

fun newTicker p =
   let
      fun loop (p, t) =
         let
            val x = Time.now()
            val px = promise()
         in

            if (Time.toSeconds(t) > Time.toSeconds(x))
               then Thread.sleep(Time.fromMilliseconds(Int.toLarge 900))
               else
                  if (Time.toSeconds(t) > Time.toSeconds(x))
                     then Thread.sleep(Time.fromMilliseconds(Int.toLarge 1100))
                     else Thread.sleep(Time.fromMilliseconds(Int.toLarge 1000));
            p ?= x::(future px);
            loop(px, x)
         end
   in
      spawn loop(p, Time.now())
   end

(* 4.7 The Haskell language *)
fun lazy factorial 0 : int         = 1 : int
  |      factorial n if (n > 0) = n * factorial(n-1)
  |      factorial n               = raise Domain

(* 4.7.1 The Haskell language - Computation model *)
val n = 3;
(if n >= 0 then factorial else raise Domain) (factorial(factorial n));

(* 4.7.2 The Haskell language - Lazy evaluation *)
fun lazy dropWhile f nil = nil
  |      dropWhile f (x::xs) = if (f x) then dropWhile f xs else x::xs
fun lazy dropUntil f xs = dropWhile (not o f) xs

fun lazy sqrt' x =
   let
      fun lazy goodEnough guess = (abs(x - guess*guess) / x) < 0.00001
      fun lazy improve guess = (guess + x/guess) / 2.0
      val sqrtGuesses = promise()
   in
      sqrtGuesses ?= 1.0::(lazyMap improve (future sqrtGuesses));
      hd (dropUntil goodEnough (future sqrtGuesses))
   end;

(sqrt' 36.0) + 0.0;

(* 4.7.3 The Haskell language - Currying *)
val doubleList = lazyMap (fn x => 2*x);

val x = doubleList [1,2,3,4];

List.take(x, 4);

(* 4.7.4 The Haskell language - Polymorphic types *)
datatype 'a btree = Leaf
                  | Node of 'a * 'a btree * 'a btree

fun lazy bsize Leaf = 0
  |      bsize (Node((k, v), lt, rt)) = 1 + (bsize lt) + (bsize rt)

fun lazy lookup k Leaf = NONE
  |      lookup k (Node((nk, nv), lt, rt)) if (k < nk) = lookup k lt
  |      lookup k (Node((nk, nv), lt, rt)) if (k > nk) = lookup k rt
  |      lookup k (Node((nk, nv), lt, rt)) = SOME nv

(* 4.8.3.2 Limitations and Extensions of declarative programming - Nondeterminism *)
fun skip xs =
   if (isDetermined xs)
      then
         case xs of
             x::xr => skip xr
           | nil   => nil
      else xs

fun skip1 nil = nil
  | skip1 (xs as x::xr) =
      if (isDetermined xr)
         then skip1 xr
         else xs

fun displayFrame x = ()

fun display xs =
   case skip1 xs of
       x::xr => ( displayFrame x; display xr )
     | nil   => ()

(* 4.9.1 Advanced topics - The declarativwe concurrent model with exceptions *)
fun foo x = x
val x =
   lazy fn x =>
      let
         val a = promise()
         val b = promise()
      in
         a ?= foo(1);
         b ?= foo(2);
         a ?= future b;
         a
      end

val x = ( raise Promise; () ) handle Promise => ()

fun byneed2 f x =
   lazy (
      fn x =>
         let
            val y = promise()
         in
            f y;
            x ?= future y;
            x
         end
         handle exc => raise Promise)

(* 4.9.3 Advanced topics - Dataflow variables as communication channels *)
fun syncSend x m =
   let
      val sync = promise()
   in
      lazy fn x => ( x ?= future m; sync ?= (); future x);
      await sync
   end

(* 4.9.5 Advanced topics - Usefulness of dataflow variables *)
fun xfuture x = ( x = promise(); future x )