SM/Stmt

regression/Makefile

@@ -15,10 +15,10 @@ all: .depend $(TOPFILE).opt
 	$(OCAMLDEP) $(PXFLAGS) *.ml > .depend
 
 $(TOPFILE).opt: $(SOURCES:.ml=.cmx)
-	$(OCAMLOPT) -o $(TOPFILE).opt $(OFLAGS) $(LIBS:.cma=.cmxa) ostap.cmx Expr.cmx Embedding.cmx $(SOURCES:.ml=.cmx)
+	$(OCAMLOPT) -o $(TOPFILE).opt $(OFLAGS) $(LIBS:.cma=.cmxa) ostap.cmx Syntax.cmx Embedding.cmx SM.cmx $(SOURCES:.ml=.cmx)
 
 $(TOPFILE).byte: $(SOURCES:.ml=.cmo)
-	$(OCAMLC) -o $(TOPFILE).byte $(BFLAGS) $(LIBS) ostap.cmo Expr.cmo Embedding.cmo $(SOURCES:.ml=.cmo) 
+	$(OCAMLC) -o $(TOPFILE).byte $(BFLAGS) $(LIBS) ostap.cmo Syntax.cmo Embedding.cmo SM.cmo $(SOURCES:.ml=.cmo) 
 
 clean:
 	rm -Rf *.cmi *.cmo *.cmx *.annot *.o *.opt *.byte *~

regression/common.ml

@@ -1,6 +1,16 @@
 open GT
-open Expr
+open Syntax
+       
+let conj = (&&)
+             
 open Embedding
 
-let state ps = List.fold_right (fun (x, v) s -> update x v s) ps empty
-let eval s e = Printf.printf "%d\n" (eval s e)
+let state ps = List.fold_right (fun (x, v) (s, p) -> Expr.update x v s, (x =:= !? v) :: p) ps (Expr.empty, [])
+let eval  (s, p) e =
+  let orig      = Expr.eval s e in
+  let stmt      = List.fold_right (fun p s -> p |> s) p (Stmt.Write e) in
+  let [s_orig]  = eval [] stmt in
+  let [sm_orig] = SM.run [] (SM.compile stmt) in
+  if conj (orig = s_orig) (orig = sm_orig)
+  then Printf.printf "%d\n" orig
+  else Printf.printf "*** divergence: %d <?> %d <?> %d\n" orig s_orig sm_orig

regression/test.sh

@@ -1 +1,2 @@
+make clean
 make TOPFILE=test000

src/Embedding.ml

@@ -4,14 +4,14 @@
 open GT
        
 (* Opening the substrate module for convenience. *)
-open Expr
+open Syntax
 
 (* Shortcuts for leaf constructors *)
-let ( ! ) x = Var x
-let ( !? ) n = Const n
+let ( ! ) x = Expr.Var x
+let ( !? ) n = Expr.Const n
 
 (* Implementation of operators *)
-let binop op x y = Binop (op, x, y)
+let binop op x y = Expr.Binop (op, x, y)
                          
 let ( +  ) = binop "+"
 let ( -  ) = binop "-"
@@ -27,14 +27,13 @@ let ( != ) = binop "!="
 let ( && ) = binop "&&"
 let ( || ) = binop "!!"
 
+let ( =:= ) x e = Stmt.Assign (x, e)
+let read  x = Stmt.Read x
+let write e = Stmt.Write e
+let (|>) x y = Stmt.Seq (x, y)
+                             
 (* Some predefined names for variables *)
 let x = !"x"
 let y = !"y"
 let z = !"z"
 let t = !"t"
-
-(* Voila; comment this out before submitting the solution 
-let _ =
-  List.iter (fun e -> Printf.printf "eval s (%s) = %d\n" (show(expr) e) (eval s e)) [x+y*z- !?3; t-z+y && x]
-*)
-                   

src/Makefile

@@ -2,7 +2,7 @@ TOPFILE = rc
 OCAMLC = ocamlc
 OCAMLOPT = ocamlopt
 OCAMLDEP = ocamldep
-SOURCES = Expr.ml Embedding.ml
+SOURCES = Syntax.ml Embedding.ml SM.ml
 LIBS = GT.cma unix.cma re.cma re_emacs.cma re_str.cma
 CAMLP5 = -pp "camlp5o -I `ocamlfind -query GT.syntax` -I `ocamlfind -query ostap.syntax` pa_ostap.cmo pa_gt.cmo -L `ocamlfind -query GT.syntax`"
 PXFLAGS = $(CAMLP5)

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]

src/Syntax.ml

@@ -0,0 +1,108 @@
+(* Opening a library for generic programming (https://github.com/dboulytchev/GT).
+   The library provides "@type ..." syntax extension and plugins like show, etc.
+*)
+open GT 
+    
+(* Simple expressions: syntax and semantics *)
+module Expr =
+  struct
+    
+    (* The type for expressions. Note, in regular OCaml there is no "@type..." 
+       notation, it came from GT. 
+    *)
+    @type t =
+    (* integer constant *) | Const of int
+    (* variable         *) | Var   of string
+    (* binary operator  *) | Binop of string * t * t with show
+
+    (* Available binary operators:
+        !!                   --- disjunction
+        &&                   --- conjunction
+        ==, !=, <=, <, >=, > --- comparisons
+        +, -                 --- addition, subtraction
+        *, /, %              --- multiplication, division, reminder
+    *)
+                                                            
+    (* State: a partial map from variables to integer values. *)
+    type state = string -> int 
+
+    (* Empty state: maps every variable into nothing. *)
+    let empty = fun x -> failwith (Printf.sprintf "Undefined variable %s" x)
+
+    (* Update: non-destructively "modifies" the state s by binding the variable x 
+      to value v and returns the new state.
+    *)
+    let update x v s = fun y -> if x = y then v else s y
+
+    (* Expression evaluator
+
+          val eval : state -> t -> int
+ 
+       Takes a state and an expression, and returns the value of the expression in 
+       the given state.
+     *)
+                                                       
+    let to_func op =
+      let bti   = function true -> 1 | _ -> 0 in
+      let itb b = b <> 0 in
+      let (|>) f g   = fun x y -> f (g x y) in
+      match op with
+      | "+"  -> (+)
+      | "-"  -> (-)
+      | "*"  -> ( * )
+      | "/"  -> (/)
+      | "%"  -> (mod)
+      | "<"  -> bti |> (< )
+      | "<=" -> bti |> (<=)
+      | ">"  -> bti |> (> )
+      | ">=" -> bti |> (>=)
+      | "==" -> bti |> (= )
+      | "!=" -> bti |> (<>)
+      | "&&" -> fun x y -> bti (itb x && itb y)
+      | "!!" -> fun x y -> bti (itb x || itb y)
+      | _    -> failwith (Printf.sprintf "Unknown binary operator %s" op)    
+    
+    let rec eval st expr =      
+      match expr with
+      | Const n -> n
+      | Var   x -> st x
+      | Binop (op, x, y) -> to_func op (eval st x) (eval st y)
+
+  end
+                    
+(* Simple statements: syntax and sematics *)
+module Stmt =
+  struct
+
+    (* The type for statements *)
+    @type t =
+    (* read into the variable           *) | Read   of string
+    (* write the value of an expression *) | Write  of Expr.t
+    (* assignment                       *) | Assign of string * Expr.t
+    (* composition                      *) | Seq    of t * t with show
+
+    (* The type of configuration: a state, an input stream, an output stream *)
+    type config = Expr.state * int list * int list 
+
+    (* Statement evaluator
+
+          val eval : config -> t -> config
+
+       Takes a configuration and a statement, and returns another configuration
+    *)
+    let rec eval ((st, i, o) as conf) stmt =
+      match stmt with
+      | Read    x       -> (match i with z::i' -> (Expr.update x z st, i', o) | _ -> failwith "Unexpected end of input")
+      | Write   e       -> (st, i, o @ [Expr.eval st e])
+      | Assign (x, e)   -> (Expr.update x (Expr.eval st e) st, i, o)
+      | Seq    (s1, s2) -> eval (eval conf s1) s2
+                                                         
+  end
+
+(* Top-level evaluator
+
+     val eval : int list -> Stmt.t -> int list
+
+   Takes an input stream, a program, and returns the output stream this program calculates
+ *)
+let eval i p = let _, _, o = Stmt.eval (Expr.empty, i, []) p in o