From b4ef95c8bc7cf76d4c9ab451c228f4c29332fa7c Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Tue, 27 Mar 2018 01:51:22 +0300 Subject: [PATCH] Procedures in interpretation --- regression/Makefile | 6 +- regression/orig/test024.log | 3 +- regression/orig/test025.log | 13 ++- regression/orig/test026.log | 22 ++++- regression/orig/test027.log | 169 ++++++++---------------------------- regression/orig/test028.log | 14 ++- regression/orig/test029.log | 22 +++-- regression/test024.expr | 13 +++ regression/test024.input | 1 + regression/test025.expr | 29 +++++++ regression/test025.input | 1 + regression/test026.expr | 32 +++++++ regression/test026.input | 1 + regression/test027.expr | 28 ++++++ regression/test027.input | 1 + regression/test028.expr | 16 ++++ regression/test028.input | 1 + regression/test029.expr | 18 ++++ regression/test029.input | 1 + src/Driver.ml | 8 +- src/Language.ml | 120 ++++++++++++++++++------- src/SM.ml | 6 +- 22 files changed, 337 insertions(+), 188 deletions(-) create mode 100644 regression/test024.expr create mode 100644 regression/test024.input create mode 100644 regression/test025.expr create mode 100644 regression/test025.input create mode 100644 regression/test026.expr create mode 100644 regression/test026.input create mode 100644 regression/test027.expr create mode 100644 regression/test027.input create mode 100644 regression/test028.expr create mode 100644 regression/test028.input create mode 100644 regression/test029.expr create mode 100644 regression/test029.input diff --git a/regression/Makefile b/regression/Makefile index 4d77df5f9..6e6305d44 100644 --- a/regression/Makefile +++ b/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) diff --git a/regression/orig/test024.log b/regression/orig/test024.log index 5c1d82376..c5707ba01 100644 --- a/regression/orig/test024.log +++ b/regression/orig/test024.log @@ -1 +1,2 @@ -> 6765 +> 3 +8 diff --git a/regression/orig/test025.log b/regression/orig/test025.log index 3f66fd229..fcb2827ec 100644 --- a/regression/orig/test025.log +++ b/regression/orig/test025.log @@ -1 +1,12 @@ -> 3628800 +> 1 +100 +200 +300 +2 +100 +200 +300 +3 +100 +200 +300 diff --git a/regression/orig/test026.log b/regression/orig/test026.log index cc0e5b6e4..2353669bc 100644 --- a/regression/orig/test026.log +++ b/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 diff --git a/regression/orig/test027.log b/regression/orig/test027.log index 06bd40b5a..8a28ae625 100644 --- a/regression/orig/test027.log +++ b/regression/orig/test027.log @@ -1,136 +1,35 @@ -73 -32 -119 -105 -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 +100 +200 +300 1 --1 -0 +2 +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 diff --git a/regression/orig/test028.log b/regression/orig/test028.log index ace1d56c9..325578c16 100644 --- a/regression/orig/test028.log +++ b/regression/orig/test028.log @@ -1,2 +1,14 @@ +> 7 +5040 +6 +720 +5 +120 +4 +24 +3 +6 +2 +2 +1 1 -100 diff --git a/regression/orig/test029.log b/regression/orig/test029.log index 1fe6f297e..67af2524c 100644 --- a/regression/orig/test029.log +++ b/regression/orig/test029.log @@ -1,10 +1,18 @@ -> > > > > 5 -6 -7 +> 9 +55 +8 +34 +7 +21 +6 +13 +5 8 -9 -1 -2 -3 4 5 +3 +3 +2 +2 +1 +1 diff --git a/regression/test024.expr b/regression/test024.expr new file mode 100644 index 000000000..0d2dca7d6 --- /dev/null +++ b/regression/test024.expr @@ -0,0 +1,13 @@ +fun test1 () { + a := 3 +} + +fun test2 (b) { + a := b +} + +test1 (); +write (a); + +test2 (8); +write (a) \ No newline at end of file diff --git a/regression/test024.input b/regression/test024.input new file mode 100644 index 000000000..c22708346 --- /dev/null +++ b/regression/test024.input @@ -0,0 +1 @@ +0 \ No newline at end of file diff --git a/regression/test025.expr b/regression/test025.expr new file mode 100644 index 000000000..11ce787f8 --- /dev/null +++ b/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 () + diff --git a/regression/test025.input b/regression/test025.input new file mode 100644 index 000000000..c22708346 --- /dev/null +++ b/regression/test025.input @@ -0,0 +1 @@ +0 \ No newline at end of file diff --git a/regression/test026.expr b/regression/test026.expr new file mode 100644 index 000000000..984d2c1d5 --- /dev/null +++ b/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 () + diff --git a/regression/test026.input b/regression/test026.input new file mode 100644 index 000000000..c22708346 --- /dev/null +++ b/regression/test026.input @@ -0,0 +1 @@ +0 \ No newline at end of file diff --git a/regression/test027.expr b/regression/test027.expr new file mode 100644 index 000000000..919970d7a --- /dev/null +++ b/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) diff --git a/regression/test027.input b/regression/test027.input new file mode 100644 index 000000000..c22708346 --- /dev/null +++ b/regression/test027.input @@ -0,0 +1 @@ +0 \ No newline at end of file diff --git a/regression/test028.expr b/regression/test028.expr new file mode 100644 index 000000000..7b9f14090 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/regression/test028.input b/regression/test028.input new file mode 100644 index 000000000..7f8f011eb --- /dev/null +++ b/regression/test028.input @@ -0,0 +1 @@ +7 diff --git a/regression/test029.expr b/regression/test029.expr new file mode 100644 index 000000000..8ef723040 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/regression/test029.input b/regression/test029.input new file mode 100644 index 000000000..ec635144f --- /dev/null +++ b/regression/test029.input @@ -0,0 +1 @@ +9 diff --git a/src/Driver.ml b/src/Driver.ml index 0ea101ebd..f2c8d9938 100644 --- a/src/Driver.ml +++ b/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 diff --git a/src/Language.ml b/src/Language.ml index 6b56a26e9..a84102540 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -4,8 +4,39 @@ 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 = struct @@ -25,25 +56,14 @@ module Expr = +, - --- 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 @@ -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) - | Seq (s1, s2) -> eval (eval conf s1) s2 + | Assign (x, e) -> (State.update x (Expr.eval st e) st, i, o) + | 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) - | While (e, s) -> if Expr.eval st e = 0 then conf else eval (eval 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' + | 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 env (eval env conf s) stmt + | 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 *) -type t = Stmt.t +(* The top-level syntax category is a pair of definition list and statement (program body) *) +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 _, _, o = Stmt.eval (Expr.empty, i, []) p in o +let eval (defs, body) i = + 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)) diff --git a/src/SM.ml b/src/SM.ml index fe12ccf23..35302f53b 100644 --- a/src/SM.ml +++ b/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' - | ST x -> let z::stack' = stack in eval env (stack', (Expr.update x z st, i, o)) prg' + | LD x -> eval env (State.eval st x :: stack, c) 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