(* ********************************************************************** *)
(* ********** Staging filter to illuistrate exponential code size ******* *)

fun even x = (x mod 2) = 0;

fun filter p [] = <[]>
  | filter p (x::xs) = <if ~p ~(lift x) then ~(filter p xs) else ~(lift x) :: ~(filter p xs)>;

val ex1 = filter <even> [1,2,3,4];

fun filter p [] = <[]>
  | filter p (x::xs) = 
<let val ys = ~(filter p xs)
 in if ~p ~(lift x) then ys else ~(lift x) :: ys end>;

val ex2 = filter <even> [1,2,3,4];



(* ****************************************************************** *)
(* ************** Staging the shortest path problem ***************** *)

fun g x = 
 case x of
   1 => [2]     
 | 2 => [3,4]
 | 3 => [5]
 | 4 => [1,2,5]
 | 5 => [4]
 | _ => [];


type graph = int -> int list;

(*  min : int -> int -> int *)
fun min x z = if x '<' z then x else z ;

(* minimum : int list  -> int *)
fun minimum (x::xs) = (case xs of [] => x | _ => min x (minimum xs));

(* map : ('b -> 'a) -> 'b list  -> 'a list *)
fun map f x = case x of [] => [] | (a::b) => (f a)::(map f b);

(* mem : int -> int list  -> bool *)
fun mem x xs = case xs of [] => false | (a::b) => if a=x then true else mem x b;

(* minus : int list  -> int list  -> int list *)
fun minus xs ys = 
 case xs of 
   [] => [] 
 | (a::b) => if mem a ys then minus b ys else a::(minus b ys);


val infinity = 10000;

fun shortestPath succ (source:int) dest marked weight =
  if source = dest 
     then 0 
     else 
      let val marked2 = (source::marked)
          val explore = (minus (succ source) marked2)
          fun short x = shortestPath succ x dest marked2 weight
          val path_weights =
                map (fn node => (short node) + (weight source node))
                       explore
      in
         case path_weights of
          [] => infinity
         | _ => (minimum path_weights) 
      end;


val ex1 = let fun weight x y = 1
          in shortestPath g 3 2 [] weight end;



fun liftMinimum x =
     case x of 
       [] => <infinity> 
     | (c::cs) => <min ~c ~(liftMinimum cs)>;

fun shortestPath2 succ (source:int) dest marked = 
 <fn weight =>
    ~(if source = dest 
         then <0> 
         else
           let val marked2 = source::marked
               val explore = (minus (succ source) marked)
               fun short x = shortestPath2 succ x dest marked2
               val path_weights = 
                     map (fn node => < (~(short node) weight) + 
                           (weight ~(lift source) ~(lift node)) > )
                         explore
           in
              (liftMinimum path_weights) 
           end
     )
  >;

val ex2 = (shortestPath2 g 4 2 []);


(* ******** Restructure to introduce let *************** *)

fun liftMinimum x =
     case x of 
       [] => <infinity> 
     | [x] => x
     | ( <infinity> :: cs) => liftMinimum cs
     | (c::cs) => <let val y = ~(liftMinimum cs)
                       val z = ~c
                   in min z y end>;

fun shortestPath2 succ source dest marked = 
   <fn weight =>
     ~(if source = dest 
          then <0> 
          else
            let val marked2 = source::marked
                val explore = (minus (succ source) marked)
                fun short x = shortestPath2 succ x dest marked2
                val path_weights = 
                      map (fn node =>
                              let val recall = < ~(short node) weight>
                                  val wght = <weight ~(lift source) ~(lift node)>
                              in <let val q = ~recall in q + ~wght end>
                              end)
                          explore
            in
               (liftMinimum path_weights) 
            end
      )
   >;

val ex3 = (shortestPath2 g 4 2 []);


(* ****************************************************************** *)
(* *************** Staging the merge function *********************** *)


(*********** First try goes into infinite loop ************ *)

fun merge2 xs = 
   <fn ys =>
     ~(case xs of
         [] => <ys>
       | (z::zs) => 
            <case ys of
               [] => ~(lift xs)
             | (w::ws) => 
                 if z '<' (w:int)
                    then z::(~(merge2 zs) ys)
                    else w::(~(merge2 xs) ws)
                    >)>;

fun reverse [] ys = ys 
  | reverse (x::xs) ys = (reverse xs (x::ys));

fun split2 (n:int) xs (small,big) =
     case xs of
       [] => (reverse small [], reverse big [])
     | (z::zs) => if z '>' n
                     then split2 n zs (small,z::big)
                     else split2 n zs (z::small,big);

fun split n l = (split2 n l ([],[]));

fun merge3 xs ys =
   case xs of
     [] => ys
   | z::zs => 
       (case ys of
          [] => xs
        | w::ws => 
           if z '<' w
              then z::(merge3 zs ys)
              else let val (u,v) = split z ys 
                   in 
                     append u (z::(merge3 zs v)) 
                   end
       );

fun merge4 xs = 
<fn ys => 
  ~(case xs of
      [] => <ys>
    | (b::bs) => 
        <case ys of
           [] => ~(lift xs)
         | (w::ws) => 
             if (~(lift b)) '<' w
                then (~(lift b))::(~(merge4 bs) ys)
                else let val (low,high) = split (~(lift b)) ys 
                     in
                       append low
                              (~(lift b)::(~(merge4 bs) high)) 
                     end
        >) 
>;


fun merge5 xs ys = 
case xs of
  [] => ys
| (b::bs) => 
     <case ~ys of
         [] => ~(lift xs)
       | (w::ws) => 
            let val tail = ~(merge5 bs ys)
                val (low,high) = split (~(lift b)) ~ys 
            in if (~(lift b)) '<' w
                then (~(lift b)):: tail
                else append low (~(lift b):: tail) 
            end
        >;

fun f1 xs = <fn ys => ~(merge5 xs <ys>)>;