Yuri Voevodin 2303

regression/Makefile

@@ -1,4 +1,4 @@
-TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 test009 test010 test011 test014 test015 test016 test017 test018 
+TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 test009 test010  test014 test015 test016 test017 test018 
 
 # test019 test020 test021 test022 test023 test024 test025 test026 
 # test027 test028 test029 test030 

src/Driver.ml

@@ -1,51 +1,51 @@
-open Language
-open Expr
-open Stmt
-open Ostap
-
-let parse filename = 
-  let s = Util.read filename in
-  Util.parse 
-    (object 
-       inherit Matcher.t s 
-       inherit Util.Lexers.ident ["read"; "write"; "skip"] s
-       inherit Util.Lexers.decimal s
-       inherit Util.Lexers.skip [
-         Matcher.Skip.whitespaces " \t\n";
-	 Matcher.Skip.lineComment "--";
-	 Matcher.Skip.nestedComment "(*" "*)"
-       ] s
-    end)
-    (ostap (!(Stmt.parse) -EOF))
-
-let main =
-  try
-    let interpret  = Sys.argv.(1) = "-i"  in
-    let stack      = Sys.argv.(1) = "-s"  in
-    let to_compile = not (interpret || stack) in
-    let infile     = Sys.argv.(if not to_compile then 2 else 1) in
-    match parse infile with
-    | `Ok prog ->
-      if to_compile
-      then 
-        let basename = Filename.chop_suffix infile ".expr" in
-        ignore @@ X86.build prog basename
-      else 
-	let rec read acc =
-	  try
-	    let r = read_int () in
-	    Printf.printf "> ";
-	    read (acc @ [r]) 
-          with End_of_file -> acc
-	in
-	let input = read [] in	
-	let output = 
-	  if interpret 
-	  then Interpret.Program.eval prog input 
-	  else StackMachine.Interpret.run (StackMachine.Compile.Program.compile prog) input
-	in
-	List.iter (fun i -> Printf.printf "%d\n" i) output
-    | `Fail er -> Printf.eprintf "Syntax error: %s\n" er
-  with Invalid_argument _ ->
-    Printf.printf "Usage: rc [-i] <input file.expr>\n"
-
+open Language
+open Expr
+open Stmt
+open Ostap
+
+let parse filename = 
+  let s = Util.read filename in
+  Util.parse 
+    (object 
+       inherit Matcher.t 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";
+	 Matcher.Skip.lineComment "--";
+	 Matcher.Skip.nestedComment "(*" "*)"
+       ] s
+    end)
+    (ostap (!(Stmt.parse) -EOF))
+
+let main =
+  try
+    let interpret  = Sys.argv.(1) = "-i"  in
+    let stack      = Sys.argv.(1) = "-s"  in
+    let to_compile = not (interpret || stack) in
+    let infile     = Sys.argv.(if not to_compile then 2 else 1) in
+    match parse infile with
+    | `Ok prog ->
+      if to_compile
+      then 
+        let basename = Filename.chop_suffix infile ".expr" in
+        ignore @@ X86.build prog basename
+      else 
+	let rec read acc =
+	  try
+	    let r = read_int () in
+	    Printf.printf "> ";
+	    read (acc @ [r]) 
+          with End_of_file -> acc
+	in
+	let input = read [] in	
+	let output = 
+	  if interpret 
+	  then Interpret.Program.eval prog input 
+	  else StackMachine.Interpret.run (StackMachine.Compile.Program.compile prog) input
+	in
+	List.iter (fun i -> Printf.printf "%d\n" i) output
+    | `Fail er -> Printf.eprintf "Syntax error: %s\n" er
+  with Invalid_argument _ ->
+    Printf.printf "Usage: rc [-i] <input file.expr>\n"
+

src/Interpret.ml

@@ -1,49 +1,52 @@
-open Language
-
-(* Interpreter for expressions *)
-module Expr =
-  struct
-
-    open Expr
-
-    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
-
-  end
-
-(* Interpreter for statements *)
-module Stmt =
-  struct
-
-    open Stmt
-
-    (* State update primitive *) 
-    let update st x v = fun y -> if y = x then v else st y 
-
-    let rec eval stmt ((st, input, output) as conf) =
-      match stmt with
-      | Skip          -> conf
-      | Assign (x, e) -> (update st x (Expr.eval e st), input, output)
-      | Read    x     -> 
-	  let z :: input' = input in 
-          (update st x z, input', output)
-      | Write   e     -> (st, input, output @ [Expr.eval e st])
-      | Seq (s1, s2)  -> eval s1 conf |> eval s2 
-
-  end
-
-module Program =
-  struct
-
-    let eval p input = 
-      let (_, _, output) = 
-	Stmt.eval p ((fun _ -> failwith "undefined variable"), input, []) 
-      in
-      output
-
-  end
+open Language
+
+(* Interpreter for expressions *)
+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
+      | Binop  (op, x, y) -> (apply op) (eval' x) (eval' y)
+
+  end
+
+(* Interpreter for statements *)
+module Stmt =
+  struct
+
+    open Stmt
+
+    (* State update primitive *) 
+    let update st x v = fun y -> if y = x then v else st y 
+
+    let rec eval stmt ((st, input, output) as conf) =
+      match stmt with
+      | Skip          -> conf
+      | Assign (x, e) -> (update st x (Expr.eval e st), input, output)
+      | Write   e     -> (st, input, output @ [Expr.eval e st])
+      | Seq (s1, s2)  -> eval s1 conf |> eval s2 
+      | Read    x     -> 
+	  let z :: input' = input in
+	  (update st x z, input', output)
+      | If (e, s1, s2) -> if (Expr.eval e st) <> 0 then (eval s1 conf) else (eval s2 conf)
+      (*eval self again but with new conf (which is eval'ed body of while')*)
+      | While (e, s)   -> if (Expr.eval e st) <> 0 then eval stmt (eval s conf) else conf
+
+  end
+
+module Program =
+  struct
+
+    let eval p input = 
+      let (_, _, output) = 
+	Stmt.eval p ((fun _ -> failwith "undefined variable"), input, []) 
+      in
+      output
+
+  end

src/Language.ml

@@ -1,54 +1,125 @@
-(* AST for expressions *)
-module Expr =
-  struct
-
-    type t =
-    | Var   of string
-    | Const of int
-    | Add   of t * t
-    | Mul   of 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 -")" 
-    )
-
-  end
-
-(* AST statements/commands *)
-module Stmt =
-  struct
-
-    type t =
-    | Skip
-    | Assign of string * Expr.t
-    | Read   of string
-    | Write  of Expr.t
-    | Seq    of t * 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};
-
-      parse: s:simp ";" d:parse {Seq (s,d)} | simp 
-    )
-
-  end
-
-module Program =
-  struct
-
-    type t = Stmt.t
-
-    let parse = Stmt.parse
-
-  end
-
+open Ostap 
+open Matcher
+
+module Expr =
+  struct
+
+    type t =
+    | Var   of string
+    | Const of int
+    | Binop of string * t * t
+
+    ostap (
+      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
+
+(* AST statements/commands *)
+module Stmt =
+  struct
+
+    type t =
+    | Skip
+    | Assign of string * Expr.t
+    | 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}
+      | %"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
+
+    type t = Stmt.t
+
+    let parse = Stmt.parse
+
+  end
+