From 2645f1433c10d80b14d12f9f80112de5960691d6 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Wed, 28 Mar 2018 17:13:59 +0300 Subject: [PATCH] hw6 --- src/Driver.ml | 2 +- src/Language.ml | 128 ++++++------------------------------------------ src/SM.ml | 89 +-------------------------------- 3 files changed, 19 insertions(+), 200 deletions(-) diff --git a/src/Driver.ml b/src/Driver.ml index 9e96848e9..f0f6451d6 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"; (* add new keywords *)] s inherit Util.Lexers.skip [ Matcher.Skip.whitespaces " \t\n"; Matcher.Skip.lineComment "--"; diff --git a/src/Language.ml b/src/Language.ml index a84102540..cb41eda4b 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -15,25 +15,21 @@ module State = 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 = []} + let empty = failwith "Not implemented" (* 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} - + let update x v s = failwith "Not implemented" + (* 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 + let eval s x = failwith "Not implemented" (* Creates a new scope, based on a given state *) - let push_scope st xs = {empty with g = st.g; scope = xs} + let enter st xs = failwith "Not implemented" (* Drops a scope *) - let drop_scope st st' = {st' with g = st.g} + let leave st st' = failwith "Not implemented" end @@ -64,31 +60,7 @@ module Expr = 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 - let (|>) f g = fun x y -> f (g x y) in - match op with - | "+" -> (+) - | "-" -> (-) - | "*" -> ( * ) - | "/" -> (/) - | "%" -> (mod) - | "<" -> bti |> (< ) - | "<=" -> bti |> (<=) - | ">" -> bti |> (> ) - | ">=" -> bti |> (>=) - | "==" -> bti |> (= ) - | "!=" -> bti |> (<>) - | "&&" -> fun x y -> bti (itb x && itb y) - | "!!" -> fun x y -> bti (itb x || itb y) - | _ -> failwith (Printf.sprintf "Unknown binary operator %s" op) - - let rec eval st 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) + let eval st expr = failwith "Not implemented" (* Expression parser. You can use the following terminals: @@ -97,26 +69,7 @@ module Expr = *) ostap ( - parse: - !(Ostap.Util.expr - (fun x -> x) - (Array.map (fun (a, s) -> a, - List.map (fun s -> ostap(- $(s)), (fun x y -> Binop (s, x, y))) s - ) - [| - `Lefta, ["!!"]; - `Lefta, ["&&"]; - `Nona , ["=="; "!="; "<="; "<"; ">="; ">"]; - `Lefta, ["+" ; "-"]; - `Lefta, ["*" ; "/"; "%"]; - |] - ) - primary); - - primary: - n:DECIMAL {Const n} - | x:IDENT {Var x} - | -"(" parse -")" + parse: empty {failwith "Not implemented"} ) end @@ -147,56 +100,15 @@ module Stmt = Takes an environment, a configuration and a statement, and returns another configuration. The environment supplies the following method - method definition : string -> (string list, t) + method definition : string -> (string list, string list, t) - which returns a list of formal parameters and a body for given definition + which returns a list of formal parameters, local variables, and a body for given definition *) - 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) - | 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.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') + let eval env ((st, i, o) as conf) stmt = failwith "Not implemented" (* Statement parser *) ostap ( - parse: - s:stmt ";" ss:parse {Seq (s, ss)} - | stmt; - stmt: - %"read" "(" x:IDENT ")" {Read x} - | %"write" "(" e:!(Expr.parse) ")" {Write e} - | %"skip" {Skip} - | %"if" e:!(Expr.parse) - %"then" the:parse - elif:(%"elif" !(Expr.parse) %"then" parse)* - els:(%"else" parse)? - %"fi" { - If (e, the, - List.fold_right - (fun (e, t) elif -> If (e, t, elif)) - elif - (match els with None -> Skip | Some s -> s) - ) - } - | %"while" e:!(Expr.parse) %"do" s:parse %"od"{While (e, s)} - | %"for" i:parse "," c:!(Expr.parse) "," s:parse %"do" b:parse %"od" { - Seq (i, While (c, Seq (b, s))) - } - | %"repeat" s:parse %"until" e:!(Expr.parse) {Repeat (s, e)} - | x:IDENT - s:(":=" e :!(Expr.parse) {Assign (x, e)} | - "(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)} - ) {s} + parse: empty {failwith "Not implemented"} ) end @@ -209,12 +121,7 @@ module Definition = 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)) - } + parse: empty {failwith "Not implemented"} ) end @@ -230,10 +137,7 @@ type t = Definition.t list * Stmt.t Takes a program and its input stream, and returns the output stream *) -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 eval (defs, body) i = failwith "Not implemented" + (* Top-level parser *) -let parse = ostap (!(Definition.parse)* !(Stmt.parse)) +let parse = failwith "Not implemented" diff --git a/src/SM.ml b/src/SM.ml index cee1e79b4..057298228 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -31,32 +31,7 @@ type config = (prg * State.t) list * int list * Stmt.config Takes an environment, a configuration and a program, and returns a configuration as a result. The environment is used to locate a label to jump to (via method env#labeled ) *) -let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function -| [] -> conf -| insn :: prg' -> - (match insn with - | BINOP op -> let y::x::stack' = stack in eval env (cstack, Expr.to_func op x y :: stack', c) prg' - | READ -> let z::i' = i in eval env (cstack, z::stack, (st, i', o)) prg' - | WRITE -> let z::stack' = stack in eval env (cstack, stack', (st, i, o @ [z])) prg' - | CONST i -> eval env (cstack, i::stack, c) prg' - | LD x -> eval env (cstack, State.eval st x :: stack, c) prg' - | ST x -> let z::stack' = stack in eval env (cstack, 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') - | CALL f -> eval env ((prg', st)::cstack, stack, c) (env#labeled f) - | BEGIN (args, locals) -> let rec combine acc args stack = - match args, stack with - | [], _ -> List.rev acc, stack - | a::args', s::stack' -> combine ((a, s)::acc) args' stack' - in - let state', stack' = combine [] args stack in - eval env (cstack, stack', (List.fold_left (fun s (x, v) -> State.update x v s) (State.push_scope st (args @ locals)) state', i, o)) prg' - | END -> (match cstack with - | (prg', st')::cstack' -> eval env (cstack', stack, (State.drop_scope st st', i, o)) prg' - | [] -> conf - ) - ) +let eval env ((cstack, stack, ((st, i, o) as c)) as conf) = failwith "Not implemented" (* Top-level evaluation @@ -81,64 +56,4 @@ let run p i = Takes a program in the source language and returns an equivalent program for the stack machine *) -let compile (defs, p) = - let label s = "L" ^ s in - let rec expr = function - | Expr.Var x -> [LD x] - | Expr.Const n -> [CONST n] - | Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op] - in - let rec compile_stmt l env = function - | Stmt.Read x -> env, false, [READ; ST x] - | Stmt.Write e -> env, false, expr e @ [WRITE] - | Stmt.Assign (x, e) -> env, false, expr e @ [ST x] - | Stmt.Skip -> env, false, [] - - | Stmt.Seq (s1, s2) -> let l2, env = env#get_label in - let env, flag1, s1 = compile_stmt l2 env s1 in - let env, flag2, s2 = compile_stmt l env s2 in - env, flag2, s1 @ (if flag1 then [LABEL l2] else []) @ s2 - - | Stmt.If (c, s1, s2) -> let l2, env = env#get_label in - let env, flag1, s1 = compile_stmt l env s1 in - let env, flag2, s2 = compile_stmt l env s2 in - env, true, expr c @ [CJMP ("z", l2)] @ s1 @ (if flag1 then [] else [JMP l]) @ [LABEL l2] @ s2 @ (if flag2 then [] else [JMP l]) - - | Stmt.While (c, s) -> let loop, env = env#get_label in - let cond, env = env#get_label in - let env, _, s = compile_stmt cond env s in - env, false, [JMP cond; LABEL loop] @ s @ [LABEL cond] @ expr c @ [CJMP ("nz", loop)] - - | Stmt.Repeat (s, c) -> let loop , env = env#get_label in - let check, env = env#get_label in - let env , flag, body = compile_stmt check env s in - env, false, [LABEL loop] @ body @ (if flag then [LABEL check] else []) @ (expr c) @ [CJMP ("z", loop)] - - | Stmt.Call (f, args) -> let args_code = List.concat @@ List.map expr (List.rev args) in - env, false, args_code @ [CALL (label f)] - in - let compile_def env (name, (args, locals, stmt)) = - let lend, env = env#get_label in - let env, flag, code = compile_stmt lend env stmt in - env, - [LABEL name; BEGIN (args, locals)] @ - code @ - (if flag then [LABEL lend] else []) @ - [END] - in - let env = - object - val ls = 0 - method get_label = (label @@ string_of_int ls), {< ls = ls + 1 >} - end - in - let env, def_code = - List.fold_left - (fun (env, code) (name, others) -> let env, code' = compile_def env (label name, others) in env, code'::code) - (env, []) - defs - in - let lend, env = env#get_label in - let _, flag, code = compile_stmt lend env p in - (LABEL "main" :: if flag then code @ [LABEL lend] else code) @ [END] @ (List.concat def_code) - +let compile (defs, p) = failwith "Not implemented"