This commit is contained in:
Dmitry Boulytchev 2018-03-28 17:13:59 +03:00
parent eff25f1cf4
commit 2645f1433c
3 changed files with 19 additions and 200 deletions

View file

@ -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"