(* 22c:185, Fall 2006 *) (* SML datatypes for the IMP language *) type num = int ;; (* N *) type loc = string ;; (* Loc *) type state = loc -> num ;; (* Sigma *) type truthValue = bool ;; (* T *) type 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 *) ;; type aConf = aExpr * state ;; let x = "l1" ;; let a = Times (Plus (Num 3, Loc x), Minus (Num 11, Num 2)) ;; (* a = (3 + X) * (11 - 2)) *) a ;; type 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 *) ;; type bConf = bExpr * state ;; type 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 *) | Print of loc (* new command *) ;; type cConf = comm * state ;; (* while not(X = Y) do if X <= Y then Y := Y - X else X := X - Y *) let x = "l1" ;; let y = "l2" ;; let euclid = WhileDo (Not (Eq (Loc x, Loc y)), If (Leq (Loc x, Loc y), Assign (y, Minus (Loc y, Loc x)), Assign (x, Minus (Loc x, Loc y)))) ;; (* sigma_0: state *) let sigma_0 (x:loc) = 0 ;; (* update: state * num * loc -> state *) (* (update (sigma, m, X) Y) same as sigma[m/X](Y) *) let update ((sigma:state), (m:num), (x:loc)) (y:loc) = if y = x then m else sigma y ;; let sigma' = update(sigma_0, 2, "l1") ;; sigma' "l1" ;; sigma' "l2" ;; sigma' "h3" ;; (* aEval: aExpr * state -> num *) (* (aEval (a, sigma)) = n iff -> n *) let rec aEval conf = match conf with (* -> sigma(X) *) (Loc x, sigma) -> sigma x (* -> n *) | (Num n, _) -> n (* -> n0 -> n1 ------------------------------------- -> n where n is the sum of n0 and n2 *) | (Plus (a0,a1), sigma) -> let n0 = aEval (a0, sigma) in let n1 = aEval (a1, sigma) in n0 + n1 | (Minus (a0,a1), sigma) -> let n0 = aEval (a0, sigma) in let n1 = aEval (a1, sigma) in n0 - n1 | (Times (a0,a1), sigma) -> let n0 = aEval (a0, sigma) in let n1 = aEval (a1, sigma) in n0 * n1 ;; let x = "l1" ;; let sigma = update(sigma_0, 2, x) ;; let a = Times (Plus (Num 3, Loc x), Minus (Num 11, Num 2)) (* (3 + X) * (11 - 2)) *) ;; (* -> 45 *) aEval (a, sigma) = 45;; aEval (a, sigma) ;; (* bEval: bExpr * state -> truthValue *) (* (bEval (b, sigma)) = t iff -> t *) let rec bEval conf = match conf with (Atom t, _) -> t | (Eq (a0, a1), sigma) -> let n = aEval (a0, sigma) in let m = aEval (a1, sigma) in n = m | (Leq (a0, a1), sigma) -> let n = aEval (a0, sigma) in let m = aEval (a1, sigma) in n <= m | (Not b, sigma) -> (match bEval (b, sigma) with true -> false | _ -> true ) | (And (b0, b1), sigma) -> (match (bEval (b0, sigma), bEval (b1, sigma)) with (true, true) -> true | _ -> false ) | (Or (b0, b1), sigma) -> (match (bEval (b0, sigma), bEval (b1, sigma)) with (false, false) -> false | _ -> true ) (* cEval: comm * state -> state *) (* (aEval (c, sigma)) = sigma' iff -> sigma' *) let rec cEval conf = match conf with (* -> sigma *) (Skip, sigma) -> sigma (* -> n ----------------------------- -> sigma[n/X] *) | (Assign (x, a), sigma) -> let m = aEval (a, sigma) in update (sigma, m, x) (* -> sigma'' -> sigma' ---------------------------- -> sigma' *) | (Seq (c0, c1), sigma) -> let sigma'' = cEval (c0, sigma) in let sigma' = cEval (c1, sigma'') in sigma' | (If (b, c0, c1), sigma) -> (match (bEval (b, sigma)) with true -> let sigma' = cEval (c0, sigma) in sigma' | false -> let sigma' = cEval (c1, sigma) in sigma' ) | (WhileDo (b, c), sigma) -> (match (bEval (b, sigma)) with true -> let sigma'' = cEval (c, sigma) in let sigma' = cEval (WhileDo (b, c), sigma'') in sigma' | false -> sigma ) | (Print x, sigma) -> print_string (x ^ " = ") ; print_int (sigma x) ; print_string " \n" ; sigma ;; let x = "l1" ;; let y = "l2" ;; let euclid = WhileDo (Not (Eq (Loc x, Loc y)), If (Leq (Loc x, Loc y), Assign (y, Minus (Loc y, Loc x)), Assign (x, Minus (Loc x, Loc y)))) ;; let program = Seq (Assign (x, Num 12), Seq (Assign (y, Num 17), Seq (euclid, Seq (Print x, Print y)))) ;; let sigma = cEval (program, sigma_0) ;;