mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 23:08:46 +00:00
Procedures in interpretation
This commit is contained in:
Dmitry Boulytchev
parent
30697f19eb
commit
b4ef95c8bc
22 changed files with 337 additions and 188 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"] 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
|
||||
|
|
|
|||
120
src/Language.ml
120
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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue