All operations

Driver.ml

@@ -0,0 +1,60 @@
+open Language
+open Expr
+open Stmt
+open Ostap
+open GT
+
+ostap (
+  expr : expr "+" expr 
+)
+
+let rec parse s =                                                                                    
+	expr id
+	  [|                                                                                            
+	    left , [ostap ("+"), (fun x y -> `Add (x, y)); ostap ("-"), (fun x y -> `Sub (x, y))]; 
+	    left , [ostap ("*"), (fun x y -> `Mul (x, y)); ostap ("/"), (fun x y -> `Div (x, y))]  
+	  |]                                                                                            
+	  primary                                                                                       
+	  s                                                                                             
+	and ostap (primary:  	  n: DECIMAL {Const n}
+			 	| e:IDENT {Var e}	
+				| -"(" parse -")")       
+
+ostap (
+  simp: x:IDENT ":=" e:expr     {Assign (x, e)}
+      | %"read" "(" x:IDENT ")" {Read x}
+      | %"write" "(" e:expr ")" {Write e}
+      | %"skip"                 {Skip};
+
+  stmt: s:simp ";" d:stmt {Seq (s,d)}
+      | simp 
+)
+
+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"
+       ] s
+    end)
+    (ostap (stmt -EOF))
+
+let _ =
+  match Sys.argv with
+  | [|_; filename|] ->
+      match parse filename with
+      | `Ok stmt -> 
+        let basename = Filename.chop_suffix filename ".expr" in      
+        let text = X86.compile stmt in
+        Printf.printf "%s\n" (show (Stmt.t) stmt);
+        let asm  = basename ^ ".s" in
+        let ouch = open_out asm   in
+      Printf.fprintf ouch "%s\n" text;
+      close_out ouch;
+        let runtime = try Sys.getenv "RUNTIME" with _ -> "../runtime" in
+        ignore @@ Sys.command (Printf.sprintf "gcc -m32 -o %s %s/runtime.o %s.s" basename runtime basename)
+      | `Fail e -> Printf.eprintf "Parsing error: %s\n" e

Driver.ml~

@@ -0,0 +1,59 @@
+open Language
+open Expr
+open Stmt
+open Ostap
+open GT
+
+ostap (
+  expr : expr "+" expr 
+)
+
+ostap (
+  expr: x:mull "+" y:expr {Add (x,y)} 
+      | mull;
+  mull: x:prim "*" y:mull {Mul (x,y)}
+      | prim; 
+  prim: n:DECIMAL {Const n}  
+      | e:IDENT   {Var e}
+      | -"(" expr -")"
+(*       | "(" e:expr ")" {e} *)
+)
+
+ostap (
+  simp: x:IDENT ":=" e:expr     {Assign (x, e)}
+      | %"read" "(" x:IDENT ")" {Read x}
+      | %"write" "(" e:expr ")" {Write e}
+      | %"skip"                 {Skip};
+
+  stmt: s:simp ";" d:stmt {Seq (s,d)}
+      | simp 
+)
+
+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"
+       ] s
+    end)
+    (ostap (stmt -EOF))
+
+let _ =
+  match Sys.argv with
+  | [|_; filename|] ->
+      match parse filename with
+      | `Ok stmt -> 
+        let basename = Filename.chop_suffix filename ".expr" in      
+        let text = X86.compile stmt in
+        Printf.printf "%s\n" (show (Stmt.t) stmt);
+        let asm  = basename ^ ".s" in
+        let ouch = open_out asm   in
+      Printf.fprintf ouch "%s\n" text;
+      close_out ouch;
+        let runtime = try Sys.getenv "RUNTIME" with _ -> "../runtime" in
+        ignore @@ Sys.command (Printf.sprintf "gcc -m32 -o %s %s/runtime.o %s.s" basename runtime basename)
+      | `Fail e -> Printf.eprintf "Parsing error: %s\n" e

Makefile

@@ -1,7 +1,7 @@
 MKDIR ?= mkdir -vp
 CP    ?= cp
 
-OB=ocamlbuild -cflag -g -no-hygiene -use-ocamlfind -plugin-tag "package(str)" -classic-display
+OB=ocamlbuild -cflag -g -no-hygiene -use-ocamlfind  -plugin-tag "package(str)" -classic-display
 ifdef OBV
 OB += -verbose 6
 endif

Makefile~

@@ -0,0 +1,25 @@
+MKDIR ?= mkdir -vp
+CP    ?= cp
+
+OB=ocamlbuild -cflag -g -no-hygiene -use-ocmalfind  -plugin-tag "package(str)" -classic-display
+ifdef OBV
+OB += -verbose 6
+endif
+
+BYTE_TARGETS=src/rc.byte 
+NATIVE_TARGETS=src/rc.native
+
+.PHONY: all clean runtime
+
+.DEFAULT_GOAL: all
+
+all: main runtime
+
+runtime:
+	cd runtime && make all && cd ..
+
+main:
+	$(OB) -Is src $(BYTE_TARGETS) $(NATIVE_TARGETS)
+
+clean: 
+	cd runtime && make clean && cd .. && $(RM) -r _build *.log  *.native *.byte

_build/_digests

@@ -0,0 +1,9 @@
+"Resource: /home/roma/\208\151\208\176\208\179\209\128\209\131\208\183\208\186\208\184/eltech_compilers/src/StackMachine.ml": "i17\002hfm$\158 \221\186\130\181\134\127"
+"Rule: ocaml dependencies ml (%=src/rc )": "\000\2340\188\135\185\204\229\241XR\186\165\222\bT"
+"Rule: ocaml dependencies ml (%=src/Driver )": "\190\250\150\140r90\029&ee\136g\004\147U"
+"Rule: ocaml dependencies ml (%=src/Interpret )": "\163*\147\246C\144}\246R2\206\"\132\236~z"
+"Resource: /home/roma/\208\151\208\176\208\179\209\128\209\131\208\183\208\186\208\184/eltech_compilers/src/Language.ml": "e?R\221\234\1277\156\020eR\215\nE\254\233"
+"Resource: /home/roma/\208\151\208\176\208\179\209\128\209\131\208\183\208\186\208\184/eltech_compilers/src/Interpret.ml": "\20969\195\2154\202\150M\143v\185\\\245\236Y"
+"Resource: /home/roma/\208\151\208\176\208\179\209\128\209\131\208\183\208\186\208\184/eltech_compilers/src/rc.ml": "\1925m\003\2304M\252\t\212\022\151\002\167\151\245"
+"Resource: /home/roma/\208\151\208\176\208\179\209\128\209\131\208\183\208\186\208\184/eltech_compilers/src/Driver.ml": "F95\195\227\028A^\151:\225F\186\153vL"
+"Rule: ocaml dependencies ml (%=src/StackMachine )": "T\205\210?\214\132\232\240\216\0074\196p\153\228v"

_build/_log

@@ -0,0 +1,2 @@
+### Starting build.
+# Compilation unsuccessful.

_build/ocamlc.where

@@ -0,0 +1 @@
+/usr/lib/ocaml

_build/src/Driver.ml

@@ -0,0 +1,53 @@
+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"; "then"; "else"; "elif"; "fi";
+				   "for"; "while"; "do"; "od"; "repeat"; "until"] 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"
+

_build/src/Driver.ml.depends

@@ -0,0 +1 @@
+src/Driver.ml: Array Expr Filename Interpret Language List Matcher Ostap Printf StackMachine Stmt Sys Util X86

_build/src/Interpret.ml

@@ -0,0 +1,95 @@
+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
+      | Sub  (x, y) -> eval' x - eval' y
+      | Div  (x, y) -> eval' x / eval' y
+      | Mod  (x, y) -> eval' mod eval' y
+      | And  (x, y) -> if( (eval' x) == 1 && (eval' y) == 1) 
+		               then 1 
+		       else 0
+      | Or   (x, y) -> if( (eval' x) == 0 && (eval' y) == 0)
+		           then 0
+		       else 1
+      | Equals (x, y) -> if( (eval' x) == (eval' y))
+	                      then 1
+			 else 0
+      | NotEquals (x, y) -> if( (eval' x) == (eval' y))
+	                        then 0
+			    else 1
+      | Greater  (x, y) -> if( (eval' x) > (eval' y))
+	                       then 1
+			   else 0
+      | Less  (x, y) -> if( (eval' x) < (eval' y))
+	                    then 1
+			else 0
+      | GreaterEquals  (x, y) -> if( (eval' x) < (eval' y))
+	                             then 0
+				 else 1
+      | LessEquals  (x, y) -> if( (eval' x) > (eval' y))
+	                          then 0
+			      else 1
+
+
+  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 
+      | If (expr, then_part, else_part) ->
+            if (Expr.eval expr st) != 0
+                 then eval then_part conf
+            else eval else_part conf
+      | While (expr, value) ->
+           let rec loop expr' value' ( (st', _, _) as conf') =
+               if (Expr.eval expr' st') != 0
+                  then loop expr' value' (eval value' conf')
+               else conf'
+           in
+           loop expr value conf    
+      | Until (value, expr) ->
+            let rec loop expr' value' conf' = 
+                let (st_new, _, _) as conf_new = eval value' conf' in
+                if (Expr.eval expr' st_new) == 0
+                     then loop expr' value' conf_new
+                else conf_new
+            in
+            loop expr value c
+  end
+
+module Program =
+  struct
+
+    let eval p input = 
+      let (_, _, output) = 
+	Stmt.eval p ((fun _ -> failwith "undefined variable"), input, []) 
+      in
+      output
+
+  end

_build/src/Interpret.ml.depends

@@ -0,0 +1 @@
+src/Interpret.ml: Expr Language Stmt