From be53e45ca4d75fa87a9029f84b95958e19a4b4fa Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 8 Sep 2017 19:20:08 -0400 Subject: - Re-named luxc/env to luxc/scope. --- new-luxc/source/luxc/analyser.lux | 3 +- new-luxc/source/luxc/analyser/case.lux | 6 +- new-luxc/source/luxc/analyser/function.lux | 6 +- new-luxc/source/luxc/analyser/reference.lux | 4 +- new-luxc/source/luxc/analyser/structure.lux | 6 +- new-luxc/source/luxc/env.lux | 158 --------------------- new-luxc/source/luxc/generator/statement.jvm.lux | 4 +- new-luxc/source/luxc/module.lux | 4 +- new-luxc/source/luxc/scope.lux | 158 +++++++++++++++++++++ new-luxc/test/test/luxc/analyser/primitive.lux | 1 - .../test/test/luxc/analyser/procedure/common.lux | 26 ++-- new-luxc/test/test/luxc/analyser/reference.lux | 6 +- 12 files changed, 190 insertions(+), 192 deletions(-) delete mode 100644 new-luxc/source/luxc/env.lux create mode 100644 new-luxc/source/luxc/scope.lux diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux index a7e420eec..3272057f2 100644 --- a/new-luxc/source/luxc/analyser.lux +++ b/new-luxc/source/luxc/analyser.lux @@ -11,8 +11,7 @@ (type ["TC" check])) (luxc ["&" base] (lang ["la" analysis]) - ["&;" module] - ["&;" env]) + ["&;" module]) (. ["&&;" common] ["&&;" function] ["&&;" primitive] diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux index 8ef4b030b..9a205d934 100644 --- a/new-luxc/source/luxc/analyser/case.lux +++ b/new-luxc/source/luxc/analyser/case.lux @@ -16,7 +16,7 @@ (type ["TC" check])) (../.. ["&" base] (lang ["la" analysis]) - ["&;" env]) + ["&;" scope]) (.. ["&;" common] ["&;" structure]) (. ["&&;" coverage])) @@ -81,9 +81,9 @@ [cursor (#;Symbol ["" name])] (&;with-cursor cursor (do Monad - [outputA (&env;with-local [name inputT] + [outputA (&scope;with-local [name inputT] next) - idx &env;next-local] + idx &scope;next-local] (wrap [(#la;BindP idx) outputA]))) [cursor (#;Symbol ident)] diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux index f1d7fdd31..31bc367f4 100644 --- a/new-luxc/source/luxc/analyser/function.lux +++ b/new-luxc/source/luxc/analyser/function.lux @@ -9,7 +9,7 @@ (type ["TC" check])) (luxc ["&" base] (lang ["la" analysis #+ Analysis]) - ["&;" env] + ["&;" scope] (analyser ["&;" common] ["&;" inference]))) @@ -79,8 +79,8 @@ &;with-scope ## Functions have access not only to their argument, but ## also to themselves, through a local variable. - (&env;with-local [func-name functionT]) - (&env;with-local [arg-name inputT]) + (&scope;with-local [func-name functionT]) + (&scope;with-local [arg-name inputT]) (&;with-expected-type outputT) (analyse body)) diff --git a/new-luxc/source/luxc/analyser/reference.lux b/new-luxc/source/luxc/analyser/reference.lux index 5f09ee774..d664ac9d0 100644 --- a/new-luxc/source/luxc/analyser/reference.lux +++ b/new-luxc/source/luxc/analyser/reference.lux @@ -5,7 +5,7 @@ (type ["TC" check])) (luxc ["&" base] (lang ["la" analysis #+ Analysis]) - ["&;" env])) + ["&;" scope])) ## [Analysers] (def: (analyse-definition def-name) @@ -20,7 +20,7 @@ (def: (analyse-variable var-name) (-> Text (Lux (Maybe Analysis))) (do Monad - [?var (&env;find var-name)] + [?var (&scope;find var-name)] (case ?var (#;Some [actual ref]) (do @ diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux index ad7ad2a7a..e13d1d88a 100644 --- a/new-luxc/source/luxc/analyser/structure.lux +++ b/new-luxc/source/luxc/analyser/structure.lux @@ -20,7 +20,7 @@ (luxc ["&" base] (lang ["la" analysis]) ["&;" module] - ["&;" env] + ["&;" scope] (analyser ["&;" common] ["&;" inference]))) @@ -39,7 +39,7 @@ (do @ [valueA (&;with-expected-type variant-type (analyse valueC)) - temp &env;next-local] + temp &scope;next-local] (wrap (la;sum tag type-size temp valueA))) #;None @@ -189,7 +189,7 @@ expectedT macro;expected-type _ (&;within-type-env (TC;check expectedT inferredT)) - temp &env;next-local] + temp &scope;next-local] (wrap (la;sum idx case-size temp (|> valueA+ list;head assume))))) ## There cannot be any ambiguity or improper syntax when analysing diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux deleted file mode 100644 index e15e01130..000000000 --- a/new-luxc/source/luxc/env.lux +++ /dev/null @@ -1,158 +0,0 @@ -(;module: - lux - (lux (control monad) - (data [text "T/" Eq] - text/format - [maybe #+ Monad "Maybe/" Monad] - [product] - ["R" result] - (coll [list "L/" Fold Monoid])) - [macro]) - (luxc ["&" base])) - -(type: Locals (Bindings Text [Type Nat])) -(type: Captured (Bindings Text [Type Ref])) - -(do-template [ ] - [(def: ( name scope) - (-> Text Scope Bool) - (|> scope - (get@ [ #;mappings]) - (&;pl-contains? name))) - - (def: ( name scope) - (-> Text Scope (Maybe [Type Ref])) - (|> scope - (get@ [ #;mappings]) - (&;pl-get name) - (Maybe/map (function [[type value]] - [type ( value)]))))] - - [#;locals is-local? get-local #;Local] - [#;captured is-captured? get-captured id] - ) - -(def: (is-ref? name scope) - (-> Text Scope Bool) - (or (is-local? name scope) - (is-captured? name scope))) - -(def: (get-ref name scope) - (-> Text Scope (Maybe [Type Ref])) - (case (get-local name scope) - (#;Some type) - (#;Some type) - - _ - (get-captured name scope))) - -(def: #export (find name) - (-> Text (Lux (Maybe [Type Ref]))) - (function [compiler] - (let [[inner outer] (|> compiler - (get@ #;scopes) - (list;split-with (|>. (is-ref? name) not)))] - (case outer - #;Nil - (#;Right [compiler #;None]) - - (#;Cons top-outer _) - (let [[ref-type init-ref] (default (undefined) - (get-ref name top-outer)) - [ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)]) - (function [scope [ref inner]] - [(#;Captured (get@ [#;captured #;counter] scope)) - (#;Cons (update@ #;captured - (: (-> Captured Captured) - (|>. (update@ #;counter n.inc) - (update@ #;mappings (&;pl-put name [ref-type ref])))) - scope) - inner)])) - [init-ref #;Nil] - (list;reverse inner)) - scopes (L/append inner' outer)] - (#;Right [(set@ #;scopes scopes compiler) - (#;Some [ref-type ref])])) - )))) - -(def: #export (with-local [name type] action) - (All [a] (-> [Text Type] (Lux a) (Lux a))) - (function [compiler] - (case (get@ #;scopes compiler) - (#;Cons head tail) - (let [old-mappings (get@ [#;locals #;mappings] head) - new-var-id (get@ [#;locals #;counter] head) - new-head (update@ #;locals - (: (-> Locals Locals) - (|>. (update@ #;counter n.inc) - (update@ #;mappings (&;pl-put name [type new-var-id])))) - head)] - (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler) - action) - (#R;Success [compiler' output]) - (case (get@ #;scopes compiler') - (#;Cons head' tail') - (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head') - tail')] - (#R;Success [(set@ #;scopes scopes' compiler') - output])) - - _ - (error! "Invalid scope alteration.")) - - (#R;Error error) - (#R;Error error))) - - _ - (#R;Error "Cannot create local binding without a scope.")) - )) - -(do-template [ ] - [(def: - (Bindings Text [Type ]) - {#;counter +0 - #;mappings (list)})] - - [init-locals Nat] - [init-captured Ref] - ) - -(def: (scope parent-name child-name) - (-> (List Text) Text Scope) - {#;name (list& child-name parent-name) - #;inner +0 - #;locals init-locals - #;captured init-captured}) - -(def: #export (with-scope name action) - (All [a] (-> Text (Lux a) (Lux a))) - (function [compiler] - (let [parent-name (case (get@ #;scopes compiler) - #;Nil - (list) - - (#;Cons top _) - (get@ #;name top))] - (case (action (update@ #;scopes - (|>. (#;Cons (scope parent-name name))) - compiler)) - (#R;Error error) - (#R;Error error) - - (#R;Success [compiler' output]) - (#R;Success [(update@ #;scopes - (|>. list;tail (default (list))) - compiler') - output]) - )) - )) - -(def: #export next-local - (Lux Nat) - (function [compiler] - (case (get@ #;scopes compiler) - #;Nil - (#R;Error "Cannot get next reference when there is no scope.") - - (#;Cons top _) - (#R;Success [compiler (get@ [#;locals #;counter] top)])))) diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux index 96263181f..b091a2f37 100644 --- a/new-luxc/source/luxc/generator/statement.jvm.lux +++ b/new-luxc/source/luxc/generator/statement.jvm.lux @@ -7,7 +7,7 @@ [macro #+ Monad]) (luxc ["&" base] ["&;" module] - ["&;" env] + ["&;" scope] (compiler ["&;" expr]))) (def: #export (compile-def def-name def-value def-meta) @@ -20,6 +20,6 @@ (def: #export (compile-program prog-args prog-body) (-> Text Code (Lux Unit)) (do Monad - [=prog-body (&env;with-local [prog-args (type (List Text))] + [=prog-body (&scope;with-local [prog-args (type (List Text))] (&expr;compile prog-body))] (undefined))) diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux index 68c43c0c1..66c53e479 100644 --- a/new-luxc/source/luxc/module.lux +++ b/new-luxc/source/luxc/module.lux @@ -7,7 +7,7 @@ (coll [list "L/" Fold Functor])) [macro #+ Monad]) (luxc ["&" base] - ["&;" env])) + ["&;" scope])) (def: (new-module hash) (-> Nat Module) @@ -56,7 +56,7 @@ (All [a] (-> Nat Text (Lux a) (Lux [Module a]))) (do Monad [_ (create hash name) - output (&env;with-scope name action) + output (&scope;with-scope name action) module (macro;find-module name)] (wrap [module output]))) diff --git a/new-luxc/source/luxc/scope.lux b/new-luxc/source/luxc/scope.lux new file mode 100644 index 000000000..e15e01130 --- /dev/null +++ b/new-luxc/source/luxc/scope.lux @@ -0,0 +1,158 @@ +(;module: + lux + (lux (control monad) + (data [text "T/" Eq] + text/format + [maybe #+ Monad "Maybe/" Monad] + [product] + ["R" result] + (coll [list "L/" Fold Monoid])) + [macro]) + (luxc ["&" base])) + +(type: Locals (Bindings Text [Type Nat])) +(type: Captured (Bindings Text [Type Ref])) + +(do-template [ ] + [(def: ( name scope) + (-> Text Scope Bool) + (|> scope + (get@ [ #;mappings]) + (&;pl-contains? name))) + + (def: ( name scope) + (-> Text Scope (Maybe [Type Ref])) + (|> scope + (get@ [ #;mappings]) + (&;pl-get name) + (Maybe/map (function [[type value]] + [type ( value)]))))] + + [#;locals is-local? get-local #;Local] + [#;captured is-captured? get-captured id] + ) + +(def: (is-ref? name scope) + (-> Text Scope Bool) + (or (is-local? name scope) + (is-captured? name scope))) + +(def: (get-ref name scope) + (-> Text Scope (Maybe [Type Ref])) + (case (get-local name scope) + (#;Some type) + (#;Some type) + + _ + (get-captured name scope))) + +(def: #export (find name) + (-> Text (Lux (Maybe [Type Ref]))) + (function [compiler] + (let [[inner outer] (|> compiler + (get@ #;scopes) + (list;split-with (|>. (is-ref? name) not)))] + (case outer + #;Nil + (#;Right [compiler #;None]) + + (#;Cons top-outer _) + (let [[ref-type init-ref] (default (undefined) + (get-ref name top-outer)) + [ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)]) + (function [scope [ref inner]] + [(#;Captured (get@ [#;captured #;counter] scope)) + (#;Cons (update@ #;captured + (: (-> Captured Captured) + (|>. (update@ #;counter n.inc) + (update@ #;mappings (&;pl-put name [ref-type ref])))) + scope) + inner)])) + [init-ref #;Nil] + (list;reverse inner)) + scopes (L/append inner' outer)] + (#;Right [(set@ #;scopes scopes compiler) + (#;Some [ref-type ref])])) + )))) + +(def: #export (with-local [name type] action) + (All [a] (-> [Text Type] (Lux a) (Lux a))) + (function [compiler] + (case (get@ #;scopes compiler) + (#;Cons head tail) + (let [old-mappings (get@ [#;locals #;mappings] head) + new-var-id (get@ [#;locals #;counter] head) + new-head (update@ #;locals + (: (-> Locals Locals) + (|>. (update@ #;counter n.inc) + (update@ #;mappings (&;pl-put name [type new-var-id])))) + head)] + (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler) + action) + (#R;Success [compiler' output]) + (case (get@ #;scopes compiler') + (#;Cons head' tail') + (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head') + tail')] + (#R;Success [(set@ #;scopes scopes' compiler') + output])) + + _ + (error! "Invalid scope alteration.")) + + (#R;Error error) + (#R;Error error))) + + _ + (#R;Error "Cannot create local binding without a scope.")) + )) + +(do-template [ ] + [(def: + (Bindings Text [Type ]) + {#;counter +0 + #;mappings (list)})] + + [init-locals Nat] + [init-captured Ref] + ) + +(def: (scope parent-name child-name) + (-> (List Text) Text Scope) + {#;name (list& child-name parent-name) + #;inner +0 + #;locals init-locals + #;captured init-captured}) + +(def: #export (with-scope name action) + (All [a] (-> Text (Lux a) (Lux a))) + (function [compiler] + (let [parent-name (case (get@ #;scopes compiler) + #;Nil + (list) + + (#;Cons top _) + (get@ #;name top))] + (case (action (update@ #;scopes + (|>. (#;Cons (scope parent-name name))) + compiler)) + (#R;Error error) + (#R;Error error) + + (#R;Success [compiler' output]) + (#R;Success [(update@ #;scopes + (|>. list;tail (default (list))) + compiler') + output]) + )) + )) + +(def: #export next-local + (Lux Nat) + (function [compiler] + (case (get@ #;scopes compiler) + #;Nil + (#R;Error "Cannot get next reference when there is no scope.") + + (#;Cons top _) + (#R;Success [compiler (get@ [#;locals #;counter] top)])))) diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux index 9c3c1acfe..e435ecca0 100644 --- a/new-luxc/test/test/luxc/analyser/primitive.lux +++ b/new-luxc/test/test/luxc/analyser/primitive.lux @@ -17,7 +17,6 @@ (macro [code]) test) (luxc ["&" base] - ["&;" env] ["&;" module] (lang ["~" analysis]) [analyser] diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux index 457363106..3947a738e 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/common.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux @@ -14,7 +14,7 @@ (macro [code]) test) (luxc ["&" base] - ["&;" env] + ["&;" scope] ["&;" module] (lang ["~" analysis]) [analyser] @@ -242,8 +242,8 @@ (test "Can create arrays." (check-success+ "array new" (list sizeC) arrayT)) (test "Can get a value inside an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] + (|> (&scope;with-scope "" + (&scope;with-local [var-name arrayT] (&;with-expected-type elemT (@;analyse-procedure analyse "array get" (list idxC @@ -255,8 +255,8 @@ (#R;Error _) false))) (test "Can put a value inside an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] + (|> (&scope;with-scope "" + (&scope;with-local [var-name arrayT] (&;with-expected-type arrayT (@;analyse-procedure analyse "array put" (list idxC @@ -269,8 +269,8 @@ (#R;Error _) false))) (test "Can remove a value from an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] + (|> (&scope;with-scope "" + (&scope;with-local [var-name arrayT] (&;with-expected-type arrayT (@;analyse-procedure analyse "array remove" (list idxC @@ -282,8 +282,8 @@ (#R;Error _) false))) (test "Can query the size of an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] + (|> (&scope;with-scope "" + (&scope;with-local [var-name arrayT] (&;with-expected-type Nat (@;analyse-procedure analyse "array size" (list (code;symbol ["" var-name])))))) @@ -338,8 +338,8 @@ (test "Can create atomic reference." (check-success+ "atom new" (list elemC) atomT)) (test "Can read the value of an atomic reference." - (|> (&env;with-scope "" - (&env;with-local [var-name atomT] + (|> (&scope;with-scope "" + (&scope;with-local [var-name atomT] (&;with-expected-type elemT (@;analyse-procedure analyse "atom read" (list (code;symbol ["" var-name])))))) @@ -350,8 +350,8 @@ (#R;Error _) false))) (test "Can swap the value of an atomic reference." - (|> (&env;with-scope "" - (&env;with-local [var-name atomT] + (|> (&scope;with-scope "" + (&scope;with-local [var-name atomT] (&;with-expected-type Bool (@;analyse-procedure analyse "atom compare-and-swap" (list elemC diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux index ef5479b64..5601318aa 100644 --- a/new-luxc/test/test/luxc/analyser/reference.lux +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -8,7 +8,7 @@ [type "Type/" Eq] [macro #+ Monad] test) - (luxc ["&;" env] + (luxc ["&;" scope] ["&;" module] (lang ["~" analysis]) [analyser] @@ -24,8 +24,8 @@ var-name (r;text +5)] ($_ seq (test "Can analyse variable." - (|> (&env;with-scope scope-name - (&env;with-local [var-name ref-type] + (|> (&scope;with-scope scope-name + (&scope;with-local [var-name ref-type] (@common;with-unknown-type (@;analyse-reference ["" var-name])))) (macro;run (init-compiler [])) -- cgit v1.2.3