diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 94 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/actor.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 21 | ||||
| -rw-r--r-- | stdlib/source/lux/host.old.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/lux/macro.lux | 87 | ||||
| -rw-r--r-- | stdlib/source/lux/target/php.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/target/ruby.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/target/scheme.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/analysis/module.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/analysis/reference.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/extension/statement.lux | 40 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/type/abstract.lux | 52 | ||||
| -rw-r--r-- | stdlib/source/lux/type/implicit.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux | 4 |
15 files changed, 241 insertions, 155 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index b75b5bebe..aff2f300a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -419,6 +419,28 @@ #Nil)) #1) +## (type: Alias +## Name) +("lux def" Alias + ("lux check type" + (#Named ["lux" "Alias"] + Name)) + (record$ #Nil) + #1) + +## (type: Global +## (| Alias +## Definition)) +("lux def" Global + ("lux check type" + (#Named ["lux" "Global"] + (#Sum Alias + Definition))) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Represents all the data associated with a global constant.")] + #Nil)) + #1) + ## (type: (Bindings k v) ## {#counter Nat ## #mappings (List [k v])}) @@ -525,7 +547,7 @@ ## (type: Module ## {#module-hash Nat ## #module-aliases (List [Text Text]) -## #definitions (List [Text Definition]) +## #definitions (List [Text Global]) ## #imports (List Text) ## #tags (List [Text [Nat (List Name) Bit Type]]) ## #types (List [Text [(List Name) Bit Type]]) @@ -538,7 +560,7 @@ (#Product ## "lux.module-aliases" (#Apply (#Product Text Text) List) (#Product ## "lux.definitions" - (#Apply (#Product Text Definition) List) + (#Apply (#Product Text Global) List) (#Product ## "lux.imports" (#Apply Text List) (#Product ## "lux.tags" @@ -1724,13 +1746,13 @@ #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] ({(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _}) - ({(#Some [exported? def-type def-meta def-value]) - ({(#Some [_ (#Identifier real-name)]) + ({(#Some constant) + ({(#Left real-name) (#Right [state real-name]) - - _ + + (#Right [exported? def-type def-meta def-value]) (#Right [state full-name])} - (get-meta ["lux" "alias"] def-meta)) + constant) #None (#Left ($_ text@compose "Unknown definition: " (name@encode full-name)))} @@ -2527,19 +2549,18 @@ [$module (get module modules) gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] (get name bindings))] - (let' [[exported? def-type def-meta def-value] ("lux check" Definition gdef)] - (if (macro-type? def-type) - (if exported? - (#Some ("lux coerce" Macro def-value)) - (if (text@= module current-module) - (#Some ("lux coerce" Macro def-value)) - #None)) - ({(#Some [_ (#Identifier [r-module r-name])]) - (find-macro' modules current-module r-module r-name) - - _ - #None} - (get-meta ["lux" "alias"] def-meta)))))) + ({(#Left [r-module r-name]) + (find-macro' modules current-module r-module r-name) + + (#Right [exported? def-type def-meta def-value]) + (if (macro-type? def-type) + (if exported? + (#Some ("lux coerce" Macro def-value)) + (if (text@= module current-module) + (#Some ("lux coerce" Macro def-value)) + #None)) + #None)} + ("lux check" Global gdef)))) (def:''' (normalize name) #Nil @@ -4227,12 +4248,17 @@ modules)] (case (get module modules) (#Some =module) - (let [to-alias (list@map (: (-> [Text Definition] + (let [to-alias (list@map (: (-> [Text Global] (List Text)) - (function (_ [name [exported? def-type def-meta def-value]]) - (if exported? - (list name) - (list)))) + (function (_ [name definition]) + (case definition + (#Left _) + (list) + + (#Right [exported? def-type def-meta def-value]) + (if exported? + (list name) + (list))))) (let [{#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] definitions))] (#Right state (list@join to-alias))) @@ -4307,8 +4333,13 @@ #None #None - (#Some [exported? def-type def-meta def-value]) - (#Some def-type))))) + (#Some definition) + (case definition + (#Left de-aliased) + (find-def-type de-aliased state) + + (#Right [exported? def-type def-meta def-value]) + (#Some def-type)))))) (def: (find-def-value name state) (-> Name (Meta [Type Any])) @@ -4326,8 +4357,13 @@ #None (#Left (text@compose "Unknown definition: " (name@encode name))) - (#Some [exported? def-type def-meta def-value]) - (#Right [state [def-type def-value]]))))) + (#Some definition) + (case definition + (#Left de-aliased) + (find-def-value de-aliased state) + + (#Right [exported? def-type def-meta def-value]) + (#Right [state [def-type def-value]])))))) (def: (find-type-var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 09ef7e625..a0e44b1bf 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -169,13 +169,18 @@ (def: #export (<resolve> name) (-> Name (Meta Name)) (do macro.monad - [[_ _ annotations _] (macro.find-def name)] - (case (macro.get-tag-ann (name-of <tag>) annotations) - (#.Some actor-name) - (wrap actor-name) - - _ - (macro.fail (format "Definition is not " <desc> ".")))))] + [constant (macro.find-def name)] + (case constant + (#.Left de-aliased) + (<resolve> de-aliased) + + (#.Right [_ _ annotations _]) + (case (macro.get-tag-ann (name-of <tag>) annotations) + (#.Some actor-name) + (wrap actor-name) + + _ + (macro.fail (format "Definition is not " <desc> "."))))))] [with-actor resolve-actor #..actor "an actor"] [with-message resolve-message #..message "a message"] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 9578288c2..c6d636e82 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -393,14 +393,19 @@ (do macro.monad [current-module macro.current-module-name definitions (macro.definitions current-module)] - (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) - (function (_ [short-name [_ _ meta _]] imports) - (case (macro.get-text-ann (name-of #..jvm-class) meta) - (#.Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) + (wrap (list@fold (: (-> [Text Global] Class-Imports Class-Imports) + (function (_ [short-name constant] imports) + (case constant + (#.Left _) + imports + + (#.Right [_ _ meta _]) + (case (macro.get-text-ann (name-of #..jvm-class) meta) + (#.Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports)))) empty-imports definitions))))) (#.Left _) (list) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index db8145ab2..1f92a4a3b 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -369,18 +369,26 @@ (do macro.monad [current-module macro.current-module-name definitions (macro.definitions current-module)] - (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) - (function (_ [short-name [_ _ meta _]] imports) - (case (macro.get-text-ann (name-of #..jvm-class) meta) - (#.Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) + (wrap (list@fold (: (-> [Text Global] Class-Imports Class-Imports) + (function (_ [short-name constant] imports) + (case constant + (#.Left _) + imports + + (#.Right [_ _ meta _]) + (case (macro.get-text-ann (name-of #..jvm-class) meta) + (#.Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports)))) empty-imports definitions))))) - (#.Left _) (list) - (#.Right imports) imports)) + (#.Left _) + (list) + + (#.Right imports) + imports)) (def: java/lang/* (List Text) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 23d1223e4..7eedc2f35 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -206,15 +206,6 @@ [signature? #.sig? "a signature"] ) -(def: #export (aliased? annotations) - (-> Code Bit) - (case (get-identifier-ann (name-of #.alias) annotations) - (#.Some _) - #1 - - #.None - #0)) - (template [<name> <tag> <type>] [(def: (<name> input) (-> Code (Maybe <type>)) @@ -257,14 +248,17 @@ (Maybe Macro)) (do maybe.monad [$module (get module modules) - [exported? def-type def-anns def-value] (: (Maybe Definition) (|> (: Module $module) (get@ #.definitions) (get name)))] - (if (macro-type? def-type) - (#.Some (:coerce Macro def-value)) - (case (get-identifier-ann (name-of #.alias) def-anns) - (#.Some [r-module r-name]) - (find-macro' modules this-module r-module r-name) - - _ + definition (: (Maybe Global) + (|> (: Module $module) + (get@ #.definitions) + (get name)))] + (case definition + (#.Left [r-module r-name]) + (find-macro' modules this-module r-module r-name) + + (#.Right [exported? def-type def-anns def-value]) + (if (macro-type? def-type) + (#.Some (:coerce Macro def-value)) #.None)))) (def: #export (normalize name) @@ -501,11 +495,11 @@ (def: #export (find-def name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} - (-> Name (Meta Definition)) + (-> Name (Meta Global)) (do ..monad [name (normalize name)] (function (_ compiler) - (case (: (Maybe Definition) + (case (: (Maybe Global) (do maybe.monad [#let [[v-prefix v-name] name] (^slots [#.definitions]) (get v-prefix (get@ #.modules compiler))] @@ -533,8 +527,13 @@ {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Type)) (do ..monad - [[exported? def-type def-data def-value] (find-def name)] - (clean-type def-type))) + [definition (find-def name)] + (case definition + (#.Left de-aliased) + (find-def-type de-aliased) + + (#.Right [exported? def-type def-data def-value]) + (clean-type def-type)))) (def: #export (find-type name) {#.doc "Looks-up the type of either a local variable or a definition."} @@ -553,26 +552,40 @@ {#.doc "Finds the value of a type definition (such as Int, Any or Lux)."} (-> Name (Meta Type)) (do ..monad - [[exported? def-type def-data def-value] (find-def name)] - (wrap (:coerce Type def-value)))) + [definition (find-def name)] + (case definition + (#.Left de-aliased) + (find-type-def de-aliased) + + (#.Right [exported? def-type def-data def-value]) + (wrap (:coerce Type def-value))))) (def: #export (definitions module-name) {#.doc "The entire list of definitions in a module (including the non-exported/private ones)."} - (-> Text (Meta (List [Text Definition]))) + (-> Text (Meta (List [Text Global]))) (function (_ compiler) (case (get module-name (get@ #.modules compiler)) - #.None (#error.Failure ($_ text@compose "Unknown module: " module-name)) - (#.Some module) (#error.Success [compiler (get@ #.definitions module)]) - ))) + #.None + (#error.Failure ($_ text@compose "Unknown module: " module-name)) + + (#.Some module) + (#error.Success [compiler (get@ #.definitions module)])))) (def: #export (exports module-name) {#.doc "All the exported definitions in a module."} (-> Text (Meta (List [Text Definition]))) (do ..monad - [definitions (definitions module-name)] - (wrap (list.filter (function (_ [name [exported? def-type def-anns def-value]]) - exported?) - definitions)))) + [constants (definitions module-name)] + (wrap (do list.monad + [[name definition] constants] + (case definition + (#.Left _) + (list) + + (#.Right [exported? def-type def-data def-value]) + (if exported? + (wrap [name [exported? def-type def-data def-value]]) + (list))))))) (def: #export modules {#.doc "All the available modules (including the current one)."} @@ -689,13 +702,13 @@ {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Name (Meta Name)) (do ..monad - [[_ _ def-anns _] (find-def def-name)] - (case (get-identifier-ann (name-of #.alias) def-anns) - (#.Some real-def-name) - (wrap real-def-name) + [constant (find-def def-name)] + (wrap (case constant + (#.Left real-def-name) + real-def-name - _ - (wrap def-name)))) + (#.Right _) + def-name)))) (def: #export get-compiler {#.doc "Obtains the current state of the compiler."} diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux index 286d8d397..46689fd29 100644 --- a/stdlib/source/lux/target/php.lux +++ b/stdlib/source/lux/target/php.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code static int if cond or and not comment for) + [lux (#- Code Global static int if cond or and not comment for) [control [pipe (#+ case> cond> new>)]] [data diff --git a/stdlib/source/lux/target/ruby.lux b/stdlib/source/lux/target/ruby.lux index 037cdca5b..f82b5c92a 100644 --- a/stdlib/source/lux/target/ruby.lux +++ b/stdlib/source/lux/target/ruby.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code static int if cond function or and not comment) + [lux (#- Code Global static int if cond function or and not comment) [control [pipe (#+ case> cond> new>)]] [data diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux index 886d2ba88..652eb65ef 100644 --- a/stdlib/source/lux/target/scheme.lux +++ b/stdlib/source/lux/target/scheme.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code int or and if function cond let) + [lux (#- Code Global int or and if function cond let) [control [pipe (#+ new> cond> case>)]] [data diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux index 4894ce931..6a33171f1 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux @@ -118,7 +118,7 @@ [state] #error.Success)))) (def: #export (define name definition) - (-> Text Definition (Operation Any)) + (-> Text Global (Operation Any)) (///extension.lift (do ///.monad [self-name macro.current-module-name @@ -129,7 +129,7 @@ (#error.Success [(update@ #.modules (plist.put self-name (update@ #.definitions - (: (-> (List [Text Definition]) (List [Text Definition])) + (: (-> (List [Text Global]) (List [Text Global])) (|>> (#.Cons [name definition]))) self)) state) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux index a484eaebb..c09ea55ba 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux @@ -30,12 +30,12 @@ (-> Name (Operation Analysis)) (with-expansions [<return> (wrap (|> def-name ////reference.constant #/.Reference))] (do ///.monad - [[exported? actualT def-anns _] (///extension.lift (macro.find-def def-name))] - (case (macro.get-identifier-ann (name-of #.alias) def-anns) - (#.Some real-def-name) + [constant (///extension.lift (macro.find-def def-name))] + (case constant + (#.Left real-def-name) (definition real-def-name) - - _ + + (#.Right [exported? actualT def-anns _]) (do @ [_ (//type.infer actualT) (^@ def-name [::module ::name]) (///extension.lift (macro.normalize def-name)) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index 2b17c9f8a..992d5a932 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -4,6 +4,7 @@ ["." monad (#+ do)]] [control [io (#+ IO)] + ["." exception (#+ exception:)] ["p" parser ["s" code (#+ Parser)]]] [data @@ -139,7 +140,7 @@ #let [annotations (:coerce Code annotations)] [type valueT valueN value] (..definition full-name #.None valueC) _ (////statement.lift-analysis - (module.define short-name [exported? type annotations value])) + (module.define short-name (#.Right [exported? type annotations value]))) #let [_ (log! (format "Definition " (%name full-name)))] _ (////statement.lift-generation (///generation.learn full-name valueN)) @@ -179,7 +180,7 @@ [type valueT valueN value] (..definition full-name (#.Some .Type) valueC) _ (////statement.lift-analysis (do ///.monad - [_ (module.define short-name [exported? type annotations value])] + [_ (module.define short-name (#.Right [exported? type annotations value]))] (module.declare-tags tags exported? (:coerce Type value)))) #let [_ (log! (format "Definition " (%name full-name)))] _ (////statement.lift-generation @@ -214,36 +215,35 @@ (wrap {#////statement.imports imports #////statement.referrals (list)})))])) -## TODO: Reify aliasing as a feature of the compiler, instead of -## manifesting it implicitly through definition annotations. -(def: (alias-annotations original) - (-> Name Code) - (` {#.alias (~ (code.identifier original))})) +(exception: #export (cannot-alias-an-alias {local Alias} {foreign Alias} {target Name}) + (exception.report + ["Local alias" (%name local)] + ["Foreign alias" (%name foreign)] + ["Target definition" (%name target)])) (def: (define-alias alias original) (-> Text Name (////analysis.Operation Any)) (do ///.monad - [[exported? original-type original-annotations original-value] - (//.lift (macro.find-def original))] - (module.define alias [false - original-type - (alias-annotations original) - original-value]))) + [current-module (//.lift macro.current-module-name) + constant (//.lift (macro.find-def original))] + (case constant + (#.Left de-aliased) + (///.throw ..cannot-alias-an-alias [[current-module alias] original de-aliased]) + + (#.Right [exported? original-type original-annotations original-value]) + (module.define alias (#.Left original))))) (def: def::alias Handler - (function (_ extension-name phase inputsC+) - (case inputsC+ - (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)])) + (..custom + [($_ p.and s.local-identifier s.identifier) + (function (_ extension-name phase [alias def-name]) (do ///.monad [_ (//.lift (///.sub [(get@ [#////statement.analysis #////statement.state]) (set@ [#////statement.analysis #////statement.state])] (define-alias alias def-name)))] - (wrap ////statement.no-requirements)) - - _ - (///.throw //.invalid-syntax [extension-name %code inputsC+])))) + (wrap ////statement.no-requirements)))])) (template [<mame> <type> <scope>] [(def: <mame> diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux index 7281a0c0e..b67f4d20a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- inc) + [lux (#- Global inc) [abstract [monad (#+ do)]] [control diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 70ec590da..70b742236 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -42,9 +42,13 @@ (undefined)))) (def: (peek-scopes-definition reference source) - (-> Text (List [Text Definition]) (Stack Scope)) + (-> Text (List [Text Global]) (Stack Scope)) (!peek source reference - (let [[exported? scope-type scope-anns scope-value] head] + (case head + (#.Left _) + (undefined) + + (#.Right [exported? scope-type scope-anns scope-value]) (:coerce (Stack Scope) scope-value)))) (def: (peek-scopes reference definition-reference source) @@ -88,13 +92,17 @@ (undefined)))) (def: (push-scope-definition reference scope source) - (-> Text Scope (List [Text Definition]) (List [Text Definition])) + (-> Text Scope (List [Text Global]) (List [Text Global])) (!push source reference - (let [[exported? scopes-type scopes-anns scopes-value] head] - [exported? - scopes-type - scopes-anns - (stack.push scope (:coerce (Stack Scope) scopes-value))]))) + (case head + (#.Left _) + (undefined) + + (#.Right [exported? scopes-type scopes-anns scopes-value]) + (#.Right [exported? + scopes-type + scopes-anns + (stack.push scope (:coerce (Stack Scope) scopes-value))])))) (def: (push-scope [module-reference definition-reference] scope source) (-> Name Scope (List [Text Module]) (List [Text Module])) @@ -110,19 +118,23 @@ []]))) (def: (pop-scope-definition reference source) - (-> Text (List [Text Definition]) (List [Text Definition])) + (-> Text (List [Text Global]) (List [Text Global])) (!push source reference - (let [[exported? scopes-type scopes-anns scopes-value] head] - [exported? - scopes-type - scopes-anns - (let [current-scopes (:coerce (Stack Scope) scopes-value)] - (case (stack.pop current-scopes) - (#.Some current-scopes') - current-scopes' - - #.None - current-scopes))]))) + (case head + (#.Left _) + (undefined) + + (#.Right [exported? scopes-type scopes-anns scopes-value]) + (#.Right [exported? + scopes-type + scopes-anns + (let [current-scopes (:coerce (Stack Scope) scopes-value)] + (case (stack.pop current-scopes) + (#.Some current-scopes') + current-scopes' + + #.None + current-scopes))])))) (def: (pop-scope [module-reference definition-reference] source) (-> Name (List [Text Module]) (List [Text Module])) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 90fd32c1c..083a07e4d 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -1,7 +1,7 @@ (.module: [lux #* [abstract - ["." monad (#+ do Monad)] + ["." monad (#+ Monad do)] ["eq" equivalence]] [control ["p" parser @@ -111,13 +111,20 @@ [idx tag-list sig-type] (macro.resolve-tag member)] (wrap [idx sig-type]))) -(def: (prepare-definitions this-module-name definitions) - (-> Text (List [Text Definition]) (List [Name Type])) - (|> definitions - (list.filter (function (_ [name [exported? def-type def-anns def-value]]) - (macro.structure? def-anns))) - (list@map (function (_ [name [exported? def-type def-anns def-value]]) - [[this-module-name name] def-type])))) +(def: (prepare-definitions source-module target-module constants) + (-> Text Text (List [Text Global]) (List [Name Type])) + (do list.monad + [[name constant] constants] + (case constant + (#.Left _) + (list) + + (#.Right [exported? def-type def-anns def-value]) + (if (and (macro.structure? def-anns) + (or (text@= target-module source-module) + exported?)) + (list [[source-module name] def-type]) + (list))))) (def: local-env (Meta (List [Name Type])) @@ -137,7 +144,7 @@ (do macro.monad [this-module-name macro.current-module-name definitions (macro.definitions this-module-name)] - (wrap (prepare-definitions this-module-name definitions)))) + (wrap (prepare-definitions this-module-name this-module-name definitions)))) (def: import-structs (Meta (List [Name Type])) @@ -146,8 +153,8 @@ imp-mods (macro.imported-modules this-module-name) export-batches (monad.map @ (function (_ imp-mod) (do @ - [exports (macro.exports imp-mod)] - (wrap (prepare-definitions imp-mod exports)))) + [exports (macro.definitions imp-mod)] + (wrap (prepare-definitions imp-mod this-module-name exports)))) imp-mods)] (wrap (list@join export-batches)))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux index 5d8782a4f..842c23950 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux @@ -46,7 +46,7 @@ (-> Text [Bit Text] [Bit Text] Check Bit) (|> (do ///.monad [_ (//module.with-module 0 def-module - (//module.define var-name [export? Any (' {}) []]))] + (//module.define var-name (#.Right [export? Any (' {}) []])))] (//module.with-module 0 dependent-module (do @ [_ (if import? @@ -82,7 +82,7 @@ (_.test "Can analyse definition (in the same module)." (let [def-name [def-module var-name]] (|> (do ///.monad - [_ (//module.define var-name [false expectedT (' {}) []])] + [_ (//module.define var-name (#.Right [false expectedT (' {}) []]))] (//type.with-inference (_primitive.phase (code.identifier def-name)))) (//module.with-module 0 def-module) |