Implement all binops

.travis-opam.sh

@@ -0,0 +1,37 @@
+echo -en "travis_fold:start:prepare.ci\r"
+# If a fork of these scripts is specified, use that GitHub user instead
+fork_user=${FORK_USER:-ocaml}
+
+# If a branch of these scripts is specified, use that branch instead of 'master'
+fork_branch=${FORK_BRANCH:-master}
+
+### Bootstrap
+
+set -uex
+
+get() {
+  wget https://raw.githubusercontent.com/${fork_user}/ocaml-ci-scripts/${fork_branch}/$@
+}
+
+TMP_BUILD=$(mktemp -d 2>/dev/null || mktemp -d -t 'citmpdir')
+cd ${TMP_BUILD}
+
+get .travis-ocaml.sh
+get yorick.mli
+get yorick.ml
+get ci_opam.ml
+
+sh .travis-ocaml.sh
+export OPAMYES=1
+eval $(opam config env)
+
+# This could be removed with some OPAM variable plumbing into build commands
+opam install ocamlfind
+
+ocamlc.opt yorick.mli
+ocamlfind ocamlc -c yorick.ml
+
+ocamlfind ocamlc -o ci-opam -package unix -linkpkg yorick.cmo ci_opam.ml
+cd -
+
+echo -en "travis_fold:end:prepare.ci\r"

.travis.yml

@@ -0,0 +1,9 @@
+language: c 
+sudo: required 
+script:
+  - bash -ex .travis-opam.sh
+  - ./installBuildRun.sh
+env:
+  - OCAML_VERSION=4.04
+os:
+  - linux

installBuildRun.sh

@@ -0,0 +1,14 @@
+opam pin add GT https://github.com/Kakadu/GT.git -n -y
+opam pin add ostap https://github.com/dboulytchev/ostap.git -n -y
+opam install camlp5 -y
+opam install GT ostap ocamlfind -y
+eval `opam config env`
+sudo apt-get install gcc-multilib -y
+
+make
+
+cd regression
+make
+
+cd deep-expressions
+make

regression/Makefile

@@ -1,7 +1,4 @@
-TESTS=test001 test002 test012 test013 
-
-# More expressions:
-# test003 test004 test005 test006 test007 test008 
+TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 
 
 # Later:
 # test009 test010 test 11

src/Driver.ml

@@ -8,7 +8,7 @@ let parse filename =
   Util.parse 
     (object 
        inherit Matcher.t s 
-       inherit Util.Lexers.ident ["read"; "write"; "skip"] s
+       inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "fi"; "then"; "else"; "while"; "do"; "od"; "repeat"; "until"; "for"] s
        inherit Util.Lexers.decimal s
        inherit Util.Lexers.skip [
          Matcher.Skip.whitespaces " \t\n";

src/Interpret.ml

@@ -5,14 +5,14 @@ module Expr =
   struct
 
     open Expr
+    open Language.BinOp
 
     let rec eval expr st = 
       let eval' e = eval e st in
       match expr with
       | Var   x     -> st x
       | Const z     -> z
-      | Add  (x, y) -> eval' x + eval' y
-      | Mul  (x, y) -> eval' x * eval' y
+      | Binop  (op, x, y) -> (apply op) (eval' x) (eval' y)
 
   end
 
@@ -34,6 +34,9 @@ module Stmt =
 	  (update st x z, input', output)
       | Write   e     -> (st, input, output @ [Expr.eval e st])
       | Seq (s1, s2)  -> eval s1 conf |> eval s2 
+      | If (e, s1, s2) -> if (Expr.eval state' e) <> 0 then (eval conf s1) else (eval conf s2)
+      (*eval self again but with new conf (which is eval'ed body of while')*)
+      | While (e, s)   -> if (Expr.eval state' e) <> 0 then eval (eval conf s) stmt else conf
 
   end
 

src/Language.ml

@@ -1,20 +1,52 @@
-(* AST for expressions *)
+open Ostap 
+open Matcher
+
 module Expr =
   struct
 
     type t =
     | Var   of string
     | Const of int
-    | Add   of t * t
-    | Mul   of t * t 
+    | Binop of string * t * t
 
     ostap (
-      parse: x:mull "+" y:parse {Add (x,y)} | mull;
-      mull : x:prim "*" y:mull  {Mul (x,y)} | prim; 
-      prim : 
-        n:DECIMAL       {Const n}  
-      | e:IDENT         {Var e}
-      | -"(" parse -")" 
+      parse:
+        orins;
+
+      orins:
+        l:andins suf:(("!!") andins)* {
+           List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf
+        }
+      | andins;
+
+      andins:
+        l:cmp suf:(("&&") cmp)* {
+           List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf
+        }
+      | cmp;
+
+      cmp:
+        l:add suf:(("<=" | "<" | ">=" | ">" | "==" | "!=") add)* {
+           List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf
+        }
+      | add;
+
+      add:
+        l:mull suf:(("+" | "-") mull)* {
+          List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf
+        }
+      | mull;
+
+      mull:
+        l:prim suf:(("*" | "/" | "%") prim)* {
+           List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf
+        }
+      | prim;
+
+      prim:
+        n:DECIMAL {Const n}
+      | x:IDENT   {Var   x}
+      | -"(" parse -")"
     )
 
   end
@@ -29,20 +61,59 @@ module Stmt =
     | Read   of string
     | Write  of Expr.t
     | Seq    of t * t
+    | If     of Expr.t * t * t
+    | While  of Expr.t * t
+    | Repeat of t * Expr.t
 
     let expr = Expr.parse
 
     ostap (
       simp: x:IDENT ":=" e:expr  {Assign (x, e)}
       | %"read"  "(" x:IDENT ")" {Read x}
       | %"write" "(" e:expr  ")" {Write e}
-      | %"skip"                  {Skip};
-
+      | %"skip"                  {Skip}
+      | %"if"        e:!(Expr.parse)
+        %"then"      s1:!(parse)
+        %"else"      s2:!(parse)
+        %"fi"                            {If (e, s1, s2)}
+      | %"if"        e:!(Expr.parse)
+        %"then"      s1:!(parse)
+        %"fi"                            {If (e, s1, Skip)}
+      | %"while"     e:!(Expr.parse)
+        %"do"        s:!(parse)
+        %"od"                            {While (e, s)}
+      | %"repeat"    s:!(parse)
+        %"until"     e:!(Expr.parse)     {Seq (s, While (Binop ("==", e, Const 0), s))}
+      | %"for"       i:!(parse) "," n:!(Expr.parse) "," b:!(parse)
+        %"do"        a:!(parse)
+        %"od"                            {Seq (i, (While (n, Seq (a, b))))};
       parse: s:simp ";" d:parse {Seq (s,d)} | simp 
     )
 
   end
 
+
+module BinOp = 
+    struct
+
+    let apply op =
+      match op with
+      | "+"  -> fun x y -> x + y
+      | "*"  -> fun x y -> x * y
+      | "-"  -> fun x y -> x - y
+      | "/"  -> fun x y -> x / y
+      | "%"  -> fun x y -> x mod y
+      | "<"  -> fun x y -> if x < y then 1 else 0
+      | "<=" -> fun x y -> if x <= y then 1 else 0
+      | ">"  -> fun x y -> if x > y then 1 else 0
+      | ">=" -> fun x y -> if x >= y then 1 else 0
+      | "==" -> fun x y -> if x = y then 1 else 0
+      | "!=" -> fun x y -> if x <> y then 1 else 0
+      | "&&" -> fun x y -> if (x <> 0) && (y <> 0) then 1 else 0
+      | "!!" -> fun x y -> if (x <> 0) || (y <> 0) then 1 else 0
+
+  end
+
 module Program =
   struct
 

src/StackMachine.ml

@@ -8,8 +8,7 @@ module Instr =
       | PUSH of int
       | LD   of string
       | ST   of string
-      | ADD  
-      | MUL
+      | BINOP of string
 
   end
 
@@ -25,6 +24,7 @@ module Interpret =
 
     open Instr
     open Interpret.Stmt
+    open Language.BinOp
 
     let run prg input =
       let rec run' prg ((stack, st, input, output) as conf) =
@@ -41,13 +41,10 @@ module Interpret =
             | LD   x -> (st x :: stack, st, input, output)
 	    | ST   x -> let z :: stack' = stack in
               (stack', update st x z, input, output)
-	    | _ -> let y :: x :: stack' = stack in
-              ((match i with ADD -> (+) | _ -> ( * )) x y :: stack', 
-               st, 
-               input, 
-               output
-              )
-           )
+	    | BINOP op ->
+		  let y::x::stack' = stack in
+                  ((apply op x y)::stack', st, input, output)
+        )
       in
       let (_, _, _, output) = 
 	run' prg ([], 
@@ -72,8 +69,7 @@ module Compile =
 	let rec compile = function 
 	| Var x      -> [LD   x]
 	| Const n    -> [PUSH n]
-	| Add (x, y) -> (compile x) @ (compile y) @ [ADD]
-	| Mul (x, y) -> (compile x) @ (compile y) @ [MUL]
+    | Binop (op, x, y) -> (compile x) @ (compile y) @ [BINOP op]
 
       end