SM/Stmt

src/SM.ml

@@ -0,0 +1,66 @@
+open GT       
+open Syntax
+       
+(* The type for the stack machine instructions *)
+@type insn =
+(* binary operator                 *) | BINOP of string
+(* read to stack                   *) | READ
+(* write from stack                *) | WRITE
+(* put a constant of the stack     *) | CONST of int
+(* load a variable to the stack    *) | LD    of string
+(* store a variable from the stack *) | ST    of string with show
+
+(* The type for the stack machine program *)                                                               
+type prg = insn list
+
+(* The type for the stack machine configuration: a stack and a configuration from statement
+   interpreter
+ *)
+type config = int list * Stmt.config
+
+(* Stack machine interpreter
+
+     val eval : config -> prg -> config
+
+   Takes a configuration and a program, and returns a configuration as a result
+ *)                         
+let rec eval ((stack, ((st, i, o) as c)) as conf) = function
+| [] -> conf
+| insn :: prg' ->
+   eval 
+     (match insn with
+      | BINOP op -> let y::x::stack' = stack in (Expr.to_func op x y :: stack', c)
+      | READ     -> let z::i'        = i     in (z::stack, (st, i', o))
+      | WRITE    -> let z::stack'    = stack in (stack', (st, i, o @ [z]))
+      | CONST i  -> (i::stack, c)
+      | LD x     -> (st x :: stack, c)
+      | ST x     -> let z::stack'    = stack in (stack', (Expr.update x z st, i, o))
+     ) prg'
+
+(* Top-level evaluation
+
+     val run : int list -> prg -> int list
+
+   Takes an input stream, a program, and returns an output stream this program calculates
+ *)
+let run i p = let (_, (_, _, o)) = eval ([], (Expr.empty, i, [])) p in o
+                                                                         
+(* Stack machine compiler
+
+     val compile : Stmt.t -> prg
+
+   Takes a program in the source language and returns an equivalent program for the
+   stack machine
+ *)
+
+let rec compile =
+  let rec expr = function
+  | Expr.Var   x          -> [LD x]
+  | Expr.Const n          -> [CONST n]
+  | Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
+  in
+  function
+  | Stmt.Seq (s1, s2)  -> compile s1 @ compile s2
+  | Stmt.Read x        -> [READ; ST x]
+  | Stmt.Write e       -> expr e @ [WRITE]
+  | Stmt.Assign (x, e) -> expr e @ [ST x]