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

Fixed return (seems to be; no regression yet)

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-01-05 01:26:13 +03:00
parent 8658f1343b
commit 644c1b3086
3 changed files with 35 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

2
regression/test063.expr
View file

@ -8,4 +8,4 @@ fun traverse (l) {
local x = read (); local x = read ();
traverse ({1, fun () write(100), 2, 3, 4, 5, fun () write (200), 6, 7}) traverse ({1, fun () {write(100)}, 2, 3, 4, 5, fun () {write (200)}, 6, 7})

96
src/Language.ml
View file

@ -307,7 +307,7 @@ module Expr =
(* Reff : parsed expression should return value Reff (look for ":="); (* Reff : parsed expression should return value Reff (look for ":=");
Val : -//- returns simple value; Val : -//- returns simple value;
Void : parsed expression should not return any value; *) Void : parsed expression should not return any value; *)
@type atr = Reff | Void | Val with show, html @type atr = Reff | Void | Val | Weak with show, html
(* The type for expressions. Note, in regular OCaml there is no "@type..." (* The type for expressions. Note, in regular OCaml there is no "@type..."
notation, it came from GT. notation, it came from GT.
*) *)
@ -342,10 +342,9 @@ module Expr =
and decl = [`Local | `Public | `Extern | `PublicExtern ] * [`Fun of string list * t | `Variable of t option] and decl = [`Local | `Public | `Extern | `PublicExtern ] * [`Fun of string list * t | `Variable of t option]
with show, html with show, html
let notRef x = match x with Reff -> false | _ -> true let notRef = function Reff -> false | _ -> true
let isVoid x = match x with Void -> true | _ -> false let isVoid = function Void | Weak -> true | _ -> false
let isValue x = match x with Void -> false | _ -> true (* functions for handling atribute *)
(* Available binary operators: (* Available binary operators:
!! --- disjunction !! --- disjunction
&& --- conjunction && --- conjunction
@ -537,57 +536,21 @@ module Expr =
in in
eval conf Skip (schedule_list [e; Intrinsic (fun conf -> branch conf bs)]) eval conf Skip (schedule_list [e; Intrinsic (fun conf -> branch conf bs)])
(* Expression parser. You can use the following terminals: (* Expression parser. You can use the following terminals:
LIDENT --- a non-empty identifier a-z[a-zA-Z0-9_]* as a string
LIDENT --- a non-empty identifier a-z[a-zA-Z0-9_]* as a string UIDENT --- a non-empty identifier A-Z[a-zA-Z0-9_]* as a string
UIDENT --- a non-empty identifier A-Z[a-zA-Z0-9_]* as a string DECIMAL --- a decimal constant [0-9]+ as a string
DECIMAL --- a decimal constant [0-9]+ as a string *)
*)
(* Propagates *)
let rec propagate_ref = function
| Var x -> Ref x
| Elem (e, i) -> ElemRef (e, i)
| Seq (s1, s2) -> Seq (s1, propagate_ref s2)
| If (e, t1, t2) -> If (e, propagate_ref t1, propagate_ref t2)
| Case (e, bs, l, a) -> Case (e, List.map (fun (p, e) -> p, propagate_ref e) bs, l, a)
| _ -> raise (Semantic_error "not a destination")
(* Balance values *)
let rec balance_value = function
| Array es -> Array (List.map balance_value es)
| Sexp (s, es) -> Sexp (s, List.map balance_value es)
| Binop (o, l, r) -> Binop (o, balance_value l, balance_value r)
| Elem (b, i) -> Elem (balance_value b, balance_value i)
| ElemRef (b, i) -> ElemRef (balance_value b, balance_value i)
| Length x -> Length (balance_value x)
| StringVal x -> StringVal (balance_value x)
| Call (f, es) -> Call (balance_value f, List.map balance_value es)
| Assign (d, s) -> Assign (balance_value d, balance_value s)
| Seq (l, r) -> Seq (balance_void l, balance_value r)
| If (c, t, e) -> If (balance_value c, balance_value t, balance_value e)
| Case (e, ps, l, a) -> Case (balance_value e, List.map (fun (p, e) -> p, balance_value e) ps, l, a)
| Return _
| While _
| Repeat _
| Skip -> raise (Semantic_error "missing value")
| e -> e
and balance_void = function
| If (c, t, e) -> If (balance_value c, balance_void t, balance_void e)
| Seq (l, r) -> Seq (balance_void l, balance_void r)
| Case (e, ps, l, a) -> Case (balance_value e, List.map (fun (p, e) -> p, balance_void e) ps, l, a)
| While (e, s) -> While (balance_value e, balance_void s)
| Repeat (s, e) -> Repeat (balance_void s, balance_value e)
| Return (Some e) -> Return (Some (balance_value e))
| Return None -> Return None
| Skip -> Skip
| e -> Ignore (balance_value e)
(* places ignore if expression should be void *) (* places ignore if expression should be void *)
let ignore atr expr = if isVoid atr then Ignore expr else expr let ignore atr expr = match atr with Void -> Ignore expr | _ -> expr
(* places dummy value if required *)
let materialize atr expr =
match atr with
| Weak -> Seq (expr, Const 0)
| _ -> expr
(* semantics for infixes creaed in runtime *) (* semantics for infixes creaed in runtime *)
let sem s = (fun x atr y -> ignore atr (Call (Var s, [x; y]))), (fun _ -> Val, Val) let sem s = (fun x atr y -> ignore atr (Call (Var s, [x; y]))), (fun _ -> Val, Val)
@ -630,7 +593,9 @@ module Expr =
) )
in in
ostap (inner[0][id][atr]) ostap (inner[0][id][atr])
let atr' = atr
(* ======= *) (* ======= *)
ostap ( ostap (
parse[def][infix][atr]: h:basic[def][infix][Void] -";" t:parse[def][infix][atr] {Seq (h, t)} parse[def][infix][atr]: h:basic[def][infix][Void] -";" t:parse[def][infix][atr] {Seq (h, t)}
@ -695,7 +660,7 @@ module Expr =
| c:(%"true" {Const 1} | %"false" {Const 0}) => {notRef atr} => {ignore atr c} | c:(%"true" {Const 1} | %"false" {Const 0}) => {notRef atr} => {ignore atr c}
| %"infix" s:STRING => {notRef atr} => {ignore atr (Var (infix_name s))} | %"infix" s:STRING => {notRef atr} => {ignore atr (Var (infix_name s))}
| %"fun" "(" args:!(Util.list0)[ostap (LIDENT)] ")" body:basic[def][infix][Void] => {notRef atr} => {ignore atr (Lambda (args, body))} | %"fun" "(" args:!(Util.list0)[ostap (LIDENT)] ")" body:basic[def][infix][Weak] => {notRef atr} => {ignore atr (Lambda (args, body))}
| "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} => {ignore atr (Array es)} | "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} => {ignore atr (Array es)}
| -"{" scope[def][infix][atr][parse def] -"}" | -"{" scope[def][infix][atr][parse def] -"}"
| "{" es:!(Util.list0)[parse def infix Val] "}" => {notRef atr} => {ignore atr (match es with | "{" es:!(Util.list0)[parse def infix Val] "}" => {notRef atr} => {ignore atr (match es with
@ -708,24 +673,25 @@ module Expr =
} }
| x:LIDENT {if notRef atr then Var x else Ref x} | x:LIDENT {if notRef atr then Var x else Ref x}
| {isVoid atr} => %"skip" {Skip} | {isVoid atr} => %"skip" {materialize atr Skip}
| %"if" e:parse[def][infix][Val] %"then" the:scope[def][infix][atr][parse def] | %"if" e:parse[def][infix][Val] %"then" the:scope[def][infix][atr][parse def]
elif:(%"elif" parse[def][infix][Val] %"then" scope[def][infix][atr][parse def])* elif:(%"elif" parse[def][infix][Val] %"then" scope[def][infix][atr][parse def])*
%"else" els:scope[def][infix][atr][parse def] %"fi" els:(%"else" scope[def][infix][atr][parse def])? %"fi"
{If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif els)} {If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif (match els with Some e -> e | _ -> materialize atr Skip))}
(*
| %"if" e:parse[def][infix][Val] %"then" the:scope[def][infix][Void][parse def] | %"if" e:parse[def][infix][Val] %"then" the:scope[def][infix][Void][parse def]
elif:(%"elif" parse[def][infix][Val] %"then" scope[def][infix][atr][parse def])* elif:(%"elif" parse[def][infix][Val] %"then" scope[def][infix][atr][parse def])*
=> {isVoid atr} => %"fi" => {isVoid atr} => %"fi"
{If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif Skip)} {If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif Skip)}
*)
| %"while" e:parse[def][infix][Val] %"do" s:scope[def][infix][Void][parse def] | %"while" e:parse[def][infix][Val] %"do" s:scope[def][infix][Void][parse def]
=> {isVoid atr} => %"od" {While (e, s)} => {isVoid atr} => %"od" {materialize atr (While (e, s))}
| %"for" i:parse[def][infix][Void] "," c:parse[def][infix][Val] "," s:parse[def][infix][Void] %"do" b:scope[def][infix][Void][parse def] => {isVoid atr} => %"od" | %"for" i:parse[def][infix][Void] "," c:parse[def][infix][Val] "," s:parse[def][infix][Void] %"do" b:scope[def][infix][Void][parse def] => {isVoid atr} => %"od"
{Seq (i, While (c, Seq (b, s)))} {materialize atr (Seq (i, While (c, Seq (b, s))))}
| %"repeat" s:scope[def][infix][Void][parse def] %"until" e:basic[def][infix][Val] => {isVoid atr} => {Repeat (s, e)} | %"repeat" s:scope[def][infix][Void][parse def] %"until" e:basic[def][infix][Val] => {isVoid atr} => {materialize atr (Repeat (s, e))}
| %"return" e:basic[def][infix][Val]? => {isVoid atr} => {Return e} | %"return" e:basic[def][infix][Val]? => {isVoid atr} => {Return e}
| %"case" l:$ e:parse[def][infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[def][infix][atr][parse def])] %"esac" | %"case" l:$ e:parse[def][infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[def][infix][atr][parse def])] %"esac"
@ -876,7 +842,7 @@ module Definition =
m:(%"local" {`Local} | %"public" e:(%"external")? {match e with None -> `Public | Some _ -> `PublicExtern} | %"external" {`Extern}) m:(%"local" {`Local} | %"public" e:(%"external")? {match e with None -> `Public | Some _ -> `PublicExtern} | %"external" {`Extern})
locs:!(Util.list (local_var m infix expr def)) ";" {locs, infix} locs:!(Util.list (local_var m infix expr def)) ";" {locs, infix}
| - <(m, orig_name, name, infix')> : head[infix] -"(" -args:!(Util.list0 arg) -")" | - <(m, orig_name, name, infix')> : head[infix] -"(" -args:!(Util.list0 arg) -")"
(body:expr[def][infix'][Expr.Void] { (body:expr[def][infix'][Expr.Weak (*Void*)] {
match m with match m with
| `Extern -> raise (Semantic_error (Printf.sprintf "body for an external function '%s' can not be specified" orig_name)) | `Extern -> raise (Semantic_error (Printf.sprintf "body for an external function '%s' can not be specified" orig_name))
| _ -> [(name, (m, `Fun (args, body)))], infix' | _ -> [(name, (m, `Fun (args, body)))], infix'
@ -1007,7 +973,7 @@ ostap (
is, infix is, infix
}; };
parse[cmd]: parse[cmd]:
<(is, infix)> : imports[cmd] <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Void)? { <(is, infix)> : imports[cmd] <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Weak (*Void*))? {
(is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e) (is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
}; };
definitions[infix]: definitions[infix]:

5
src/X86.ml
View file

@ -367,9 +367,11 @@ let compile cmd env code =
(if f = "main" then [Call "L__gc_init"] else []) (if f = "main" then [Call "L__gc_init"] else [])
| END -> | END ->
let x, env = env#pop in
env#assert_empty_stack; env#assert_empty_stack;
let name = env#fname in let name = env#fname in
env#leave, [ env#leave, [
Mov (x, eax); (*!!*)
Label env#epilogue; Label env#epilogue;
Mov (ebp, esp); Mov (ebp, esp);
Pop ebp Pop ebp
@ -382,8 +384,7 @@ let compile cmd env code =
] ]
| RET -> | RET ->
let x, env = env#pop in let x = env#peek in
env#assert_empty_stack;
env, [Mov (x, eax); Jmp env#epilogue] env, [Mov (x, eax); Jmp env#epilogue]
| CALL (f, n) -> call env f n | CALL (f, n) -> call env f n