From 39508a019575fdf864b4415785e0d1c867b587e0 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Fri, 27 Apr 2018 01:27:10 +0300 Subject: [PATCH] Buildtins, arrays, string (no X86 yet), tests --- regression/orig/test035.log | 8 ++++++++ regression/orig/test036.log | 16 ++++++++++++++++ regression/test034.expr | 4 +--- regression/test035.expr | 21 +++++++++++++++++++++ regression/test035.input | 1 + regression/test036.expr | 21 +++++++++++++++++++++ regression/test036.input | 1 + src/Language.ml | 29 +++++++++++++---------------- src/SM.ml | 9 ++++----- src/X86.ml | 2 +- 10 files changed, 87 insertions(+), 25 deletions(-) create mode 100644 regression/orig/test035.log create mode 100644 regression/orig/test036.log create mode 100644 regression/test035.expr create mode 100644 regression/test035.input create mode 100644 regression/test036.expr create mode 100644 regression/test036.input diff --git a/regression/orig/test035.log b/regression/orig/test035.log new file mode 100644 index 000000000..439208742 --- /dev/null +++ b/regression/orig/test035.log @@ -0,0 +1,8 @@ +> 10 +20 +30 +40 +0 +1 +2 +3 diff --git a/regression/orig/test036.log b/regression/orig/test036.log new file mode 100644 index 000000000..35990fed4 --- /dev/null +++ b/regression/orig/test036.log @@ -0,0 +1,16 @@ +> 97 +98 +99 +100 +101 +102 +103 +104 +97 +97 +97 +97 +97 +97 +97 +97 diff --git a/regression/test034.expr b/regression/test034.expr index dd898077e..a31a87f19 100644 --- a/regression/test034.expr +++ b/regression/test034.expr @@ -14,6 +14,4 @@ for i:=0, i (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 diff --git a/src/SM.ml b/src/SM.ml index 6ebf68b6a..5ff3c519d 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -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 diff --git a/src/X86.ml b/src/X86.ml index 7b6dcb08b..3932e31db 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -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