diff --git a/regression/orig/test105.log b/regression/orig/test105.log new file mode 100644 index 000000000..b3fe0d1bc --- /dev/null +++ b/regression/orig/test105.log @@ -0,0 +1 @@ +> 3 diff --git a/regression/test105.expr b/regression/test105.expr new file mode 100644 index 000000000..545c3162b --- /dev/null +++ b/regression/test105.expr @@ -0,0 +1,6 @@ +fun f (x) {write (x)} + +local g = eta f, n = read (); + + +g (3) \ No newline at end of file diff --git a/regression/test105.input b/regression/test105.input new file mode 100644 index 000000000..7ed6ff82d --- /dev/null +++ b/regression/test105.input @@ -0,0 +1 @@ +5 diff --git a/runtime/runtime.c b/runtime/runtime.c index bc889d973..62c128909 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -1377,8 +1377,8 @@ extern void __gc_root_scan_stack (); /* Mark-and-copy */ /* ======================================== */ -static size_t SPACE_SIZE = 16; -// static size_t SPACE_SIZE = 16 * 1024; +//static size_t SPACE_SIZE = 16; +static size_t SPACE_SIZE = 16 * 1024; // static size_t SPACE_SIZE = 128; // static size_t SPACE_SIZE = 1024 * 1024; diff --git a/src/Driver.ml b/src/Driver.ml index 7168e2f48..48f36d042 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -14,7 +14,7 @@ let parse cmd = "case"; "of"; "esac"; "when"; "boxed"; "unboxed"; "string"; "sexp"; "array"; "infix"; "infixl"; "infixr"; "at"; "before"; "after"; - "true"; "false"; "lazy"] + "true"; "false"; "lazy"; "eta"] in Util.parse (object diff --git a/src/Language.ml b/src/Language.ml index 3aa0638a5..9f8bc8d2e 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -635,16 +635,13 @@ module Expr = let defCell = Pervasives.ref 0 (* ======= *) + let makeParsers env = let makeParser, makeBasicParser, makeScopeParser = let def s = let Some def = Obj.magic !defCell in def s in let ostap ( - parse[infix][atr]: h:basic[infix][Void] -";" t:parse[infix][atr] {Seq (h, t)} - | basic[infix][atr]; - scope[infix][atr]: <(d, infix')> : def[infix] expr:parse[infix'][atr] {Scope (d, expr)} | - <(d, infix')> : def[infix] => {d <> []} => {Scope (d, materialize atr Skip)}; - + parse[infix][atr]: h:basic[infix][Void] -";" t:parse[infix][atr] {Seq (h, t)} | basic[infix][atr]; + scope[infix][atr]: <(d, infix')> : def[infix] expr:parse[infix'][atr] {Scope (d, expr)} | <(d, infix')> : def[infix] => {d <> []} => {Scope (d, materialize atr Skip)}; basic[infix][atr]: !(expr (fun x -> x) (Array.map (fun (a, (atr, l)) -> a, (atr, List.map (fun (s, _, f) -> ostap (- $(s)), f) l)) infix) (primary infix) atr); - primary[infix][atr]: s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)}) b:base[infix][Val] is:( "." f:LIDENT args:(-"(" !(Util.list)[parse infix Val] -")")? {`Post (f, args)} @@ -761,16 +758,16 @@ module Expr = | _ -> Repeat (s, e) } | %"return" e:basic[infix][Val]? => {isVoid atr} => {Return e} - - | %"case" l:$ e:parse[infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[infix][atr])] %"esac" - {Case (e, bs, l#coord, atr)} - | l:$ %"lazy" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {ignore atr (Call (Var "makeLazy", [Lambda ([], e)]))} - + | %"case" l:$ e:parse[infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[infix][atr])] %"esac"{Case (e, bs, l#coord, atr)} + | l:$ %"lazy" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {env#add_lazy; ignore atr (Call (Var "makeLazy", [Lambda ([], e)]))} + | l:$ %"eta" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {let name = env#get_tmp in ignore atr (Lambda ([name], Call (e, [Var name])))} | -"(" parse[infix][atr] -")" ) in (fun def -> defCell := Obj.magic !def; parse), (fun def -> defCell := Obj.magic !def; basic), (fun def -> defCell := Obj.magic !def; scope) - + in + makeParser, makeBasicParser, makeScopeParser + (* Workaround until Ostap starts to memoize properly *) ostap ( constexpr: @@ -1130,10 +1127,24 @@ let parse cmd = definitions in - let definitions = Pervasives.ref None in - let expr s = Expr.makeParser definitions s in - let exprBasic s = Expr.makeBasicParser definitions s in - let exprScope s = Expr.makeScopeParser definitions s in + let definitions = Pervasives.ref None in + + let env = + object + val lazy_used = Pervasives.ref false + val tmp_index = Pervasives.ref 0 + + method add_lazy = lazy_used := true + method get_tmp = let index = !tmp_index in incr tmp_index; Printf.sprintf "__tmp%d" index + method is_lazy = !lazy_used + end + in + + let (makeParser, makeBasicParser, makeScopeParser) = Expr.makeParsers env in + + let expr s = makeParser definitions s in + let exprBasic s = makeBasicParser definitions s in + let exprScope s = makeScopeParser definitions s in definitions := Some (makeDefinitions exprBasic exprScope); @@ -1144,7 +1155,7 @@ let parse cmd = <(is, infix)> : imports[cmd] <(d, infix')> : definitions[infix] expr:expr[infix'][Expr.Weak]? { - (is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.materialize Expr.Weak Expr.Skip | Some e -> e) + ((if env#is_lazy then "Lazy" :: is else is), Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.materialize Expr.Weak Expr.Skip | Some e -> e) } ) in diff --git a/stdlib/Lazy.expr b/stdlib/Lazy.expr index 7911ac276..9086f235a 100644 --- a/stdlib/Lazy.expr +++ b/stdlib/Lazy.expr @@ -2,10 +2,10 @@ public fun makeLazy (f) { local value, set = false; fun () { - if set - then value - else set := true; value := f (); value - fi + if set + then value + else set := true; value := f (); value + fi } }