mirror of
https://github.com/ProgramSnail/Lama.git
synced 2026-01-01 03:28:19 +00:00
Strings/arrays/builtins in int/sm
This commit is contained in:
Dmitry Boulytchev
parent
b19bea4d58
commit
dd5956d663
10991 changed files with 24197 additions and 24039 deletions
111
src/SM.ml
111
src/SM.ml
|
|
@ -3,29 +3,32 @@ open Language
|
|||
|
||||
(* The type for the stack machine instructions *)
|
||||
@type insn =
|
||||
(* binary operator *) | BINOP of string
|
||||
(* put a constant on the stack *) | CONST of int
|
||||
(* binary operator *) | BINOP of string
|
||||
(* put a constant on the stack *) | CONST of int
|
||||
(* put a string on the stack *) | STRING of string
|
||||
(* read to stack *) | READ
|
||||
(* write from stack *) | WRITE
|
||||
(* load a variable to the stack *) | LD of string
|
||||
(* store a variable from the stack *) | ST of string
|
||||
(* a label *) | LABEL of string
|
||||
(* unconditional jump *) | JMP of string
|
||||
(* conditional jump *) | CJMP of string * string
|
||||
(* begins procedure definition *) | BEGIN of string * string list * string list
|
||||
(* load a variable to the stack *) | LD of string
|
||||
(* store a variable from the stack *) | ST of string
|
||||
(* store in an array *) | STA of string * int
|
||||
(* a label *) | LABEL of string
|
||||
(* unconditional jump *) | JMP of string
|
||||
(* conditional jump *) | CJMP of string * string
|
||||
(* begins procedure definition *) | BEGIN of string * string list * string list
|
||||
(* end procedure definition *) | END
|
||||
(* calls a function/procedure *) | CALL of string * int * bool
|
||||
(* returns from a function *) | RET of bool with show
|
||||
(* calls a function/procedure *) | CALL of string * int * bool
|
||||
(* returns from a function *) | RET of bool with show
|
||||
|
||||
(* The type for the stack machine program *)
|
||||
(* The type for the stack machine program *)
|
||||
|
||||
type prg = insn list
|
||||
|
||||
let print_prg p = List.iter (fun i -> Printf.printf "%s\n" (show(insn) i)) p
|
||||
|
||||
(* The type for the stack machine configuration: control stack, stack and configuration from statement
|
||||
interpreter
|
||||
*)
|
||||
type config = (prg * State.t) list * int list * Expr.config
|
||||
*)
|
||||
type config = (prg * State.t) list * Value.t list * Expr.config
|
||||
|
||||
(* Stack machine interpreter
|
||||
|
||||
|
|
@ -34,31 +37,37 @@ type config = (prg * State.t) list * int list * Expr.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 split n l =
|
||||
let rec unzip (taken, rest) = function
|
||||
| 0 -> (List.rev taken, rest)
|
||||
| n -> let h::tl = rest in unzip (h::taken, tl) (n-1)
|
||||
in
|
||||
unzip ([], l) n
|
||||
|
||||
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 (cstack, stack', (st, i, o)) (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.enter st (args @ locals)) state', i, o)) prg'
|
||||
| END | RET _ -> (match cstack with
|
||||
| (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
|
||||
| [] -> conf
|
||||
)
|
||||
| BINOP op -> let y::x::stack' = stack in eval env (cstack, (Value.of_int @@ Expr.to_func op (Value.to_int x) (Value.to_int y)) :: stack', c) prg'
|
||||
| CONST i -> eval env (cstack, (Value.of_int i)::stack, c) prg'
|
||||
| STRING s -> eval env (cstack, (Value.of_string s)::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'
|
||||
| STA (x, n) -> let v::is, stack' = split (n+1) stack in
|
||||
eval env (cstack, stack', (Language.Stmt.update st x v (List.rev is), 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 (cstack, stack', (st, i, o)) (if (c = "z" && Value.to_int x = 0) || (c = "nz" && Value.to_int x <> 0) then env#labeled l else prg')
|
||||
| CALL (f, n, p) -> if env#is_label f
|
||||
then eval env ((prg', st)::cstack, stack, c) (env#labeled f)
|
||||
else eval env (env#builtin conf f n p) prg'
|
||||
| BEGIN (_, args, locals) -> let vs, stack' = split (List.length args) stack in
|
||||
let state = List.combine args vs in
|
||||
eval env (cstack, stack', (List.fold_left (fun s (x, v) -> State.update x v s) (State.enter st (args @ locals)) state, i, o)) prg'
|
||||
| END | RET _ -> (match cstack with
|
||||
| (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
|
||||
| [] -> conf
|
||||
)
|
||||
)
|
||||
|
||||
(* Top-level evaluation
|
||||
|
|
@ -68,7 +77,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
|
|||
Takes a program, an input stream, and returns an output stream this program calculates
|
||||
*)
|
||||
let run p i =
|
||||
(*print_prg p;*)
|
||||
(* print_prg p; *)
|
||||
let module M = Map.Make (String) in
|
||||
let rec make_map m = function
|
||||
| [] -> m
|
||||
|
|
@ -76,7 +85,24 @@ 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) ([], [], (State.empty, i, [])) p in o
|
||||
let (_, _, (_, _, o)) =
|
||||
eval
|
||||
(object
|
||||
method is_label l = M.mem l m
|
||||
method labeled l = M.find l m
|
||||
method builtin (cstack, stack, (st, i, o)) f n p =
|
||||
let f = match f.[0] with 'L' -> String.sub f 1 (String.length f - 1) | _ -> f in
|
||||
let args, stack' = split n stack in
|
||||
let (st, i, o, r) = Language.Builtin.eval (st, i, o, None) args f in
|
||||
let stack'' = if p then stack' else let Some r = r in r::stack' in
|
||||
Printf.printf "Builtin: %s\n";
|
||||
(cstack, stack'', (st, i, o))
|
||||
end
|
||||
)
|
||||
([], [], (State.empty, i, []))
|
||||
p
|
||||
in
|
||||
o
|
||||
|
||||
(* Stack machine compiler
|
||||
|
||||
|
|
@ -91,15 +117,18 @@ let compile (defs, p) =
|
|||
let args_code = List.concat @@ List.map expr (List.rev args) in
|
||||
args_code @ [CALL (label f, List.length args, p)]
|
||||
and expr = function
|
||||
| Expr.Var x -> [LD x]
|
||||
| Expr.Const n -> [CONST n]
|
||||
| Expr.Var x -> [LD x]
|
||||
| Expr.Const n -> [CONST n]
|
||||
| Expr.String s -> [STRING s]
|
||||
| Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
|
||||
| Expr.Call (f, args) -> call f args false
|
||||
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL ("$array", List.length xs, false)]
|
||||
| Expr.Elem (a, i) -> expr i @ expr a @ [CALL ("$elem", 2, false)]
|
||||
| Expr.Length e -> expr e @ [CALL ("$length", 1, false)]
|
||||
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.Assign (x, [], e) -> env, false, expr e @ [ST x]
|
||||
| Stmt.Assign (x, is, e) -> env, false, List.flatten (List.map expr (is @ [e])) @ [STA (x, List.length is)]
|
||||
| Stmt.Skip -> env, false, []
|
||||
|
||||
| Stmt.Seq (s1, s2) -> let l2, env = env#get_label in
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue