(* 22c:123, Fall 2002 *)

(* SML examples seen in class *)

(* Algebraic data types *)

datatype month = Jan | Feb | Mar | Apr 
	       | May | Jun | Jul | Aug
	       | Sep | Oct | Nov | Dec ;

Jan;

fun f Jan = "this is January"
  | f Feb = "this is February"
  | f _ = "this is neither January nor February";

datatype btree = ET
               | Node of (int * btree * btree);

ET;

Node;

val e = ET;

val t1 = Node(3,e,e) ;

val t2 = Node(5,e,e) ;

val t3 = Node(10,t1,t2) ;

val t4 = Node(4,t3,e);

Compiler.Control.Print.printDepth := 50 ;

t4;

fun newTree n = Node(n,ET,ET);

fun left_child (Node (_,t,_)) = t;

fun right_child (Node (_,_,t)) = t;

fun root_value (Node (v,_,_)) = v;

t3;
left_child t3;



fun lookup n ET = false
  | lookup n (Node (m,t1,t2)) = 
    if m = n then
        true
    else if (lookup n t1) then
        true
    else if (lookup n t2) then
        true
    else
        false ;

fun lookup n ET = false
  | lookup n (Node (m,t1,t2)) =
    (m = n) orelse 
    (lookup n t1) orelse
    (lookup n t2) ;


fun insert n ET = Node(n,ET,ET)
  | insert n (Node (m,t1,t2)) = 
    if (n < m) then
        Node (m, (insert n t1), t2)
    else
        Node (m, t1, (insert n t2)) ;

val t = (Node(3,ET,(Node(5,ET,ET)))) ;
val t' = insert 4 t ;

fun traverse ET = []
  | traverse (Node (m,t1,t2)) = let
	val l1 = traverse t1
	val l2 = traverse t2
    in
	append l1 (m::l2)
    end ;

traverse t';



(* SML datatypes for the IMP language *)

type num = int ;          (* N *)
type loc = string ;       (* Loc *)
type state = loc -> num ; (* Sigma *)
type truthValue = bool ;     

datatype aexpr = Num of num             (* n *)
	       | Loc of loc             (* X *)
	       | Plus of aexpr * aexpr  (* a0 + a1 *)
	       | Minus of aexpr * aexpr (* a0 - a1 *)
	       | Times of aexpr * aexpr (* a0 * a1 *) ;

6;
Num 6;
Loc "l1";

val X = "l1" ;
val a = Times (Plus (Num 3, Loc X), 
               Minus (Num 11, Num 2)) ;
(*  a = (3 + X) * (11 - 2))  *)

a ;


datatype bexpr = Atom of truthValue   (* true | false *)
	       | Eq of aexpr * aexpr  (* a0 = a1 *)
	       | Leq of aexpr * aexpr (* a0 <= a1 *)
	       | Not of bexpr         (* ~a *)
	       | And of bexpr * bexpr (* a0 /\ a1 *)
	       | Or of bexpr * bexpr  (* a0 \/ a1 *) ;

true;
Atom true;

And (Atom true, Atom false);

datatype comm = Skip                      (* skip *)
	      | Assign of loc * aexpr     (* X := a *)
	      | Seq of comm * comm        (* a0; a1 *)
	      | If of bexpr * comm * comm (* if b then a0 else a1 *)
	      | WhileDo of bexpr * comm   (* while b do c *) ;

val M = "l1" ;
val N = "l2" ;
val euclid = WhileDo (Not (Eq (Loc M, Loc N)), 
		      If (Leq (Loc M, Loc N),
			  Assign (N, Minus (Loc N, Loc M)),
			  Assign (M, Minus (Loc M, Loc N))));

(* sigma0: state *)
fun sigma0 (x:loc) = 0 ;


(* update: state * num * loc -> state *)
(* (update (sigma, m, x) y) same as 
   sigma[m/X](Y)
 *)
fun update (sigma:state, m:num, x:loc) (y:loc) =
    if y = x then
	m
    else
	sigma y ;

val sigma' = update (sigma0, 2, "l1") ;

sigma' "l1" ;
sigma' "l2" ;
sigma' "h3" ;


(* aEval: aexpr * state -> num *)
(* (aEval a sigma) = n  iff   <a,sigma> -> n
 *)
fun aEval (Loc x, sigma:state) = sigma x
    (* <X, sigma> -> sigma(x) *)

  | aEval (Num n, _) = n
    (* <n, sigma> -> n *)

  | aEval (Plus (a0,a1), sigma) = let
	val n0 = aEval (a0, sigma)
	val n1 = aEval (a1, sigma)
    in
	n0 + n1
    end
    (* <a0, sigma> -> n0    <a1,sigma> -> n1
       -------------------------------------
             <a0 + a1, sigma> -> n

       where n is the sum of n0 and n1
    *)

  | aEval (Minus (a0,a1), sigma) = let
	val n0 = aEval (a0, sigma)
	val n1 = aEval (a1, sigma)
    in
	n0 - n1
    end

  | aEval (Times (a0,a1), sigma) = let
	val n0 = aEval (a0, sigma)
	val n1 = aEval (a1, sigma)
    in
	n0 * n1
    end ;


val X = "l1" ;
val sigma = update(sigma0, 2, X) ;

val a = Times (Plus (Num 3, Loc X), 
               Minus (Num 11, Num 2)) ;
        (*  (3 + X) * (11 - 2))  *)

(* <a, sigma> -> 45 *)
aEval (a, sigma) = 45;

aEval (a, sigma) ;


(* bEval: bexpr * state -> truthValue *)
(* (aEval b sigma) = t  iff   <b,sigma> -> t
 *)
fun bEval (Atom t, _:state) = t
  | bEval (Eq (a0, a1), sigma) = let
	val n = aEval (a0, sigma)
	val m = aEval (a1, sigma)
    in
	n = m
    end
  | bEval (Leq (a0, a1), sigma) = let
	val n = aEval (a0, sigma)
	val m = aEval (a1, sigma)
    in
	n <= m
    end
  | bEval (Not b, sigma) = 
    (case bEval (b, sigma)
      of true => false
       | _ => true)
  | bEval (And (b0, b1), sigma) = 
    (case (bEval (b0, sigma), bEval (b1, sigma))
      of (true, true) => true
       | _ => false)
  | bEval (Or (b0, b1), sigma) = 
    (case (bEval (b0, sigma), bEval (b1, sigma))
      of (false, false) => false
       | _ => true) ;


(* cEval: comm * state -> state *)
(* (aEval c sigma) = sigma'  iff
   <c,sigma> -> sigma'
 *)
fun cEval (Skip, sigma:state) = sigma
    (* <skip, sigma> -> sigma *)

  | cEval (Assign (x, a), sigma) = let
	val m = aEval (a, sigma)
    in 
	update (sigma, m, x)
    end
    (*      <a, sigma> -> n
      -----------------------------
      <X := a, sigma> -> sigma[n/X]
     *)
 
  | cEval (Seq (c0, c1), sigma) = let
	val sigma'' = cEval (c0, sigma)
	val sigma' = cEval (c1, sigma'')
    in
	sigma'
    end
    (* <c0, sigma> -> sigma''
       <c1, sigma''> -> sigma'
       ------------------------
       <c0;c1, sigma> -> sigma'
     *)

  | cEval (If (b, c0, c1), sigma) = 
    (case (bEval (b, sigma))
      of true => let 
	     val sigma' = cEval (c0, sigma)
	 in
	     sigma'
	 end
       | _ => let 
	     val sigma' = cEval (c1, sigma)
	 in
	     sigma'
	 end)
    (* <b, sigma> -> true
       <c0, sigma> -> sigma'
       ---------------------
       <if b then c0 else c1, sigma> -> sigma'

       <b, sigma> -> false
       <c1, sigma> -> sigma'
       ---------------------
       <if b then c0 else c1, sigma> -> sigma'
    *)

  | cEval (WhileDo (b, c), sigma) = 
    (case (bEval (b, sigma))
      of true => let
	     val sigma'' = cEval (c, sigma) 
	     val sigma' = cEval (WhileDo (b,c),
				 sigma'')
	 in
	     sigma'
	 end
       | _ => sigma)
    (* <b, sigma> -> true
       <c, sigma> -> sigma''
       <while b do c, sigma''> -> sigma'
       ---------------------------------
       <while b do c, sigma> -> sigma'

             <b, sigma> -> false
       ------------------------------
       <while b do c, sigma> -> sigma
     *) ;

val M = "l1";
val N = "l2";
val euclid = 
WhileDo (Not (Eq (Loc M, Loc N)), 
	 If (Leq (Loc M, Loc N),
	     Assign (N, Minus (Loc N, Loc M)),
	     Assign (M, Minus (Loc M, Loc N))));

val test = Seq (Assign (M, Num 12),
	   Seq (Assign (N, Num 28),
		euclid));

val sigma = cEval (test, sigma0);
sigma M;
sigma N;