mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-11 17:33:30 +00:00
hw6
This commit is contained in:
Dmitry Boulytchev
parent
eff25f1cf4
commit
2645f1433c
3 changed files with 19 additions and 200 deletions
|
|
@ -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 "--";
|
||||
|
|
|
|||
128
src/Language.ml
128
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"
|
||||
|
|
|
|||
89
src/SM.ml
89
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 <label_name>)
|
||||
*)
|
||||
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"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue