From 7352dc3da89937078b626b2c891028458959bb01 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Mon, 2 Apr 2018 07:00:36 +0300 Subject: [PATCH] Functions without return --- src/Driver.ml | 2 +- src/Language.ml | 93 ++++++++++++++++++++++++++++++------------------- src/SM.ml | 2 +- 3 files changed, 60 insertions(+), 37 deletions(-) diff --git a/src/Driver.ml b/src/Driver.ml index 9e96848e9..c4e5f628b 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"; "fun"; "local"] s + inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"; "fun"; "local"; "return"] s inherit Util.Lexers.skip [ Matcher.Skip.whitespaces " \t\n"; Matcher.Skip.lineComment "--"; diff --git a/src/Language.ml b/src/Language.ml index 82ac26bd6..af6bd2f28 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -47,7 +47,8 @@ module Expr = @type t = (* integer constant *) | Const of int (* variable *) | Var of string - (* binary operator *) | Binop of string * t * t with show + (* binary operator *) | Binop of string * t * t + (* function call *) | Call of string * t list with show (* Available binary operators: !! --- disjunction @@ -56,13 +57,22 @@ module Expr = +, - --- addition, subtraction *, /, % --- multiplication, division, reminder *) - + + (* The type of configuration: a state, an input stream, an output stream *) + type config = State.t * int list * int list + (* Expression evaluator - val eval : state -> t -> int - - Takes a state and an expression, and returns the value of the expression in - the given state. + val eval : env -> config -> t -> int * config + + + Takes an environment, a configuration and an expresion, and returns another its value with another configuration. The + environment supplies the following method + + method definition : env -> string -> int list -> config -> (int * config) + + which takes an environment (of the same type), a name of the function, a list of actual parameters and a configuration, + an returns a pair: the return value for the call and the resulting configuration *) let to_func op = let bti = function true -> 1 | _ -> 0 in @@ -84,17 +94,24 @@ module Expr = | "!!" -> fun x y -> bti (itb x || itb y) | _ -> failwith (Printf.sprintf "Unknown binary operator %s" op) - let rec eval st expr = + let rec eval env ((st, i, o) as conf) expr = match expr with - | Const n -> n - | Var x -> State.eval st x - | Binop (op, x, y) -> to_func op (eval st x) (eval st y) - + | Const n -> n, conf + | Var x -> State.eval st x, conf + | Binop (op, x, y) -> + let x, conf = eval env conf x in + let y, conf = eval env conf y in + to_func op x y, conf + | Call (f, args) -> + let args, ((st, i, o) as conf) = + List.fold_left (fun (acc, conf) e -> let v, conf = eval env conf e in v::acc, conf) ([], conf) args + in + env#definition env f (List.rev args) conf + (* Expression parser. You can use the following terminals: IDENT --- a non-empty identifier a-zA-Z[a-zA-Z0-9_]* as a string - DECIMAL --- a decimal constant [0-9]+ as a string - + DECIMAL --- a decimal constant [0-9]+ as a string *) ostap ( parse: @@ -114,8 +131,8 @@ module Expr = primary); primary: - n:DECIMAL {Const n} - | x:IDENT {Var x} + n:DECIMAL {Const n} + | x:IDENT s:("(" args:!(Util.list0)[parse] ")" {Call (x, args)} | empty {Var x}) {s} | -"(" parse -")" ) @@ -135,38 +152,31 @@ module Stmt = (* 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 + (* return statement *) | Return of Expr.t option (* 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 = State.t * int list * int list - (* Statement evaluator val eval : env -> config -> t -> config 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 + environment is the same as for expressions *) let rec eval env ((st, i, o) as conf) stmt = match stmt with | 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) -> (State.update x (Expr.eval st e) st, i, o) + | Write e -> let v, (st, i, o) = Expr.eval env conf e in (st, i, o @ [v]) + | Assign (x, e) -> let v, (st, i, o) = Expr.eval env conf e in (State.update x v st, i, o) | Seq (s1, s2) -> eval env (eval env conf s1) s2 | Skip -> 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.enter st (xs @ locs)) (List.combine xs args) in - let st'', i', o' = eval env (st', i, o) s in - (State.leave st'' st, i', o') - + | If (e, s1, s2) -> let v, conf = Expr.eval env conf e in eval env conf (if v <> 0 then s1 else s2) + | While (e, s) -> let v, conf = Expr.eval env conf e in if v = 0 then conf else eval env (eval env conf s) stmt + | Repeat (s, e) -> let conf = eval env conf s in + let v, conf' = Expr.eval env conf e in + if v = 0 then eval env conf' stmt else conf + | Return e -> failwith "Not implemented" + | Call (f, args) -> snd (Expr.eval env conf (Expr.Call (f, args))) + (* Statement parser *) ostap ( parse: @@ -193,6 +203,7 @@ module Stmt = Seq (i, While (c, Seq (b, s))) } | %"repeat" s:parse %"until" e:!(Expr.parse) {Repeat (s, e)} + | %"return" e:!(Expr.parse)? {Return e} | x:IDENT s:(":=" e :!(Expr.parse) {Assign (x, e)} | "(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)} @@ -233,7 +244,19 @@ type t = Definition.t list * Stmt.t 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 + let _, _, o = + Stmt.eval + (object + method definition env f args (st, i, o) = + let xs, locs, s = snd @@ M.find f m in + let st' = List.fold_left (fun st (x, a) -> State.update x a st) (State.enter st (xs @ locs)) (List.combine xs args) in + let st'', i', o' = Stmt.eval env (st', i, o) s in + 0, (State.leave st'' st, i', o') + end) + (State.empty, i, []) + body + in + o (* Top-level parser *) let parse = ostap (!(Definition.parse)* !(Stmt.parse)) diff --git a/src/SM.ml b/src/SM.ml index 0da2f9c28..6decf16fb 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -22,7 +22,7 @@ type prg = insn list (* The type for the stack machine configuration: control stack, stack and configuration from statement interpreter *) -type config = (prg * State.t) list * int list * Stmt.config +type config = (prg * State.t) list * int list * Expr.config (* Stack machine interpreter