diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/lang/analysis/expression.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/analysis/reference.lux | 56 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/scope.lux (renamed from new-luxc/source/luxc/lang/scope.lux) | 44 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/analysis/reference.lux | 57 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/analysis/structure.lux | 4 |
5 files changed, 140 insertions, 27 deletions
diff --git a/stdlib/source/lux/lang/analysis/expression.lux b/stdlib/source/lux/lang/analysis/expression.lux index a22e3d32b..5013246aa 100644 --- a/stdlib/source/lux/lang/analysis/expression.lux +++ b/stdlib/source/lux/lang/analysis/expression.lux @@ -13,8 +13,8 @@ (analysis [".A" type] [".A" primitive] [".A" structure] + [".A" reference] ## [".A" function] - ## [".A" reference] ) ## [".L" macro] ## [".L" extension] @@ -79,8 +79,8 @@ (^ (#.Record pairs)) (structureA.record analyse pairs) - ## (#.Symbol reference) - ## (referenceA.analyse-reference reference) + (#.Symbol reference) + (referenceA.reference reference) ## (^ (#.Form (list& [_ (#.Text proc-name)] proc-args))) ## (do macro.Monad<Meta> diff --git a/stdlib/source/lux/lang/analysis/reference.lux b/stdlib/source/lux/lang/analysis/reference.lux new file mode 100644 index 000000000..4192ed118 --- /dev/null +++ b/stdlib/source/lux/lang/analysis/reference.lux @@ -0,0 +1,56 @@ +(.module: + lux + (lux (control monad) + [macro] + (macro [code]) + [lang] + (lang (type ["tc" check]) + [".L" scope] + [".L" analysis #+ Analysis] + (analysis [".A" type])))) + +## [Analysers] +(def: (definition def-name) + (-> Ident (Meta Analysis)) + (do macro.Monad<Meta> + [[actualT def-anns _] (macro.find-def def-name)] + (case (macro.get-symbol-ann (ident-for #.alias) def-anns) + (#.Some real-def-name) + (definition real-def-name) + + _ + (do @ + [_ (typeA.infer actualT)] + (:: @ map (|>> #analysisL.Constant) + (macro.normalize def-name)))))) + +(def: (variable var-name) + (-> Text (Meta (Maybe Analysis))) + (do macro.Monad<Meta> + [?var (scopeL.find var-name)] + (case ?var + (#.Some [actualT ref]) + (do @ + [_ (typeA.infer actualT)] + (wrap (#.Some (#analysisL.Variable ref)))) + + #.None + (wrap #.None)))) + +(def: #export (reference reference) + (-> Ident (Meta Analysis)) + (case reference + ["" simple-name] + (do macro.Monad<Meta> + [?var (variable simple-name)] + (case ?var + (#.Some varA) + (wrap varA) + + #.None + (do @ + [this-module macro.current-module-name] + (definition [this-module simple-name])))) + + _ + (definition reference))) diff --git a/new-luxc/source/luxc/lang/scope.lux b/stdlib/source/lux/lang/scope.lux index 82d7803e2..45008ae24 100644 --- a/new-luxc/source/luxc/lang/scope.lux +++ b/stdlib/source/lux/lang/scope.lux @@ -6,36 +6,36 @@ [maybe "maybe/" Monad<Maybe>] [product] ["e" error] - (coll [list "list/" Functor<List> Fold<List> Monoid<List>])) + (coll [list "list/" Functor<List> Fold<List> Monoid<List>] + (dictionary [plist]))) [macro]) - (luxc ["&" lang] - (lang [".L" variable #+ Variable]))) + (// [analysis #+ Variable])) (type: Locals (Bindings Text [Type Nat])) -(type: Captured (Bindings Text [Type Ref])) +(type: Foreign (Bindings Text [Type Variable])) (def: (is-local? name scope) (-> Text Scope Bool) (|> scope (get@ [#.locals #.mappings]) - (&.pl-contains? name))) + (plist.contains? name))) (def: (get-local name scope) - (-> Text Scope (Maybe [Type Ref])) + (-> Text Scope (Maybe [Type Variable])) (|> scope (get@ [#.locals #.mappings]) - (&.pl-get name) + (plist.get name) (maybe/map (function (_ [type value]) - [type (#.Local value)])))) + [type (#analysis.Local value)])))) (def: (is-captured? name scope) (-> Text Scope Bool) (|> scope (get@ [#.captured #.mappings]) - (&.pl-contains? name))) + (plist.contains? name))) (def: (get-captured name scope) - (-> Text Scope (Maybe [Type Ref])) + (-> Text Scope (Maybe [Type Variable])) (loop [idx +0 mappings (get@ [#.captured #.mappings] scope)] (case mappings @@ -44,8 +44,8 @@ (#.Cons [_name [_source-type _source-ref]] mappings') (if (text/= name _name) - (#.Some [_source-type (#.Captured idx)]) - (recur (n/inc idx) mappings'))))) + (#.Some [_source-type (#analysis.Foreign idx)]) + (recur (inc idx) mappings'))))) (def: (is-ref? name scope) (-> Text Scope Bool) @@ -53,7 +53,7 @@ (is-captured? name scope))) (def: (get-ref name scope) - (-> Text Scope (Maybe [Type Ref])) + (-> Text Scope (Maybe [Type Variable])) (case (get-local name scope) (#.Some type) (#.Some type) @@ -62,7 +62,7 @@ (get-captured name scope))) (def: #export (find name) - (-> Text (Meta (Maybe [Type Ref]))) + (-> Text (Meta (Maybe [Type Variable]))) (function (_ compiler) (let [[inner outer] (|> compiler (get@ #.scopes) @@ -74,13 +74,13 @@ (#.Cons top-outer _) (let [[ref-type init-ref] (maybe.default (undefined) (get-ref name top-outer)) - [ref inner'] (list/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)]) + [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) (function (_ scope ref+inner) - [(#.Captured (get@ [#.captured #.counter] scope)) + [(#analysis.Foreign (get@ [#.captured #.counter] scope)) (#.Cons (update@ #.captured - (: (-> Captured Captured) - (|>> (update@ #.counter n/inc) - (update@ #.mappings (&.pl-put name [ref-type (product.left ref+inner)])))) + (: (-> Foreign Foreign) + (|>> (update@ #.counter inc) + (update@ #.mappings (plist.put name [ref-type (product.left ref+inner)])))) scope) (product.right ref+inner))])) [init-ref #.Nil] @@ -99,8 +99,8 @@ 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])))) + (|>> (update@ #.counter inc) + (update@ #.mappings (plist.put name [type new-var-id])))) head)] (case (macro.run' (set@ #.scopes (#.Cons new-head tail) compiler) action) @@ -129,7 +129,7 @@ #.mappings (list)})] [init-locals Nat] - [init-captured Ref] + [init-captured Variable] ) (def: (scope parent-name child-name) diff --git a/stdlib/test/test/lux/lang/analysis/reference.lux b/stdlib/test/test/lux/lang/analysis/reference.lux new file mode 100644 index 000000000..00689f3e0 --- /dev/null +++ b/stdlib/test/test/lux/lang/analysis/reference.lux @@ -0,0 +1,57 @@ +(.module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data ["e" error] + [ident "ident/" Eq<Ident>]) + ["r" math/random] + [macro #+ Monad<Meta>] + (macro [code]) + [lang] + (lang [type "type/" Eq<Type>] + [".L" scope] + [".L" module] + [".L" init] + [".L" analysis] + (analysis [".A" type] + [".A" expression])) + test) + (// ["_." primitive])) + +(def: analyse (expressionA.analyser (:! lang.Eval []))) + +(context: "References" + (<| (times +100) + (do @ + [[expectedT _] _primitive.primitive + module-name (r.unicode +5) + scope-name (r.unicode +5) + var-name (r.unicode +5) + #let [def-name [module-name var-name]]] + ($_ seq + (test "Can analyse variable." + (|> (scopeL.with-scope scope-name + (scopeL.with-local [var-name expectedT] + (typeA.with-inference + (..analyse (code.symbol ["" var-name]))))) + (macro.run (initL.compiler [])) + (case> (^ (#e.Success [inferredT (#analysisL.Variable (#analysisL.Local var))])) + (and (type/= expectedT inferredT) + (n/= +0 var)) + + _ + false))) + (test "Can analyse definition." + (|> (do Monad<Meta> + [_ (moduleL.define var-name [expectedT (' {}) []])] + (typeA.with-inference + (..analyse (code.symbol def-name)))) + (moduleL.with-module +0 module-name) + (macro.run (initL.compiler [])) + (case> (#e.Success [_ inferredT (#analysisL.Constant constant-name)]) + (and (type/= expectedT inferredT) + (ident/= def-name constant-name)) + + _ + false))))))) diff --git a/stdlib/test/test/lux/lang/analysis/structure.lux b/stdlib/test/test/lux/lang/analysis/structure.lux index 110717a0a..5bebe5325 100644 --- a/stdlib/test/test/lux/lang/analysis/structure.lux +++ b/stdlib/test/test/lux/lang/analysis/structure.lux @@ -26,6 +26,8 @@ test) (// ["_." primitive])) +(def: analyse (expressionA.analyser (:! lang.Eval []))) + (do-template [<name> <on-success> <on-error>] [(def: <name> (All [a] (-> (Meta a) Bool)) @@ -40,8 +42,6 @@ [check-fails false true] ) -(def: analyse (expressionA.analyser (:! lang.Eval []))) - (def: (check-sum' size tag variant) (-> Nat analysisL.Tag analysisL.Variant Bool) (let [variant-tag (if (get@ #analysisL.right? variant) |