diff options
Diffstat (limited to 'stdlib')
| -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 | 173 | ||||
| -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, 291 insertions, 5 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/stdlib/source/lux/lang/scope.lux b/stdlib/source/lux/lang/scope.lux new file mode 100644 index 000000000..45008ae24 --- /dev/null +++ b/stdlib/source/lux/lang/scope.lux @@ -0,0 +1,173 @@ +(.module: + lux + (lux (control monad) + (data [text "text/" Eq<Text>] + text/format + [maybe "maybe/" Monad<Maybe>] + [product] + ["e" error] + (coll [list "list/" Functor<List> Fold<List> Monoid<List>] + (dictionary [plist]))) + [macro]) + (// [analysis #+ Variable])) + +(type: Locals (Bindings Text [Type Nat])) +(type: Foreign (Bindings Text [Type Variable])) + +(def: (is-local? name scope) + (-> Text Scope Bool) + (|> scope + (get@ [#.locals #.mappings]) + (plist.contains? name))) + +(def: (get-local name scope) + (-> Text Scope (Maybe [Type Variable])) + (|> scope + (get@ [#.locals #.mappings]) + (plist.get name) + (maybe/map (function (_ [type value]) + [type (#analysis.Local value)])))) + +(def: (is-captured? name scope) + (-> Text Scope Bool) + (|> scope + (get@ [#.captured #.mappings]) + (plist.contains? name))) + +(def: (get-captured name scope) + (-> Text Scope (Maybe [Type Variable])) + (loop [idx +0 + mappings (get@ [#.captured #.mappings] scope)] + (case mappings + #.Nil + #.None + + (#.Cons [_name [_source-type _source-ref]] mappings') + (if (text/= name _name) + (#.Some [_source-type (#analysis.Foreign idx)]) + (recur (inc idx) mappings'))))) + +(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 Variable])) + (case (get-local name scope) + (#.Some type) + (#.Some type) + + _ + (get-captured name scope))) + +(def: #export (find name) + (-> Text (Meta (Maybe [Type Variable]))) + (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] (maybe.default (undefined) + (get-ref name top-outer)) + [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) + (function (_ scope ref+inner) + [(#analysis.Foreign (get@ [#.captured #.counter] scope)) + (#.Cons (update@ #.captured + (: (-> Foreign Foreign) + (|>> (update@ #.counter inc) + (update@ #.mappings (plist.put name [ref-type (product.left ref+inner)])))) + scope) + (product.right ref+inner))])) + [init-ref #.Nil] + (list.reverse inner)) + scopes (list/compose inner' outer)] + (#.Right [(set@ #.scopes scopes compiler) + (#.Some [ref-type ref])])) + )))) + +(def: #export (with-local [name type] action) + (All [a] (-> [Text Type] (Meta a) (Meta 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 inc) + (update@ #.mappings (plist.put name [type new-var-id])))) + head)] + (case (macro.run' (set@ #.scopes (#.Cons new-head tail) compiler) + action) + (#e.Success [compiler' output]) + (case (get@ #.scopes compiler') + (#.Cons head' tail') + (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head') + tail')] + (#e.Success [(set@ #.scopes scopes' compiler') + output])) + + _ + (error! "Invalid scope alteration/")) + + (#e.Error error) + (#e.Error error))) + + _ + (#e.Error "Cannot create local binding without a scope.")) + )) + +(do-template [<name> <val-type>] + [(def: <name> + (Bindings Text [Type <val-type>]) + {#.counter +0 + #.mappings (list)})] + + [init-locals Nat] + [init-captured Variable] + ) + +(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 (Meta a) (Meta 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)) + (#e.Error error) + (#e.Error error) + + (#e.Success [compiler' output]) + (#e.Success [(update@ #.scopes + (|>> list.tail (maybe.default (list))) + compiler') + output]) + )) + )) + +(def: #export next-local + (Meta Nat) + (function (_ compiler) + (case (get@ #.scopes compiler) + #.Nil + (#e.Error "Cannot get next reference when there is no scope.") + + (#.Cons top _) + (#e.Success [compiler (get@ [#.locals #.counter] top)])))) 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) |