diff options
| -rw-r--r-- | new-luxc/source/luxc/lang.lux | 13 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/reference.lux | 57 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 3 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/reference.lux | 52 | ||||
| -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 |
9 files changed, 141 insertions, 151 deletions
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index 28dd302c2..c4dff15ec 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -51,16 +51,3 @@ (if (n/= underflow idx) output (recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output))))) - -(exception: #export (Error {message Text}) - message) - -(def: #export (with-error-tracking action) - (All [a] (-> (Meta a) (Meta a))) - (function (_ compiler) - (case (action compiler) - (#e.Error error) - ((throw Error error) compiler) - - output - output))) diff --git a/new-luxc/source/luxc/lang/analysis/reference.lux b/new-luxc/source/luxc/lang/analysis/reference.lux deleted file mode 100644 index 56aba35de..000000000 --- a/new-luxc/source/luxc/lang/analysis/reference.lux +++ /dev/null @@ -1,57 +0,0 @@ -(.module: - lux - (lux (control monad) - [macro] - (macro [code]) - (lang (type ["tc" check]))) - (luxc ["&" lang] - (lang ["&." scope] - ["la" analysis #+ Analysis] - [".L" variable #+ Variable]))) - -## [Analysers] -(def: (analyse-definition def-name) - (-> Ident (Meta Analysis)) - (do macro.Monad<Meta> - [[actualT def-anns _] (&.with-error-tracking - (macro.find-def def-name))] - (case (macro.get-symbol-ann (ident-for #.alias) def-anns) - (#.Some real-def-name) - (analyse-definition real-def-name) - - _ - (do @ - [_ (&.infer actualT) - def-name (macro.normalize def-name)] - (wrap (code.symbol def-name)))))) - -(def: (analyse-variable var-name) - (-> Text (Meta (Maybe Analysis))) - (do macro.Monad<Meta> - [?var (&scope.find var-name)] - (case ?var - (#.Some [actualT ref]) - (do @ - [_ (&.infer actualT)] - (wrap (#.Some (` ((~ (code.int (variableL.from-ref ref)))))))) - - #.None - (wrap #.None)))) - -(def: #export (analyse-reference reference) - (-> Ident (Meta Analysis)) - (case reference - ["" simple-name] - (do macro.Monad<Meta> - [?var (analyse-variable simple-name)] - (case ?var - (#.Some varA) - (wrap varA) - - #.None - (do @ - [this-module macro.current-module-name] - (analyse-definition [this-module simple-name])))) - - _ - (analyse-definition reference))) diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 99328a45f..0899eccf2 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -101,8 +101,7 @@ (analyse macroC))) [_macroT _macroM _macroV] (case macroA [_ (#.Symbol macro-name)] - (&.with-error-tracking - (macro.find-def macro-name)) + (macro.find-def macro-name) _ (&.throw Invalid-Macro (%code code))) diff --git a/new-luxc/test/test/luxc/lang/analysis/reference.lux b/new-luxc/test/test/luxc/lang/analysis/reference.lux deleted file mode 100644 index 9ce4a51c1..000000000 --- a/new-luxc/test/test/luxc/lang/analysis/reference.lux +++ /dev/null @@ -1,52 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error]) - ["r" math/random] - [macro #+ Monad<Meta>] - (lang [type "type/" Eq<Type>]) - test) - (luxc (lang ["&." scope] - ["&." module] - ["~" analysis] - (analysis [".A" expression] - ["@" reference] - ["@." common]))) - (// common) - (test/luxc common)) - -(context: "References" - (<| (times +100) - (do @ - [[ref-type _] gen-primitive - module-name (r.text +5) - scope-name (r.text +5) - var-name (r.text +5)] - ($_ seq - (test "Can analyse variable." - (|> (&scope.with-scope scope-name - (&scope.with-local [var-name ref-type] - (@common.with-unknown-type - (@.analyse-reference ["" var-name])))) - (macro.run (io.run init-jvm)) - (case> (^ (#e.Success [_type (^code ((~ [_ (#.Int var)])))])) - (type/= ref-type _type) - - _ - false))) - (test "Can analyse definition." - (|> (do Monad<Meta> - [_ (&module.create +0 module-name) - _ (&module.define [module-name var-name] - [ref-type (' {}) (:! Bottom [])])] - (@common.with-unknown-type - (@.analyse-reference [module-name var-name]))) - (macro.run (io.run init-jvm)) - (case> (#e.Success [_type [_ (#.Symbol def-name)]]) - (type/= ref-type _type) - - _ - false))) - )))) 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) |