st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-25 08:08:47 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Buildtins, arrays, string (no X86 yet), tests

Browse source
This commit is contained in:
Dmitry Boulytchev 2018-04-27 01:27:10 +03:00 • committed by danyaberezun
parent 25eff5c282
commit 25b4a79832
10 changed files with 94 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

29
src/Language.ml
View file

@ -73,22 +73,19 @@ module Builtin =
struct
let eval (st, i, o, _) args = function
| "read" -> (match i with z::i' -> (st, i', o, Some (Value.of_int z)) | _ -> failwith "Unexpected end of input")
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], None)
| "$elem" -> let [b; j] = args in
(st, i, o, let i = Value.to_int j in
Some (match b with
| Value.String s -> Value.of_int @@ Char.code s.[i]
| Value.Array a -> List.nth a i
)
)
| "$length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
| "$array" -> (st, i, o, Some (Value.of_array args))
| "strcat" -> let [x; y] = args in
(st, i, o, Some (Value.of_string @@ Value.to_string x ^ Value.to_string y))
| "isArray" -> let [a] = args in
(st, i, o, Some (Value.of_int @@ match a with Array _ -> 1 | _ -> 0))
| "read" -> (match i with z::i' -> (st, i', o, Some (Value.of_int z)) | _ -> failwith "Unexpected end of input")
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], None)
| "$elem" -> let [b; j] = args in
(st, i, o, let i = Value.to_int j in
Some (match b with
| Value.String s -> Value.of_int @@ Char.code s.[i]
| Value.Array a -> List.nth a i
)
)
| "$length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
| "$array" -> (st, i, o, Some (Value.of_array args))
| "isArray" -> let [a] = args in (st, i, o, Some (Value.of_int @@ match a with Value.Array _ -> 1 | _ -> 0))
| "isString" -> let [a] = args in (st, i, o, Some (Value.of_int @@ match a with Value.String _ -> 1 | _ -> 0))
end

9
src/SM.ml
View file

@ -18,7 +18,6 @@ open Language
(* returns from a function *) | RET of bool with show
(* 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
@ -60,7 +59,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
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
let state = List.combine args @@ List.rev 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'
@ -91,7 +90,7 @@ let run p i =
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 (st, i, o, r) = Language.Builtin.eval (st, i, o, None) (List.rev 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))
@ -112,7 +111,7 @@ let run p i =
let compile (defs, p) =
let label s = "L" ^ s in
let rec call f args p =
let args_code = List.concat @@ List.map expr (List.rev args) in
let args_code = List.concat @@ List.map expr args in
args_code @ [CALL (label f, List.length args, p)]
and expr = function
| Expr.Var x -> [LD x]
@ -121,7 +120,7 @@ let compile (defs, p) =
| 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.Elem (a, i) -> expr a @ expr i @ [CALL ("$elem", 2, false)]
| Expr.Length e -> expr e @ [CALL ("$length", 1, false)]
in
let rec compile_stmt l env = function

16
src/X86.ml
View file

@ -220,7 +220,7 @@ let compile env code =
push_args env ((Push x)::acc) (n-1)
in
let env, pushs = push_args env [] n in
env, pushr @ pushs @ [Call f; Binop ("+", L (n*4), esp)] @ (List.rev popr)
env, pushr @ (List.rev pushs) @ [Call f; Binop ("+", L (n*4), esp)] @ (List.rev popr)
in
(if p then env, code else let y, env = env#allocate in env, code @ [Mov (eax, y)])
in
@ -253,14 +253,14 @@ class env =
(* allocates a fresh position on a symbolic stack *)
method allocate =
let x, n =
let rec allocate' = function
| [] -> ebx , 0
| (S n)::_ -> S (n+1) , n+2
| (R n)::_ when n < num_of_regs -> R (n+1) , stack_slots
let rec allocate' = function
| [] -> R 0 , 0
| (S n)::_ -> S (n+1) , n+2
| (R n)::_ when n < num_of_regs -> R (n+1) , stack_slots
| (M _)::s -> allocate' s
| _ -> S 0 , 1
in
allocate' stack
| _ -> let n = List.length locals in S n, n+1
in
allocate' stack
in
x, {< stack_slots = max n stack_slots; stack = x::stack >}