Procedures in interpretation

regression/Makefile

@@ -1,4 +1,4 @@
-TESTS=test001 test002 test003 test004 test005 test006 test007 test008 test009 test010 test011 test012 test013 test014 test015 test016 test017 test018 test019 test020 test021 test022 test023
+TESTS=test001 test002 test003 test004 test005 test006 test007 test008 test009 test010 test011 test012 test013 test014 test015 test016 test017 test018 test019 test020 test021 test022 test023 test024 test025 test026 test027 test028 test029
 
 RC=../src/rc.opt
 
@@ -7,9 +7,9 @@ RC=../src/rc.opt
 check: $(TESTS)
 
 $(TESTS): %: %.expr
-	@$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
+#	@$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
-	@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
+#	@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
 
 clean:
 	rm -f test*.log *.s *~ $(TESTS)

regression/orig/test024.log

@@ -1 +1,2 @@
-> 6765
+> 3
+8

regression/orig/test025.log

@@ -1 +1,12 @@
-> 3628800
+> 1
+100
+200
+300
+2
+100
+200
+300
+3
+100
+200
+300

regression/orig/test026.log

@@ -1 +1,21 @@
-> > 125
+> 1
+100
+200
+300
+100
+200
+300
+2
+100
+200
+300
+100
+200
+300
+3
+100
+200
+300
+100
+200
+300

regression/orig/test027.log

@@ -1,136 +1,35 @@
-73
+> 1
-32
+100
-119
+200
-105
+300
-108
-108
-32
-114
-101
-109
-101
-109
-98
-101
-114
-32
-65
-112
-114
-105
-108
-46
-0
-114
-101
-109
-101
-109
-98
-101
-114
-0
-114
-101
-109
-101
-109
-98
-101
-114
-0
-22
-0
-73
-32
-119
-106
-108
-108
-32
-114
-101
-109
-101
-109
-98
-101
-114
-32
-65
-112
-114
-106
-108
-46
-0
-73
-32
-119
-105
-108
-108
-32
-114
-101
-109
-101
-109
-98
-101
-114
-32
-65
-112
-114
-105
-108
-46
-0
-73
-32
-119
-106
-108
-108
-32
-114
-101
-109
-101
-109
-98
-101
-114
-32
-65
-112
-114
-106
-108
-46
-73
-32
-119
-105
-108
-108
-32
-114
-101
-109
-101
-109
-98
-101
-114
-32
-65
-112
-114
-105
-108
-46
 1
--1
+2
-0
+100
+200
+300
+3
+100
+200
+300
+3
+4
+100
+200
+300
+5
+100
+200
+300
+5
+100
+200
+300
+100
+200
+300
+100
+200
+300
+100
+200
+300

regression/orig/test028.log

@@ -1,2 +1,14 @@
+> 7
+5040
+6
+720
+5
+120
+4
+24
+3
+6
+2
+2
+1
 1
-100

regression/orig/test029.log

@@ -1,10 +1,18 @@
-> > > > > 5
+> 9
-6
+55
-7
+8
+34
+7
+21
+6
+13
+5
 8
-9
-1
-2
-3
 4
 5
+3
+3
+2
+2
+1
+1

regression/test024.expr

@@ -0,0 +1,13 @@
+fun test1 () {
+  a := 3
+}
+
+fun test2 (b) {
+  a := b
+}
+
+test1 ();
+write (a);
+
+test2 (8);
+write (a)

regression/test024.input

@@ -0,0 +1 @@
+0

regression/test025.expr

@@ -0,0 +1,29 @@
+fun test1 (a) {
+  write (a)
+}
+
+fun test2 (b) {
+  write (b)
+}
+
+fun test3 (c) {
+  write (c)
+}
+
+fun print () {
+  write (a);
+  write (b);
+  write (c)
+}
+
+a := 100;
+b := 200;
+c := 300;
+
+test1 (1);
+print ();
+test2 (2);
+print ();
+test3 (3);
+print ()
+

regression/test025.input

@@ -0,0 +1 @@
+0

regression/test026.expr

@@ -0,0 +1,32 @@
+fun test1 (a) {
+  write (a);
+  print ()
+}
+
+fun test2 (b) {
+  write (b);
+  print ()
+}
+
+fun test3 (c) {
+  write (c);
+  print ()
+}
+
+fun print () {
+  write (a);
+  write (b);
+  write (c)
+}
+
+a := 100;
+b := 200;
+c := 300;
+
+test1 (1);
+print ();
+test2 (2);
+print ();
+test3 (3);
+print ()
+

regression/test026.input

@@ -0,0 +1 @@
+0

regression/test027.expr

@@ -0,0 +1,28 @@
+fun print () {
+  write (a);
+  write (b);
+  write (c)
+}
+
+fun test1 (a) {
+  write (a);
+  print ();
+  write (a);
+  if a < 4 then
+     test2 (a+1);
+     print ()
+  fi 
+}
+
+fun test2 (b) {
+  write (b);
+  print ();
+  test1 (b+1);
+  print ()
+}
+
+a := 100;
+b := 200;
+c := 300;
+
+test1 (1)

regression/test027.input

@@ -0,0 +1 @@
+0

regression/test028.expr

@@ -0,0 +1,16 @@
+fun fact (n) {
+  if n <= 1
+  then result := 1
+  else
+    fact (n-1);
+    result := result * n
+  fi
+}
+
+read (n);
+
+for i := n, i >= 1, i := i-1 do
+  fact (i);
+  write (i);
+  write (result)
+od

regression/test028.input

@@ -0,0 +1 @@
+7

regression/test029.expr

@@ -0,0 +1,18 @@
+fun fib (n) local r {
+  if n <= 1
+  then result := 1
+  else
+    fib (n-1);
+    r := result;
+    fib (n-2);
+    result := result + r
+  fi
+}
+
+read (n);
+
+for i := n, i >= 1, i := i-1 do
+  fib (i);
+  write (i);
+  write (result)
+od

regression/test029.input

@@ -0,0 +1 @@
+9

src/Driver.ml

@@ -6,7 +6,7 @@ let parse infile =
     (object
        inherit Matcher.t s
        inherit Util.Lexers.decimal s
-       inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"] s
+       inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"; "fun"; "local"] s
        inherit Util.Lexers.skip [
 	 Matcher.Skip.whitespaces " \t\n";
 	 Matcher.Skip.lineComment "--";
@@ -25,9 +25,11 @@ let main =
     match parse infile with
     | `Ok prog ->
       if to_compile
-      then 
+      then failwith "Not implemented yet"
+        (*            
         let basename = Filename.chop_suffix infile ".expr" in
         ignore @@ X86.build prog basename
+        *)
       else 
 	let rec read acc =
 	  try
@@ -40,7 +42,7 @@ let main =
 	let output = 
 	  if interpret 
 	  then Language.eval prog input 
-	  else SM.run (SM.compile prog) input
+	  else failwith "Not implemented yet" (*SM.run (SM.compile prog) input*)
 	in
 	List.iter (fun i -> Printf.printf "%d\n" i) output
     | `Fail er -> Printf.eprintf "Syntax error: %s\n" er

src/Language.ml

@@ -4,7 +4,38 @@
 open GT
 
 (* Opening a library for combinator-based syntax analysis *)
-open Ostap.Combinators
+open Ostap
+open Combinators
+                         
+(* States *)
+module State =
+  struct
+                                                                
+    (* State: global state, local state, scope variables *)
+    type t = {g : string -> int; l : string -> int; scope : string list}
+
+    (* Empty state *)
+    let empty =
+      let e x = failwith (Printf.sprintf "Undefined variable: %s" x) in
+      {g = e; l = e; scope = []}
+
+    (* Update: non-destructively "modifies" the state s by binding the variable x 
+       to value v and returns the new state w.r.t. a scope
+    *)
+    let update x v s =
+      let u x v s = fun y -> if x = y then v else s y in
+      if List.mem x s.scope then {s with l = u x v s.l} else {s with g = u x v s.g}
+
+    (* Evals a variable in a state w.r.t. a scope *)
+    let eval s x = (if List.mem x s.scope then s.l else s.g) x
+
+    (* Creates a new scope, based on a given state *)
+    let push_scope st xs = {empty with g = st.g; scope = xs}
+
+    (* Drops a scope *)
+    let drop_scope st st' = {st' with g = st.g}
+
+  end
     
 (* Simple expressions: syntax and semantics *)
 module Expr =
@@ -26,17 +57,6 @@ module Expr =
         *, /, %              --- 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
@@ -67,7 +87,7 @@ module Expr =
     let rec eval st expr =      
       match expr with
       | Const n -> n
-      | Var   x -> st x
+      | Var   x -> State.eval st x
       | Binop (op, x, y) -> to_func op (eval st x) (eval st y)
 
     (* Expression parser. You can use the following terminals:
@@ -114,27 +134,38 @@ module Stmt =
     (* empty statement                  *) | Skip
     (* conditional                      *) | If     of Expr.t * t * t
     (* loop with a pre-condition        *) | While  of Expr.t * t
-    (* loop with a post-condition       *) | Repeat of t * Expr.t with show
+    (* loop with a post-condition       *) | Repeat of t * Expr.t
+    (* call a procedure                 *) | Call   of string * Expr.t list with show
                                                                     
     (* The type of configuration: a state, an input stream, an output stream *)
-    type config = Expr.state * int list * int list 
+    type config = State.t * int list * int list 
 
     (* Statement evaluator
 
-         val eval : config -> t -> config
+         val eval : env -> config -> t -> config
 
-       Takes a configuration and a statement, and returns another configuration
+       Takes an environment, a configuration and a statement, and returns another configuration. The 
+       environment supplies the following method
+
+           method definition : string -> (string list, t)
+
+       which returns a list of formal parameters and a body for given definition
     *)
-    let rec eval ((st, i, o) as conf) stmt =
+    let rec eval env ((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")
+      | Read    x          -> (match i with z::i' -> (State.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)
+      | Assign (x, e)      -> (State.update x (Expr.eval st e) st, i, o)
-      | Seq    (s1, s2)    -> eval (eval conf s1) s2
+      | Seq    (s1, s2)    -> eval env (eval env conf s1) s2
       | Skip               -> conf
-      | If     (e, s1, s2) -> eval conf (if Expr.eval st e <> 0 then s1 else s2)
+      | If     (e, s1, s2) -> eval env conf (if Expr.eval st e <> 0 then s1 else s2)
-      | While  (e, s)      -> if Expr.eval st e = 0 then conf else eval (eval conf s) stmt
+      | While  (e, s)      -> if Expr.eval st e = 0 then conf else eval env (eval env conf s) stmt
-      | Repeat (s, e)      -> let (st, _, _) as conf' = eval conf s in if Expr.eval st e = 0 then eval conf' stmt else conf'
+      | Repeat (s, e)      -> let (st, _, _) as conf' = eval env conf s in if Expr.eval st e = 0 then eval env conf' stmt else conf'
+      | Call   (f, args)   -> let args         = List.map (Expr.eval st) args in
+                              let xs, locs, s  = env#definition f in
+                              let st'          = List.fold_left (fun st (x, a) -> State.update x a st) (State.push_scope st (xs @ locs)) (List.combine xs args) in
+                              let st'', i', o' = eval env (st', i, o) s in
+                              (State.drop_scope st'' st, i', o')
                                 
     (* Statement parser *)
     ostap (
@@ -162,15 +193,36 @@ module Stmt =
 	  Seq (i, While (c, Seq (b, s)))
         }
       | %"repeat" s:parse %"until" e:!(Expr.parse)  {Repeat (s, e)}
-      | x:IDENT ":=" e:!(Expr.parse)                {Assign (x, e)}            
+      | x:IDENT 
+           s:(":=" e   :!(Expr.parse)                 {Assign (x, e)}    | 
+              "("  args:!(Util.list0)[Expr.parse] ")" {Call   (x, args)}
+             ) {s}
+    )
+      
+  end
+
+(* Function and procedure definitions *)
+module Definition =
+  struct
+
+    (* The type for a definition: name, argument list, local variables, body *)
+    type t = string * (string list * string list * Stmt.t)
+
+    ostap (
+      arg  : IDENT;
+      parse: %"fun" name:IDENT "(" args:!(Util.list0 arg) ")"
+         locs:(%"local" !(Util.list arg))?
+        "{" body:!(Stmt.parse) "}" {
+        (name, (args, (match locs with None -> [] | Some l -> l), body))
+      }
     )
 
   end
     
 (* The top-level definitions *)
 
-(* The top-level syntax category is statement *)
+(* The top-level syntax category is a pair of definition list and statement (program body) *)
-type t = Stmt.t    
+type t = Definition.t list * Stmt.t    
 
 (* Top-level evaluator
 
@@ -178,8 +230,10 @@ type t = Stmt.t
 
    Takes a program and its input stream, and returns the output stream
 *)
-let eval p i =
+let eval (defs, body) i =
-  let _, _, o = Stmt.eval (Expr.empty, i, []) p in o
+  let module M = Map.Make (String) in
+  let m        = List.fold_left (fun m ((name, _) as def) -> M.add name def m) M.empty defs in  
+  let _, _, o  = Stmt.eval (object method definition f = snd @@ M.find f m end) (State.empty, i, []) body in o
 
 (* Top-level parser *)
-let parse = Stmt.parse                                                     
+let parse = ostap (!(Definition.parse)* !(Stmt.parse))

src/SM.ml

@@ -36,8 +36,8 @@ let rec eval env ((stack, ((st, i, o) as c)) as conf) = function
     | READ        -> let z::i' = i     in eval env (z::stack, (st, i', o)) prg'
     | WRITE       -> let z::stack' = stack in eval env (stack', (st, i, o @ [z])) prg'
     | CONST i     -> eval env (i::stack, c) prg'
-    | LD x        -> eval env (st x :: stack, c) prg'
+    | LD x        -> eval env (State.eval st x :: stack, c) prg'
-    | ST x        -> let z::stack' = stack in eval env (stack', (Expr.update x z st, i, o)) prg'
+    | ST x        -> let z::stack' = stack in eval env (stack', (State.update x z st, i, o)) prg'
     | LABEL _     -> eval env conf prg'
     | JMP   l     -> eval env conf (env#labeled l)
     | CJMP (c, l) -> let x::stack' = stack in eval env conf (if (c = "z" && x = 0) || (c = "nz" && x <> 0) then env#labeled l else prg')
@@ -57,7 +57,7 @@ let run p i =
   | _ :: tl         -> make_map m tl
   in
   let m = make_map M.empty p in
-  let (_, (_, _, o)) = eval (object method labeled l = M.find l m end) ([], (Expr.empty, i, [])) p in o
+  let (_, (_, _, o)) = eval (object method labeled l = M.find l m end) ([], (State.empty, i, [])) p in o
 
 (* Stack machine compiler