From fe4e322d582efc68b6dbd3e6451dd9121dee9a82 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Mon, 11 Mar 2019 15:24:03 +0300 Subject: [PATCH] Postfix calls --- regression/orig/test052.log | 3 +++ regression/test052.expr | 24 ++++++++++++++++++++++++ regression/test052.input | 1 + regression/x86only/orig/test004.log | 3 +++ regression/x86only/test004.expr | 15 +++++++++++++++ regression/x86only/test004.input | 1 + src/Language.ml | 27 ++++++++++++++++++++++----- src/SM.ml | 24 ++++++++++++++---------- src/X86.ml | 4 ++++ 9 files changed, 87 insertions(+), 15 deletions(-) create mode 100644 regression/orig/test052.log create mode 100644 regression/test052.expr create mode 100644 regression/test052.input create mode 100644 regression/x86only/orig/test004.log create mode 100644 regression/x86only/test004.expr create mode 100644 regression/x86only/test004.input diff --git a/regression/orig/test052.log b/regression/orig/test052.log new file mode 100644 index 000000000..c9c3fcf86 --- /dev/null +++ b/regression/orig/test052.log @@ -0,0 +1,3 @@ +> 1 +2 +3 diff --git a/regression/test052.expr b/regression/test052.expr new file mode 100644 index 000000000..2083dc7ab --- /dev/null +++ b/regression/test052.expr @@ -0,0 +1,24 @@ +fun hd (l) { + case l of + h : _ -> return h + esac +} + + +fun tl (l) { + case l of + _ : tl -> return tl + esac +} + +fun print_list (l) { + case l of + {} -> skip + | h : t -> write (h); print_list (t) + esac +} + +n := read (); +write ({1, 2, 3}.hd); +print_list ({1, 2, 3}.tl) + diff --git a/regression/test052.input b/regression/test052.input new file mode 100644 index 000000000..573541ac9 --- /dev/null +++ b/regression/test052.input @@ -0,0 +1 @@ +0 diff --git a/regression/x86only/orig/test004.log b/regression/x86only/orig/test004.log new file mode 100644 index 000000000..88c62213f --- /dev/null +++ b/regression/x86only/orig/test004.log @@ -0,0 +1,3 @@ +1 +{2, 3, 4} +2 diff --git a/regression/x86only/test004.expr b/regression/x86only/test004.expr new file mode 100644 index 000000000..dd6d8f6e5 --- /dev/null +++ b/regression/x86only/test004.expr @@ -0,0 +1,15 @@ +fun hd (l) { + case l of + h : _ -> return h + esac +} + +fun tl (l) { + case l of + _ : t -> return t + esac +} + +printf ("%s\n", {1, 2, 3}.hd.string); +printf ("%s\n", {1, 2, 3, 4}.tl.string); +printf ("%s\n", {1, {2, 3, 4}, 5, 6}.tl.hd.hd.string) \ No newline at end of file diff --git a/regression/x86only/test004.input b/regression/x86only/test004.input new file mode 100644 index 000000000..573541ac9 --- /dev/null +++ b/regression/x86only/test004.input @@ -0,0 +1 @@ +0 diff --git a/src/Language.ml b/src/Language.ml index 849e9bd3d..3e663e6ee 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -282,8 +282,18 @@ module Expr = |] ) primary); - primary: b:base is:(-"[" i:parse -"]" {`Elem i} | -"." (%"length" {`Len} | %"string" {`Str})) * - {List.fold_left (fun b -> function `Elem i -> Elem (b, i) | `Len -> Length b | `Str -> StringVal b) b is}; + primary: b:base is:(-"[" i:parse -"]" {`Elem i} | -"." (%"length" {`Len} | %"string" {`Str} | f:LIDENT {`Post f})) * { + List.fold_left + (fun b -> + function + | `Elem i -> Elem (b, i) + | `Len -> Length b + | `Str -> StringVal b + | `Post f -> Call (f, [b]) + ) + b + is + }; base: n:DECIMAL {Const n} | s:STRING {String (String.sub s 1 (String.length s - 2))} @@ -368,7 +378,7 @@ module Stmt = (* loop with a post-condition *) | Repeat of t * Expr.t (* pattern-matching *) | Case of Expr.t * (Pattern.t * t) list (* return statement *) | Return of Expr.t option - (* call a procedure *) | Call of string * Expr.t list + (* call a procedure *) | Expr of Expr.t (* leave a scope *) | Leave with show (* Statement evaluator @@ -408,7 +418,10 @@ module Stmt = else eval env conf (seq stmt k) s | Repeat (s, e) -> eval env conf (seq (While (Expr.Binop ("==", e, Expr.Const 0), s)) k) s | Return e -> (match e with None -> (st, i, o, None) | Some e -> Expr.eval env conf e) + | Expr e -> eval env (Expr.eval env conf e) k Skip +(* | Call (f, args) -> eval env (Expr.eval env conf (Expr.Call (f, args))) k Skip + *) | Case (e, bs) -> let (_, _, _, Some v) as conf' = Expr.eval env conf e in let rec branch ((st, i, o, _) as conf) = function @@ -473,9 +486,13 @@ module Stmt = | %"return" e:!(Expr.parse)? {Return e} | %"case" e:!(Expr.parse) %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" parse)] %"esac" {Case (e, bs)} | x:LIDENT - s:(is:(-"[" !(Expr.parse) -"]")* ":=" e :!(Expr.parse) {Assign (x, is, e)} | - "(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)} + s:(is:(-"[" !(Expr.parse) -"]")* ":=" e :!(Expr.parse) {Assign (x, is, e)} +(* + | + "(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)} + *) ) {s} + | e:!(Expr.parse) {Expr e} ) end diff --git a/src/SM.ml b/src/SM.ml index de3c6422f..a0b05e52d 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -214,18 +214,18 @@ let compile (defs, p) = (List.rev bindings) ) @ [DROP; ENTER (List.map fst bindings)] - and expr = function + and generic_expr f = function | 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.Sexp (t, xs) -> List.flatten (List.map expr xs) @ [SEXP (t, List.length xs)] - | Expr.Elem (a, i) -> expr a @ expr i @ [CALL (".elem", 2, false)] - | Expr.Length e -> expr e @ [CALL (".length", 1, false)] - | Expr.StringVal e -> expr e @ [CALL (".stringval", 1, false)] - in + | Expr.Binop (op, x, y) -> generic_expr f x @ generic_expr f y @ [BINOP op] + | Expr.Call (fn, args) -> call fn args f + | Expr.Array xs -> List.flatten (List.map (generic_expr f) xs) @ [CALL (".array", List.length xs, f)] + | Expr.Sexp (t, xs) -> List.flatten (List.map (generic_expr f) xs) @ [SEXP (t, List.length xs)] + | Expr.Elem (a, i) -> generic_expr f a @ generic_expr f i @ [CALL (".elem", 2, f)] + | Expr.Length e -> generic_expr f e @ [CALL (".length", 1, f)] + | Expr.StringVal e -> generic_expr f e @ [CALL (".stringval", 1, f)] + and expr e = generic_expr false e in let rec compile_stmt l env = function | 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)] @@ -250,8 +250,12 @@ let compile (defs, p) = 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.Expr e -> env, false, generic_expr true e + (* | Stmt.Call (f, args) -> env, false, call f args true + *) | Stmt.Return e -> env, false, (match e with Some e -> expr e | None -> []) @ [RET (e <> None)] diff --git a/src/X86.ml b/src/X86.ml index efec7b034..b3f8d6862 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -540,8 +540,12 @@ class env = let genasm (ds, stmt) = let stmt = Language.Stmt.Seq ( + Language.Stmt.Expr (Language.Expr.Call ("__gc_init", [])), + Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0])))) + (* Language.Stmt.Call ("__gc_init", []), Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0])))) + *) ) in let env, code =