Trivial Language w/ Memory

language.sml

datatype expr = LIT   of int
              | PLUS  of expr * expr
              | TIMES of expr * expr
              | VAR   of string;

datatype stmt = SKIP
              | ASSIGN   of string * expr
              | SEQ      of stmt * stmt
              | PRINT    of expr
              | IFPOS    of expr * stmt * stmt
              | UNTILPOS of expr * stmt;

type memory = string -> int;
type output = int list;

fun sExpr e (m:memory) = case e of
      LIT n         => n
    | PLUS  (e1,e2) => sExpr e1 m + sExpr e2 m
    | TIMES (e1,e2) => sExpr e1 m * sExpr e2 m
    | VAR x         => m x;

fun sStmt s m : (memory * output) = case s of
      SKIP           => (m,[])
    | ASSIGN (x, e)   => (fn n => if x = n then sExpr e m else m n ,[])
    | PRINT   e      => (m, [sExpr e m])
    | SEQ    (s1,s2) => let
            val (m1,o1:output) = sStmt s1 m;
            val (m2,o2)        = sStmt s2 m1;
        in 
            (m2,o1 @ o2)
	  end
    | IFPOS (e0, s1, s2) => if sExpr e0 m > 0 then sStmt s1 m else sStmt s2 m
	| UNTILPOS (e, s)    => sStmt (IFPOS (e,SKIP, SEQ(s,UNTILPOS (e, s)))) m
	
val empty : memory = (fn _ => 0);

fun SUB (e1,e2) = PLUS(e1,TIMES(e2,LIT(~1)));

val gcd = SEQ(ASSIGN("done",LIT(0)),
              UNTILPOS(VAR("done"),
                SEQ(ASSIGN("d",SUB(VAR("a"),VAR("b"))),
                    SEQ(PRINT(VAR("d")),
                        IFPOS(VAR("d"),
                              ASSIGN("a",VAR("d")),
                              SEQ(ASSIGN("d",TIMES(LIT(~1),VAR("d"))),
                                  IFPOS(VAR("d"),
                                        ASSIGN("b",VAR("d")),
				        ASSIGN("done",LIT(1)))))))));

val prog = SEQ(ASSIGN("a",LIT(12)),
               SEQ(ASSIGN("b",LIT(20)),
                   SEQ(gcd,
                       PRINT(VAR("a")))));
                       
val run = sStmt prog empty;