aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2019-03-16 01:45:58 -0400
committerEduardo Julian2019-03-16 01:45:58 -0400
commit3589348d31a21e3d8e670c1d3e7a0bf83ef3e420 (patch)
tree016994f20083948e36ca5f474928d117333a5979 /stdlib/source
parentc2bc59de623699dcb338e74a822ce02cb8deee19 (diff)
Got serial imports fully working.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux.lux31
-rw-r--r--stdlib/source/lux/tool/compiler.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux185
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux111
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/statement.lux76
-rw-r--r--stdlib/source/lux/tool/compiler/phase/statement.lux79
-rw-r--r--stdlib/source/lux/tool/compiler/statement.lux34
8 files changed, 325 insertions, 204 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index c6e14e66b..2b99f51f8 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1487,7 +1487,7 @@
#Nil)))))))
_
- (fail "Wrong syntax for def'''")}
+ (fail "Wrong syntax for def:'''")}
tokens))
(def:''' (as-pairs xs)
@@ -4173,16 +4173,16 @@
(def: #export module-separator "/")
-(def: (count-ups ups input)
+(def: (count-relatives relatives input)
(-> Nat Text Nat)
- (case ("lux text index" input ..module-separator ups)
+ (case ("lux text index" input ..module-separator relatives)
#None
- ups
+ relatives
(#Some found)
- (if (n/= ups found)
- (count-ups (n/+ 1 ups) input)
- ups)))
+ (if (n/= relatives found)
+ (count-relatives (n/+ 1 relatives) input)
+ relatives)))
(def: (list;take amount list)
(All [a] (-> Nat (List a) (List a)))
@@ -4204,22 +4204,23 @@
(def: (clean-module nested? relative-root module)
(-> Bit Text Text (Meta Text))
- (case (count-ups 0 module)
+ (case (count-relatives 0 module)
0
(return (if nested?
($_ "lux text concat" relative-root ..module-separator module)
module))
- ups
- (let [parts (text;split-all-with ..module-separator relative-root)]
- (if (n/< (list;size parts) (n/- 1 ups))
+ relatives
+ (let [parts (text;split-all-with ..module-separator relative-root)
+ jumps (n/- 1 relatives)]
+ (if (n/< (list;size parts) jumps)
(let [prefix (|> parts
list;reverse
- (list;drop (n/- 1 ups))
+ (list;drop jumps)
list;reverse
(interpose ..module-separator)
(text;join-with ""))
- clean ("lux text clip" module ups ("lux text size" module))
+ clean ("lux text clip" module relatives ("lux text size" module))
output (case ("lux text size" clean)
0 prefix
_ ($_ text;compose prefix ..module-separator clean))]
@@ -4931,8 +4932,8 @@
imports)
=meta (process-def-meta (list& [(` #.imports) (` [(~+ =imports)])]
_meta))
- =module (` ("lux module" [(~ cursor-code)
- (#.Record (~ =meta))]))]]
+ =module (` ("lux def module" [(~ cursor-code)
+ (#.Record (~ =meta))]))]]
(wrap (#Cons =module =refers))))
(macro: #export (:: tokens)
diff --git a/stdlib/source/lux/tool/compiler.lux b/stdlib/source/lux/tool/compiler.lux
index 12a2f869c..836e9022a 100644
--- a/stdlib/source/lux/tool/compiler.lux
+++ b/stdlib/source/lux/tool/compiler.lux
@@ -4,6 +4,7 @@
["." exception (#+ exception:)]]
[data
["." error (#+ Error)]
+ ["." text]
[collection
["." dictionary (#+ Dictionary)]]]
[world
@@ -30,11 +31,15 @@
(type: #export (Output o)
(Dictionary Text o))
+(def: #export empty-output
+ Output
+ (dictionary.new text.hash))
+
(type: #export (Compilation s d o)
{#dependencies (List Module)
#process (-> s Archive
- (Error (Either [s (Compilation s d o)]
- [s [Descriptor (Document d)] (Output o)])))})
+ (Error [s (Either (Compilation s d o)
+ [[Descriptor (Document d)] (Output o)])]))})
(type: #export (Compiler s d o)
(-> Input (Compilation s d o)))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index a4359f73d..21ee99c15 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -1,13 +1,15 @@
(.module:
- [lux (#- Module loop)
+ [lux (#- Module)
[control
["." monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." product]
["." error (#+ Error)]
- ["." text ("#;." hash)]
+ ["." text ("#;." hash)
+ format]
[collection
+ ["." list ("#@." functor)]
["." dictionary]
["." set]]]
["." macro]
@@ -19,7 +21,7 @@
["#/" // (#+ Instancer)
["#." analysis]
["#." synthesis]
- ["#." statement]
+ ["#." statement (#+ Requirements)]
["#." host]
["#." phase
[macro (#+ Expander)]
@@ -112,90 +114,105 @@
(set@ #.cursor cursor))]
output])))))
-(with-expansions [<Operation> (as-is (All [anchor expression statement]
- (///statement.Operation anchor expression statement Any)))]
-
- (def: (begin dependencies hash input)
- (-> (List Module) Nat ///.Input <Operation>)
- (///statement.lift-analysis
- (do ///phase.monad
- [#let [module (get@ #///.module input)]
- _ (module.create hash module)
- _ (///analysis.set-current-module module)
- _ (monad.map @ module.import dependencies)]
- (///analysis.set-source-code (///analysis.source (get@ #///.module input) (get@ #///.code input))))))
-
- (def: end
- (-> Module <Operation>)
- (|>> module.set-compiled
- ///statement.lift-analysis))
-
- (def: (iteration expander reader)
- (-> Expander Reader <Operation>)
- (let [execute (statementP.phase expander)]
- (do ///phase.monad
- [code (///statement.lift-analysis
- (..read reader))
- _ (execute code)]
- (..refresh expander))))
-
- (def: (loop expander module)
- (-> Expander Module <Operation>)
- (do ///phase.monad
- [reader (///statement.lift-analysis
- (..reader module //syntax.no-aliases))]
- (function (_ state)
- (.loop [state state]
- (case (..iteration expander reader state)
- (#error.Success [state' output])
- (recur state')
-
- (#error.Failure error)
- (if (ex.match? //syntax.end-of-file error)
- (#error.Success [state []])
- (ex.with-stack ///.cannot-compile module (#error.Failure error))))))))
-
- (def: (compile expander dependencies hash input)
- (-> Expander (List Module) Nat ///.Input <Operation>)
+(type: (Operation a)
+ (All [anchor expression statement]
+ (///statement.Operation anchor expression statement a)))
+
+(def: (begin dependencies hash input)
+ (-> (List Module) Nat ///.Input (Operation Any))
+ (///statement.lift-analysis
+ (do ///phase.monad
+ [#let [module (get@ #///.module input)]
+ _ (module.create hash module)
+ _ (///analysis.set-current-module module)
+ _ (monad.map @ module.import dependencies)]
+ (///analysis.set-source-code (///analysis.source (get@ #///.module input) (get@ #///.code input))))))
+
+(def: end
+ (-> Module (Operation Any))
+ (|>> module.set-compiled
+ ///statement.lift-analysis))
+
+(def: (iteration expander reader)
+ (-> Expander Reader (Operation Requirements))
+ (let [execute! (statementP.phase expander)]
(do ///phase.monad
- [#let [module (get@ #///.module input)]
- _ (..begin dependencies hash input)
- _ (..loop expander module)]
- (..end module)))
-
- (def: (default-dependencies prelude input)
- (-> Module ///.Input (List Module))
- (if (text;= prelude (get@ #///.module input))
- (list)
- (list prelude)))
- )
-
-(def: #export (compiler expander prelude module)
- (-> Expander Module Module
+ [code (///statement.lift-analysis
+ (..read reader))
+ requirements (execute! code)
+ _ (..refresh expander)]
+ (wrap requirements))))
+
+(def: (iterate expander module)
+ (-> Expander Module (Operation (Maybe Requirements)))
+ (do ///phase.monad
+ [reader (///statement.lift-analysis
+ (..reader module //syntax.no-aliases))]
+ (function (_ state)
+ (case (..iteration expander reader state)
+ (#error.Success [state requirements])
+ (#error.Success [state (#.Some requirements)])
+
+ (#error.Failure error)
+ (if (ex.match? //syntax.end-of-file error)
+ (#error.Success [state #.None])
+ (ex.with-stack ///.cannot-compile module (#error.Failure error)))))))
+
+(def: (default-dependencies prelude input)
+ (-> Module ///.Input (List Module))
+ (if (text;= prelude (get@ #///.module input))
+ (list)
+ (list prelude)))
+
+(def: #export (compiler expander prelude)
+ (-> Expander Module
(All [anchor expression statement]
(Instancer (///statement.State+ anchor expression statement) .Module)))
- (function (_ key parameters input)
- (let [hash (text;hash (get@ #///.code input))
- dependencies (default-dependencies prelude input)]
- {#///.dependencies dependencies
- #///.process (function (_ state archive)
- (do error.monad
- [[state' analysis-module] (///phase.run' state
- (: (All [anchor expression statement]
- (///statement.Operation anchor expression statement .Module))
- (do ///phase.monad
- [_ (compile expander dependencies hash input)]
- (///statement.lift-analysis
- (extension.lift
- macro.current-module)))))
- #let [descriptor {#descriptor.hash hash
- #descriptor.name (get@ #///.module input)
- #descriptor.file (get@ #///.file input)
- #descriptor.references (set.from-list text.hash dependencies)
- #descriptor.state #.Compiled}]]
- (wrap (#.Right [state'
- [descriptor (document.write key analysis-module)]
- (dictionary.new text.hash)]))))})))
+ (let [execute! (statementP.phase expander)]
+ (function (_ key parameters input)
+ (let [dependencies (default-dependencies prelude input)]
+ {#///.dependencies dependencies
+ #///.process (function (_ state archive)
+ (do error.monad
+ [#let [hash (text;hash (get@ #///.code input))]
+ [state _] (<| (///phase.run' state)
+ (..begin dependencies hash input))
+ #let [module (get@ #///.module input)]]
+ (loop [iteration (<| (///phase.run' state)
+ (..iterate expander module))]
+ (do @
+ [[state ?requirements] iteration]
+ (case ?requirements
+ #.None
+ (do @
+ [[state analysis-module] (<| (///phase.run' state)
+ (do ///phase.monad
+ [_ (..end module)]
+ (<| (: (Operation .Module))
+ ///statement.lift-analysis
+ extension.lift
+ macro.current-module)))
+ #let [descriptor {#descriptor.hash hash
+ #descriptor.name module
+ #descriptor.file (get@ #///.file input)
+ #descriptor.references (set.from-list text.hash dependencies)
+ #descriptor.state #.Compiled}]]
+ (wrap [state
+ (#.Right [[descriptor (document.write key analysis-module)]
+ (dictionary.new text.hash)])]))
+
+ (#.Some requirements)
+ (wrap [state
+ (#.Left {#///.dependencies (|> requirements
+ (get@ #///statement.imports)
+ (list@map product.left))
+ #///.process (function (_ state archive)
+ (recur (<| (///phase.run' state)
+ (do ///phase.monad
+ [_ (monad.map @ execute! (get@ #///statement.referrals requirements))
+ _ (..refresh expander)]
+ (..iterate expander module)))))})])
+ )))))}))))
(def: #export key
(Key .Module)
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index e1ffb64bd..05e645e58 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -7,6 +7,8 @@
["." bit]
["." product]
["." error (#+ Error)]
+ [text
+ format]
[collection
["." list]]]
[world
@@ -15,6 +17,7 @@
["#." init]
["#." syntax]
["#/" //
+ ["#." analysis]
["#." statement]
["#." phase
[macro (#+ Expander)]
@@ -48,12 +51,13 @@
## (format module-name "/" cache.descriptor-name)
## (encoding.to-utf8 (%code (cache/description.write file-name module))))))
-(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
+(with-expansions [<type-vars> (as-is [! anchor expression statement])
+ <Platform> (as-is (Platform ! anchor expression statement))
<State+> (as-is (///statement.State+ anchor expression statement))
<Bundle> (as-is (generation.Bundle anchor expression statement))]
(def: #export (initialize expander platform generation-bundle)
- (All [! anchor expression statement]
+ (All <type-vars>
(-> Expander <Platform> <Bundle> (! (Error <State+>))))
(|> platform
(get@ #runtime)
@@ -92,7 +96,7 @@
)
(def: #export (compile expander platform configuration archive state)
- (All [! anchor expression statement]
+ (All <type-vars>
(-> Expander <Platform> Configuration Archive <State+> (! (Error [Archive <State+>]))))
(let [monad (get@ #&monad platform)
source-module (get@ #cli.module configuration)
@@ -100,51 +104,72 @@
{<State+>
state}
{(///.Compiler <State+> .Module Any)
- ((//init.compiler expander //syntax.prelude source-module) //init.key (list))})]
+ ((//init.compiler expander //syntax.prelude) //init.key (list))})]
(loop [module source-module
[archive state] [archive state]]
- (let [import! (:share [! anchor expression statement]
- {<Platform>
- platform}
- {(-> Module [Archive <State+>]
- (! (Error [Archive <State+>])))
- recur})]
- (do (error.with monad)
- [input (context.read monad
- (get@ #&file-system platform)
- (get@ #cli.sources configuration)
- module)
- ## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
- ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
- ]
- (loop [state state
- compilation (compiler (:coerce ///.Input input))]
- (do @
- [archive+state' (monad.fold @
- import!
- [archive state]
- (list.filter (bit.complement (archive.archived? archive))
- (get@ #///.dependencies compilation)))
- #let [[archive' state'] (:share [! anchor expression statement]
+ (if (archive.archived? archive module)
+ (:: monad wrap (#error.Success [archive state]))
+ (let [import! (:share <type-vars>
+ {<Platform>
+ platform}
+ {(-> Module [Archive <State+>]
+ (! (Error [Archive <State+>])))
+ recur})]
+ (do (error.with monad)
+ [input (context.read monad
+ (get@ #&file-system platform)
+ (get@ #cli.sources configuration)
+ module)
+ ## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
+ ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
+ ]
+ (loop [archive archive
+ state state
+ compilation (compiler (:coerce ///.Input input))]
+ (do @
+ [#let [dependencies (get@ #///.dependencies compilation)]
+ archive+state (monad.fold @
+ import!
+ [archive state]
+ (list.filter (bit.complement (archive.archived? archive))
+ dependencies))
+ #let [[archive state] (:share <type-vars>
{<Platform>
platform}
{[Archive <State+>]
- archive+state'})
- continue! (:share [! anchor expression statement]
- {<Platform>
- platform}
- {(-> <State+> (///.Compilation <State+> .Module Any)
- (! (Error [Archive <State+>])))
- recur})]]
- (case ((get@ #///.process compilation) state' archive')
- (#error.Success more|done)
- (case more|done
- (#.Left [state'' more])
- (continue! state'' more)
+ archive+state})
+ continue! (:share <type-vars>
+ {<Platform>
+ platform}
+ {(-> Archive <State+> (///.Compilation <State+> .Module Any)
+ (! (Error [Archive <State+>])))
+ recur})]]
+ (case ((get@ #///.process compilation)
+ (case dependencies
+ #.Nil
+ state
- (#.Right [state'' descriptor+document output])
- (wrap [(archive.add module descriptor+document archive') state'']))
+ _
+ ## TODO: The "///analysis.set-current-module" below shouldn't be necessary. Remove it ASAP.
+ (|> (///analysis.set-current-module module)
+ ///statement.lift-analysis
+ (///phase.run' state)
+ error.assume
+ product.left))
+ archive)
+ (#error.Success [state more|done])
+ (case more|done
+ (#.Left more)
+ (continue! archive state more)
- (#error.Failure error)
- (:: monad wrap (#error.Failure error))))))))))
+ (#.Right [descriptor+document output])
+ (case (archive.add module descriptor+document archive)
+ (#error.Success archive)
+ (wrap [archive state])
+
+ (#error.Failure error)
+ (:: monad wrap (#error.Failure error))))
+
+ (#error.Failure error)
+ (:: monad wrap (#error.Failure error)))))))))))
)
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index 96a6e3b63..e9ecee8cd 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -75,6 +75,10 @@
(#error.Failure _)
no))
+ (def: #export archived
+ (-> Archive (List Module))
+ (|>> :representation dictionary.keys))
+
(def: #export (merge additions archive)
(-> Archive Archive (Error Archive))
(monad.fold error.monad
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
index 172517dd0..e36af0de6 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
@@ -1,15 +1,17 @@
(.module:
[lux #*
[control
- [monad (#+ do)]
- pipe]
+ ["." monad (#+ do)]
+ ["p" parser]]
[data
+ ["." error]
[text
format]
[collection
["." list ("#;." functor)]
["." dictionary]]]
- ["." macro]
+ ["." macro
+ ["s" syntax (#+ Syntax)]]
[type (#+ :share :by-example)
["." check]]]
["." //
@@ -22,7 +24,7 @@
["#/" // #_
["#." analysis]
["#." synthesis (#+ Synthesis)]
- ["#." statement (#+ Operation Handler Bundle)]]]])
+ ["#." statement (#+ Import Operation Handler Bundle)]]]])
## TODO: Inline "evaluate!'" into "evaluate!" ASAP
(def: (evaluate!' generate code//type codeS)
@@ -135,9 +137,10 @@
#.None)
valueC)
_ (..define short-name value//type annotationsV valueV)
- #let [_ (log! (format "Definition " (%name full-name)))]]
- (////statement.lift-generation
- (///generation.learn full-name valueN)))
+ #let [_ (log! (format "Definition " (%name full-name)))]
+ _ (////statement.lift-generation
+ (///generation.learn full-name valueN))]
+ (wrap ////statement.no-requirements))
_
(///.throw //.invalid-syntax [extension-name]))))
@@ -148,6 +151,14 @@
[definition (//.lift (macro.find-def def-name))]
(module.define alias definition)))
+(def: imports
+ (Syntax (List Import))
+ (|> (s.tuple (p.and s.text s.text))
+ p.some
+ s.tuple
+ (p.after (s.this (' #.imports)))
+ s.record))
+
(def: def::module
Handler
(function (_ extension-name phase inputsC+)
@@ -155,9 +166,23 @@
(^ (list annotationsC))
(do ///.monad
[[_ annotationsT annotationsV] (evaluate! Code annotationsC)
+ imports (case (s.run (list (:coerce Code annotationsV))
+ ..imports)
+ (#error.Success imports)
+ (wrap imports)
+
+ (#error.Failure error)
+ (///.throw //.invalid-syntax [extension-name]))
_ (////statement.lift-analysis
- (module.set-annotations (:coerce Code annotationsV)))]
- (wrap []))
+ (do ///.monad
+ [_ (monad.map @ (function (_ [module alias])
+ (do @
+ [_ (module.import module)]
+ (module.alias alias module)))
+ imports)]
+ (module.set-annotations (:coerce Code annotationsV))))]
+ (wrap {#////statement.imports imports
+ #////statement.referrals (list)}))
_
(///.throw //.invalid-syntax [extension-name]))))
@@ -167,10 +192,12 @@
(function (_ extension-name phase inputsC+)
(case inputsC+
(^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)]))
- (//.lift
- (///.sub [(get@ [#////statement.analysis #////statement.state])
- (set@ [#////statement.analysis #////statement.state])]
- (alias! alias def-name)))
+ (do ///.monad
+ [_ (//.lift
+ (///.sub [(get@ [#////statement.analysis #////statement.state])
+ (set@ [#////statement.analysis #////statement.state])]
+ (alias! alias def-name)))]
+ (wrap ////statement.no-requirements))
_
(///.throw //.invalid-syntax [extension-name]))))
@@ -187,22 +214,23 @@
{(Handler anchor expression statement)
handler}
<type>)
- valueC)]
- (<| <scope>
- (//.install name)
- (:share [anchor expression statement]
- {(Handler anchor expression statement)
- handler}
- {<type>
- (:assume handlerV)})))
+ valueC)
+ _ (<| <scope>
+ (//.install name)
+ (:share [anchor expression statement]
+ {(Handler anchor expression statement)
+ handler}
+ {<type>
+ (:assume handlerV)}))]
+ (wrap ////statement.no-requirements))
_
(///.throw //.invalid-syntax [extension-name]))))]
- [def::analysis ////analysis.Handler ////statement.lift-analysis]
- [def::synthesis ////synthesis.Handler ////statement.lift-synthesis]
+ [def::analysis ////analysis.Handler ////statement.lift-analysis]
+ [def::synthesis ////synthesis.Handler ////statement.lift-synthesis]
[def::generation (///generation.Handler anchor expression statement) ////statement.lift-generation]
- [def::statement (////statement.Handler anchor expression statement) (<|)]
+ [def::statement (////statement.Handler anchor expression statement) (<|)]
)
(def: bundle::def
diff --git a/stdlib/source/lux/tool/compiler/phase/statement.lux b/stdlib/source/lux/tool/compiler/phase/statement.lux
index 7e55e2dc6..1ab3d41ef 100644
--- a/stdlib/source/lux/tool/compiler/phase/statement.lux
+++ b/stdlib/source/lux/tool/compiler/phase/statement.lux
@@ -5,7 +5,9 @@
["." exception (#+ exception:)]]
[data
[text
- format]]
+ format]
+ [collection
+ ["." list ("#;." fold monoid)]]]
["." macro]]
["." //
["#." macro (#+ Expander)]
@@ -20,7 +22,7 @@
(exception.report
["Statement" (%code code)]))
-(exception: #export (not-a-macro-call {code Code})
+(exception: #export (invalid-macro-call {code Code})
(exception.report
["Code" (%code code)]))
@@ -28,35 +30,48 @@
(exception.report
["Name" (%name name)]))
-(def: #export (phase expander)
- (-> Expander Phase)
- (let [analyze (analysisP.phase expander)]
- (function (compile code)
- (case code
- (^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
- (//extension.apply compile [name inputs])
+(with-expansions [<lux_def_module> (as-is [|form-cursor| (#.Form (list& [|text-cursor| (#.Text "lux def module")] annotations))])]
+ (def: #export (phase expander)
+ (-> Expander Phase)
+ (let [analyze (analysisP.phase expander)]
+ (function (compile code)
+ (case code
+ (^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
+ (do //.monad
+ [requirements (//extension.apply compile [name inputs])]
+ (wrap requirements))
- (^ [_ (#.Form (list& macro inputs))])
- (do //.monad
- [expansion (/.lift-analysis
- (do @
- [macroA (type.with-type Macro
- (analyze macro))]
- (case macroA
- (^ (///analysis.constant macro-name))
- (do @
- [?macro (//extension.lift (macro.find-macro macro-name))
- macro (case ?macro
- (#.Some macro)
- (wrap macro)
-
- #.None
- (//.throw macro-was-not-found macro-name))]
- (//extension.lift (//macro.expand expander macro-name macro inputs)))
-
- _
- (//.throw not-a-macro-call code))))]
- (monad.map @ compile expansion))
+ (^ [_ (#.Form (list& macro inputs))])
+ (do //.monad
+ [expansion (/.lift-analysis
+ (do @
+ [macroA (type.with-type Macro
+ (analyze macro))]
+ (case macroA
+ (^ (///analysis.constant macro-name))
+ (do @
+ [?macro (//extension.lift (macro.find-macro macro-name))
+ macro (case ?macro
+ (#.Some macro)
+ (wrap macro)
+
+ #.None
+ (//.throw macro-was-not-found macro-name))]
+ (//extension.lift (//macro.expand expander macro-name macro inputs)))
+
+ _
+ (//.throw invalid-macro-call code))))
+ requirements (case expansion
+ (^ (list& <lux_def_module> referrals))
+ (do @
+ [requirements (compile <lux_def_module>)]
+ (wrap (update@ #/.referrals (list;compose referrals) requirements)))
- _
- (//.throw not-a-statement code)))))
+ _
+ (|> expansion
+ (monad.map @ compile)
+ (:: @ map (list;fold /.merge-requirements /.no-requirements))))]
+ (wrap requirements))
+
+ _
+ (//.throw not-a-statement code))))))
diff --git a/stdlib/source/lux/tool/compiler/statement.lux b/stdlib/source/lux/tool/compiler/statement.lux
index 7f251c42d..49fd51c7b 100644
--- a/stdlib/source/lux/tool/compiler/statement.lux
+++ b/stdlib/source/lux/tool/compiler/statement.lux
@@ -1,6 +1,14 @@
(.module:
- [lux #*]
+ [lux (#- Module)
+ [data
+ [text
+ format]
+ [collection
+ ["." list ("#;." monoid)]]]]
[//
+ [meta
+ [archive
+ [descriptor (#+ Module)]]]
["." analysis]
["." synthesis]
["." phase
@@ -19,9 +27,27 @@
#generation (Component (generation.State+ anchor expression statement)
(generation.Phase anchor expression statement))})
+(type: #export Import
+ {#module Module
+ #alias Text})
+
+(type: #export Requirements
+ {#imports (List Import)
+ #referrals (List Code)})
+
+(def: #export no-requirements
+ Requirements
+ {#imports (list)
+ #referrals (list)})
+
+(def: #export (merge-requirements left right)
+ (-> Requirements Requirements Requirements)
+ {#imports (list;compose (get@ #imports left) (get@ #imports right))
+ #referrals (list;compose (get@ #referrals left) (get@ #referrals right))})
+
(do-template [<special> <general>]
[(type: #export (<special> anchor expression statement)
- (<general> (..State anchor expression statement) Code Any))]
+ (<general> (..State anchor expression statement) Code Requirements))]
[State+ extension.State]
[Operation extension.Operation]
@@ -40,7 +66,7 @@
(set@ [<component> #..state])]
operation)))]
- [lift-analysis #..analysis analysis.Operation]
- [lift-synthesis #..synthesis synthesis.Operation]
+ [lift-analysis #..analysis analysis.Operation]
+ [lift-synthesis #..synthesis synthesis.Operation]
[lift-generation #..generation (generation.Operation anchor expression statement)]
)