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

Postfix calls

Browse source
This commit is contained in:
Dmitry Boulytchev 2019-03-11 15:24:03 +03:00
parent e16fb72a9e
commit fe4e322d58
9 changed files with 87 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

3
regression/orig/test052.log Normal file
View file

@ -0,0 +1,3 @@
> 1
2
3

24
regression/test052.expr Normal file
View file

@ -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)

1
regression/test052.input Normal file
View file

@ -0,0 +1 @@
0

3
regression/x86only/orig/test004.log Normal file
View file

@ -0,0 +1,3 @@
1
{2, 3, 4}
2

15
regression/x86only/test004.expr Normal file
View file

@ -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)

1
regression/x86only/test004.input Normal file
View file

@ -0,0 +1 @@
0

27
src/Language.ml
View file

@ -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

22
src/SM.ml
View file

@ -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)]
@ -251,7 +251,11 @@ let compile (defs, p) =
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)]

4
src/X86.ml
View file

@ -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 =