aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux37
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux202
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux15
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux168
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/packager.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/artifact.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/name.lux54
-rw-r--r--stdlib/source/program/compositor.lux61
13 files changed, 262 insertions, 352 deletions
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index c98304c87..19a71742c 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -1,5 +1,6 @@
(.module:
[lux (#- Module)
+ ["@" target (#+ Host)]
[abstract
["." monad (#+ do)]]
[control
@@ -49,15 +50,16 @@
["." artifact]
["." document]]]]])
-(def: #export (info target)
+(def: #export (info host)
(-> Text Info)
- {#.target target
+ {#.target host
#.version ///version.version
#.mode #.Build})
-(def: #export (state target expander host-analysis host generate generation-bundle host-directive-bundle program extender)
+(def: #export (state target module expander host-analysis host generate generation-bundle host-directive-bundle program extender)
(All [anchor expression directive]
- (-> Text
+ (-> Host
+ Module
Expander
///analysis.Bundle
(///generation.Host expression directive)
@@ -68,7 +70,7 @@
Extender
(///directive.State+ anchor expression directive)))
(let [synthesis-state [synthesisE.bundle ///synthesis.init]
- generation-state [generation-bundle (///generation.state host)]
+ generation-state [generation-bundle (///generation.state host module)]
eval (///analysis/evaluation.evaluator expander synthesis-state generation-state generate)
analysis-state [(analysisE.bundle eval host-analysis)
(///analysis.state (..info target) host)]]
@@ -130,12 +132,12 @@
(do ///phase.monad
[_ (///directive.lift-analysis
(module.set-compiled module))
- final-buffer (///directive.lift-generation
- (///generation.save-buffer! module))
analysis-module (<| (: (Operation .Module))
///directive.lift-analysis
extension.lift
- macro.current-module)]
+ macro.current-module)
+ final-buffer (///directive.lift-generation
+ ///generation.buffer)]
(wrap [analysis-module final-buffer])))
## TODO: Inline ASAP
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index a5e97d4b9..51f4729c5 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -81,18 +81,6 @@
## (encoding.to-utf8 (%.code (cache/description.write module-file-name module))))
)))
- (def: pause-context
- (All <type-vars>
- (-> <State+> ///generation.Context))
- (get@ [#extension.state #///directive.generation #///directive.state #extension.state #///generation.context]))
-
- (def: (resume-context context state)
- (All <type-vars>
- (-> ///generation.Context <State+> <State+>))
- (set@ [#extension.state #///directive.generation #///directive.state #extension.state #///generation.context]
- context
- state))
-
## TODO: Inline ASAP
(def: initialize-buffer!
(All <type-vars>
@@ -105,12 +93,6 @@
(-> <Platform> (///generation.Operation anchor expression directive Any)))
(get@ #runtime))
- ## TODO: Inline ASAP
- (def: save-runtime-buffer!
- (All <type-vars>
- (///generation.Operation anchor expression directive (Buffer directive)))
- (///generation.save-buffer! ""))
-
(def: (ensure-target! platform target host)
(All <type-vars>
(-> <Platform> Path Host (Promise (Try Any))))
@@ -121,10 +103,11 @@
[_ (mkdir target)]
(mkdir (ioW.archive system host target)))))
- (def: #export (initialize target host expander host-analysis platform generation-bundle host-directive-bundle program extender)
+ (def: #export (initialize target host module expander host-analysis platform generation-bundle host-directive-bundle program extender)
(All <type-vars>
(-> Path
Host
+ Module
Expander
///analysis.Bundle
<Platform>
@@ -132,8 +115,9 @@
(///directive.Bundle anchor expression directive)
(-> expression directive)
Extender
- (Promise (Try <State+>))))
+ (Promise (Try [<State+> (Buffer directive)]))))
(let [state (//init.state host
+ module
expander
host-analysis
(get@ #host platform)
@@ -146,12 +130,10 @@
[_ (..ensure-target! platform target host)]
(|> (do ///phase.monad
[_ ..initialize-buffer!
- _ (..compile-runtime! platform)
- buffer ..save-runtime-buffer!]
- (wrap []))
+ _ (..compile-runtime! platform)]
+ ///generation.buffer)
///directive.lift-generation
(///phase.run' state)
- (:: try.functor map product.left)
promise@wrap)))
## (case (runtimeT.generate ## (initL.compiler (io.run js.init))
@@ -205,11 +187,10 @@
partial-host-extension
module)]
(loop [archive archive
- state (..resume-context (///generation.fresh-context module) state)
+ state state
compilation (compiler (:coerce ///.Input input))]
(do @
- [#let [dependencies (get@ #///.dependencies compilation)
- current-context (..pause-context state)]
+ [#let [dependencies (get@ #///.dependencies compilation)]
archive+state (monad.fold @
import!
[archive state]
@@ -237,7 +218,7 @@
## TODO: The context shouldn't need to be re-set either.
(|> (///analysis.set-current-module module)
///directive.lift-analysis
- (///phase.run' (..resume-context current-context state))
+ (///phase.run' state)
try.assume
product.left))
archive)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
index c8cd8f3cb..1cfd7db0f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
@@ -8,11 +8,10 @@
[data
["." product]
["." name ("#@." equivalence)]
- ["." text
+ ["." text ("#@." equivalence)
["%" format (#+ format)]]
[collection
["." row (#+ Row)]
- ["." dictionary (#+ Dictionary)]
["." list ("#@." functor)]]]]
[//
[synthesis (#+ Synthesis)]
@@ -21,34 +20,14 @@
[///
["." phase]
[meta
- [archive
- [descriptor (#+ Module)]
+ ["." archive (#+ Archive)
+ ["." descriptor (#+ Module)]
["." artifact]]]]])
-(type: #export Registry
- (Dictionary Name Text))
-
(exception: #export (cannot-interpret {error Text})
(exception.report
["Error" error]))
-(exception: #export (unknown-lux-name {name Name} {registry Registry})
- (exception.report
- ["Name" (%.name name)]
- ["Registry" (|> registry
- dictionary.keys
- (list.sort (:: name.order <))
- (list@map %.name)
- (text.join-with text.new-line))]))
-
-(exception: #export (cannot-overwrite-lux-name {lux-name Name}
- {old-host-name Text}
- {new-host-name Text})
- (exception.report
- ["Lux Name" (%.name lux-name)]
- ["Old Host Name" old-host-name]
- ["New Host Name" new-host-name]))
-
(template [<name>]
[(exception: #export (<name> {name Name})
(exception.report
@@ -58,30 +37,25 @@
[no-buffer-for-saving-code]
)
-(type: #export Context
- {#scope-name Text
- #inner-functions Nat})
-
(signature: #export (Host expression directive)
(: (-> Text expression (Try Any))
evaluate!)
(: (-> Text directive (Try Any))
execute!)
- (: (-> Name expression (Try [Text Any directive]))
+ (: (-> Module artifact.ID expression (Try [Text Any directive]))
define!))
(type: #export (Buffer directive) (Row [Name directive]))
-(type: #export (Output directive) (Row [Module (Buffer directive)]))
+(type: #export Context [Module artifact.ID])
(type: #export (State anchor expression directive)
- {#context Context
+ {#module Module
#anchor (Maybe anchor)
#host (Host expression directive)
#buffer (Maybe (Buffer directive))
- #output (Output directive)
#registry artifact.Registry
#counter Nat
- #name-cache Registry})
+ #context (Maybe artifact.ID)})
(template [<special> <general>]
[(type: #export (<special> anchor expression directive)
@@ -94,62 +68,18 @@
[Bundle extension.Bundle]
)
-(def: #export (fresh-context scope-name)
- (-> Text Context)
- {#scope-name scope-name
- #inner-functions 0})
-
-(def: #export (state host)
+(def: #export (state host module)
(All [anchor expression directive]
(-> (Host expression directive)
+ Module
(..State anchor expression directive)))
- {#context (..fresh-context "")
+ {#module module
#anchor #.None
#host host
#buffer #.None
- #output row.empty
#registry artifact.empty
#counter 0
- #name-cache (dictionary.new name.hash)})
-
-(def: #export (with-specific-context specific-scope expr)
- (All [anchor expression directive output]
- (-> Text
- (Operation anchor expression directive output)
- (Operation anchor expression directive output)))
- (function (_ [bundle state])
- (let [old (get@ #context state)]
- (case (expr [bundle (set@ #context (..fresh-context specific-scope) state)])
- (#try.Success [[bundle' state']
- output])
- (#try.Success [[bundle' (set@ #context old state')]
- output])
-
- (#try.Failure error)
- (#try.Failure error)))))
-
-(def: #export (with-context expr)
- (All [anchor expression directive output]
- (-> (Operation anchor expression directive output)
- (Operation anchor expression directive [Text output])))
- (function (_ [bundle state])
- (let [[old-scope old-inner] (get@ #context state)
- new-scope (format old-scope "$c" (%.nat old-inner))]
- (case (expr [bundle (set@ #context (..fresh-context new-scope) state)])
- (#try.Success [[bundle' state'] output])
- (#try.Success [[bundle' (set@ #context {#scope-name old-scope
- #inner-functions (inc old-inner)}
- state')]
- [new-scope output]])
-
- (#try.Failure error)
- (#try.Failure error)))))
-
-(def: #export context
- (All [anchor expression directive]
- (Operation anchor expression directive Text))
- (extension.read (|>> (get@ #context)
- (get@ #scope-name))))
+ #context #.None})
(def: #export empty-buffer Buffer row.empty)
@@ -203,11 +133,6 @@
set-buffer buffer (Buffer directive) no-active-buffer]
)
-(def: #export output
- (All [anchor expression directive]
- (Operation anchor expression directive (Output directive)))
- (extension.read (get@ #output)))
-
(def: #export next
(All [anchor expression directive]
(Operation anchor expression directive Nat))
@@ -237,11 +162,11 @@
[execute! directive]
)
-(def: #export (define! name code)
+(def: #export (define! module id code)
(All [anchor expression directive]
- (-> Name expression (Operation anchor expression directive [Text Any directive])))
+ (-> Module artifact.ID expression (Operation anchor expression directive [Text Any directive])))
(function (_ (^@ stateE [bundle state]))
- (case (:: (get@ #host state) define! name code)
+ (case (:: (get@ #host state) define! module id code)
(#try.Success output)
(#try.Success [stateE output])
@@ -252,9 +177,10 @@
(All [anchor expression directive]
(-> Bit Name directive (Operation anchor expression directive Any)))
(do phase.monad
- [label (..gensym "save")
- _ (if execute?
- (execute! label code)
+ [_ (if execute?
+ (do @
+ [label (..gensym "save")]
+ (execute! label code))
(wrap []))
?buffer (extension.read (get@ #buffer))]
(case ?buffer
@@ -266,38 +192,70 @@
#.None
(phase.throw ..no-buffer-for-saving-code name))))
-(def: #export (save-buffer! target)
+(def: #export (learn name)
(All [anchor expression directive]
- (-> Module (Operation anchor expression directive (Buffer directive))))
- (do phase.monad
- [buffer ..buffer
- _ (extension.update (update@ #output (row.add [target buffer])))]
- (wrap buffer)))
+ (-> Text (Operation anchor expression directive artifact.ID)))
+ (function (_ (^@ stateE [bundle state]))
+ (let [[id registry'] (artifact.definition name (get@ #registry state))]
+ (#try.Success [[bundle (set@ #registry registry' state)]
+ id]))))
-(def: #export (remember lux-name)
+(exception: #export (unknown-definition {name Name})
+ (exception.report
+ ["Name" (%.name name)]))
+
+(def: #export (remember archive name)
(All [anchor expression directive]
- (-> Name (Operation anchor expression directive Text)))
- (function (_ (^@ stateE [_ state]))
- (let [cache (get@ #name-cache state)]
- (case (dictionary.get lux-name cache)
- (#.Some host-name)
- (#try.Success [stateE host-name])
-
- #.None
- (exception.throw ..unknown-lux-name [lux-name cache])))))
-
-(def: #export (learn lux-name host-name)
+ (-> Archive Name (Operation anchor expression directive Context)))
+ (function (_ (^@ stateE [bundle state]))
+ (let [[_module _name] name]
+ (do try.monad
+ [registry (if (text@= (get@ #module state) _module)
+ (#try.Success (get@ #registry state))
+ (do try.monad
+ [[descriptor document] (archive.find _module archive)]
+ (#try.Success (get@ #descriptor.registry descriptor))))]
+ (case (artifact.remember _name registry)
+ #.None
+ (exception.throw ..unknown-definition name)
+
+ (#.Some id)
+ (#try.Success [stateE [_module id]]))))))
+
+(exception: #export no-context)
+
+(def: #export context
(All [anchor expression directive]
- (-> Name Text (Operation anchor expression directive Any)))
+ (Operation anchor expression directive Context))
+ (function (_ (^@ stateE [bundle state]))
+ (case (get@ #context state)
+ #.None
+ (exception.throw ..no-context [])
+
+ (#.Some id)
+ (#try.Success [stateE [(get@ #module state) id]]))))
+
+(def: #export (with-context id body)
+ (All [anchor expression directive a]
+ (-> artifact.ID
+ (Operation anchor expression directive a)
+ (Operation anchor expression directive a)))
(function (_ [bundle state])
- (let [cache (get@ #name-cache state)]
- (case (dictionary.get lux-name cache)
- #.None
- (#try.Success [[bundle
- (update@ #name-cache
- (dictionary.put lux-name host-name)
- state)]
- []])
-
- (#.Some old-host-name)
- (exception.throw ..cannot-overwrite-lux-name [lux-name old-host-name host-name])))))
+ (do try.monad
+ [[[bundle' state'] output] (body [bundle (set@ #context (#.Some id) state)])]
+ (wrap [[bundle' (set@ #context (get@ #context state) state')]
+ output]))))
+
+(def: #export (with-new-context body)
+ (All [anchor expression directive a]
+ (-> (Operation anchor expression directive a)
+ (Operation anchor expression directive [Context a])))
+ (function (_ (^@ stateE [bundle state]))
+ (let [[id registry'] (artifact.resource (get@ #registry state))]
+ (do try.monad
+ [[[bundle' state'] output] (body [bundle (|> state
+ (set@ #registry registry')
+ (set@ #context (#.Some id)))])]
+ (wrap [[bundle' (set@ #context (get@ #context state) state')]
+ [[(get@ #module state) id]
+ output]])))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index b5f4c77b3..efceba1d9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -88,7 +88,7 @@
(evaluate!' archive generate type codeS)))
## TODO: Inline "definition'" into "definition" ASAP
-(def: (definition' archive generate name code//type codeS)
+(def: (definition' archive generate [module name] code//type codeS)
(All [anchor expression directive]
(-> Archive
(/////generation.Phase anchor expression directive)
@@ -98,10 +98,11 @@
(Operation anchor expression directive [Type expression Text Any])))
(/////directive.lift-generation
(do phase.monad
- [codeT (generate archive codeS)
- [target-name value directive] (/////generation.define! name codeT)
- _ (/////generation.save! false name directive)]
- (wrap [code//type codeT target-name value]))))
+ [codeG (generate archive codeS)
+ id (/////generation.learn name)
+ [target-name value directive] (/////generation.define! module id codeG)
+ _ (/////generation.save! false [module name] directive)]
+ (wrap [code//type codeG target-name value]))))
(def: (definition archive name expected codeC)
(All [anchor expression directive]
@@ -163,8 +164,6 @@
_ (/////directive.lift-analysis
(module.define short-name (#.Right [exported? type (:coerce Code annotations) value])))
#let [_ (log! (format "Definition " (%.name full-name)))]
- _ (/////directive.lift-generation
- (/////generation.learn full-name valueN))
_ (..refresh expander host-analysis)]
(wrap /////directive.no-requirements))
@@ -188,8 +187,6 @@
[_ (module.define short-name (#.Right [exported? type annotations value]))]
(module.declare-tags tags exported? (:coerce Type value))))
#let [_ (log! (format "Definition " (%.name full-name)))]
- _ (/////directive.lift-generation
- (/////generation.learn full-name valueN))
_ (..refresh expander host-analysis)]
(wrap /////directive.no-requirements)))]))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index 3e3daa995..3a7691134 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -983,94 +983,96 @@
## (:: type.equivalence = type.double returnT)
_.dreturn))))
-(def: class::anonymous
- Handler
- (..custom
- [($_ <>.and
- <s>.text
- ..class
- (<s>.tuple (<>.some ..class))
- (<s>.tuple (<>.some ..input))
- (<s>.tuple (<>.some ..overriden-method-definition)))
- (function (_ extension-name generate archive [class-name
- super-class super-interfaces
- inputsTS
- overriden-methods])
- (do //////.monad
- [#let [class (type.class class-name (list))
- total-environment (|> overriden-methods
- ## Get all the environments.
- (list@map product.left)
- ## Combine them.
- list@join
- ## Remove duplicates.
- (set.from-list //////reference.hash)
- set.to-list)
- global-mapping (|> total-environment
- ## Give them names as "foreign" variables.
- list.enumerate
- (list@map (function (_ [id capture])
- [capture (#//////reference.Foreign id)]))
- (dictionary.from-list //////reference.hash))
- normalized-methods (list@map (function (_ [environment
- [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- body]])
- (let [local-mapping (|> environment
- list.enumerate
- (list@map (function (_ [foreign-id capture])
- [(#//////reference.Foreign foreign-id)
- (|> global-mapping
- (dictionary.get capture)
- maybe.assume)]))
- (dictionary.from-list //////reference.hash))]
- [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- (normalize-method-body local-mapping body)]))
- overriden-methods)]
- inputsTI (monad.map @ (generate-input generate archive) inputsTS)
- method-definitions (monad.map @ (function (_ [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- bodyS])
- (do @
- [bodyG (//////generation.with-specific-context class-name
- (generate archive bodyS))]
- (wrap (method.method ($_ modifier@compose
- method.public
- method.final
- (if strict-fp?
- method.strict
- modifier@identity))
- name
- (type.method [(list@map product.right arguments)
- returnT
- exceptionsT])
- (list)
- (#.Some ($_ _.compose
- bodyG
- (returnG returnT)))))))
- normalized-methods)
- bytecode (<| (:: @ map (format.run class.writer))
- //////.lift
- (class.class version.v6_0 ($_ modifier@compose class.public class.final)
- (name.internal class-name)
- (name.internal (..reflection super-class))
- (list@map (|>> ..reflection name.internal) super-interfaces)
- (foreign.variables total-environment)
- (list& (..with-anonymous-init class total-environment super-class inputsTI)
- method-definitions)
- (row.row)))
- _ (//////generation.save! true ["" class-name] [class-name bytecode])]
- (anonymous-instance class total-environment)))]))
+## TODO: Uncomment ASAP.
+## (def: class::anonymous
+## Handler
+## (..custom
+## [($_ <>.and
+## <s>.text
+## ..class
+## (<s>.tuple (<>.some ..class))
+## (<s>.tuple (<>.some ..input))
+## (<s>.tuple (<>.some ..overriden-method-definition)))
+## (function (_ extension-name generate archive [class-name
+## super-class super-interfaces
+## inputsTS
+## overriden-methods])
+## (do //////.monad
+## [#let [class (type.class class-name (list))
+## total-environment (|> overriden-methods
+## ## Get all the environments.
+## (list@map product.left)
+## ## Combine them.
+## list@join
+## ## Remove duplicates.
+## (set.from-list //////reference.hash)
+## set.to-list)
+## global-mapping (|> total-environment
+## ## Give them names as "foreign" variables.
+## list.enumerate
+## (list@map (function (_ [id capture])
+## [capture (#//////reference.Foreign id)]))
+## (dictionary.from-list //////reference.hash))
+## normalized-methods (list@map (function (_ [environment
+## [ownerT name
+## strict-fp? annotations vars
+## self-name arguments returnT exceptionsT
+## body]])
+## (let [local-mapping (|> environment
+## list.enumerate
+## (list@map (function (_ [foreign-id capture])
+## [(#//////reference.Foreign foreign-id)
+## (|> global-mapping
+## (dictionary.get capture)
+## maybe.assume)]))
+## (dictionary.from-list //////reference.hash))]
+## [ownerT name
+## strict-fp? annotations vars
+## self-name arguments returnT exceptionsT
+## (normalize-method-body local-mapping body)]))
+## overriden-methods)]
+## inputsTI (monad.map @ (generate-input generate archive) inputsTS)
+## method-definitions (monad.map @ (function (_ [ownerT name
+## strict-fp? annotations vars
+## self-name arguments returnT exceptionsT
+## bodyS])
+## (do @
+## [bodyG (//////generation.with-specific-context class-name
+## (generate archive bodyS))]
+## (wrap (method.method ($_ modifier@compose
+## method.public
+## method.final
+## (if strict-fp?
+## method.strict
+## modifier@identity))
+## name
+## (type.method [(list@map product.right arguments)
+## returnT
+## exceptionsT])
+## (list)
+## (#.Some ($_ _.compose
+## bodyG
+## (returnG returnT)))))))
+## normalized-methods)
+## bytecode (<| (:: @ map (format.run class.writer))
+## //////.lift
+## (class.class version.v6_0 ($_ modifier@compose class.public class.final)
+## (name.internal class-name)
+## (name.internal (..reflection super-class))
+## (list@map (|>> ..reflection name.internal) super-interfaces)
+## (foreign.variables total-environment)
+## (list& (..with-anonymous-init class total-environment super-class inputsTI)
+## method-definitions)
+## (row.row)))
+## _ (//////generation.save! true ["" class-name] [class-name bytecode])]
+## (anonymous-instance class total-environment)))]))
(def: bundle::class
Bundle
(<| (/////bundle.prefix "class")
(|> (: Bundle /////bundle.empty)
- (/////bundle.install "anonymous" class::anonymous)
+ ## TODO: Uncomment ASAP
+ ## (/////bundle.install "anonymous" class::anonymous)
)))
(def: #export bundle
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux
index 019714867..38fd9fec8 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux
@@ -42,7 +42,7 @@
(/reference.variable variable)
(#reference.Constant constant)
- (/reference.constant constant))
+ (/reference.constant archive constant))
(^ (synthesis.branch/case [valueS pathS]))
(/case.case generate archive [valueS pathS])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
index ebc8f6906..891d74f71 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
@@ -93,9 +93,10 @@
(Generator Abstraction)
(do phase.monad
[@begin //runtime.forge-label
- [function-class bodyG] (generation.with-context
- (generation.with-anchor [@begin ..this-offset]
- (generate archive bodyS)))
+ [function-context bodyG] (generation.with-new-context
+ (generation.with-anchor [@begin ..this-offset]
+ (generate archive bodyS)))
+ #let [function-class (//runtime.class-name function-context)]
[fields methods instance] (..with @begin function-class environment arity bodyG)
class (phase.lift (class.class version.v6_0
..modifier
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/packager.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/packager.lux
index 6a317699c..95d3640b6 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/packager.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/packager.lux
@@ -7,7 +7,7 @@
[number
["n" nat]]
[collection
- ["." row]
+ ["." row (#+ Row)]
["." list ("#@." fold)]]]
[target
[jvm
@@ -16,7 +16,7 @@
[//
[runtime (#+ Definition)]
[////
- [generation (#+ Buffer Output)]
+ [generation (#+ Buffer)]
[///
[meta
[archive
@@ -98,7 +98,7 @@
(list@fold ..write-class sink)))
(def: #export (package program-class outputs)
- (-> External (Output Definition) Binary)
+ (-> External (Row [Module (Buffer Definition)]) Binary)
(let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte))
sink (java/util/jar/JarOutputStream::new buffer (manifest program-class))]
(exec (|> outputs
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux
index 6cec91906..913b28793 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux
@@ -12,7 +12,7 @@
[encoding
["." unsigned]]]]]
["." // #_
- [runtime (#+ Operation)]
+ ["#." runtime (#+ Operation)]
["#." value]
["#." type]
["//#" /// #_
@@ -20,7 +20,9 @@
["." generation]
[///
["#" phase ("operation@." monad)]
- ["." reference (#+ Register Variable)]]]]])
+ ["." reference (#+ Register Variable)]
+ [meta
+ [archive (#+ Archive)]]]]]])
(def: #export this
(Bytecode Any)
@@ -38,10 +40,11 @@
(def: (foreign variable)
(-> Register (Operation (Bytecode Any)))
(do ////.monad
- [function-class generation.context]
+ [bytecode-name (:: @ map //runtime.class-name
+ generation.context)]
(wrap ($_ _.compose
..this
- (_.getfield (type.class function-class (list))
+ (_.getfield (type.class bytecode-name (list))
(..foreign-name variable)
//type.value)))))
@@ -54,8 +57,9 @@
(#reference.Foreign variable)
(..foreign variable)))
-(def: #export (constant name)
- (-> Name (Operation (Bytecode Any)))
+(def: #export (constant archive name)
+ (-> Archive Name (Operation (Bytecode Any)))
(do ////.monad
- [bytecode-name (generation.remember name)]
+ [bytecode-name (:: @ map //runtime.class-name
+ (generation.remember archive name))]
(wrap (_.getstatic (type.class bytecode-name (list)) //value.field //type.value))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index 0582b21be..14df69e42 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -14,7 +14,9 @@
["." list ("#@." functor)]
["." row]]
["." format #_
- ["#" binary]]]
+ ["#" binary]]
+ [text
+ ["%" format (#+ format)]]]
[target
[jvm
["_" bytecode (#+ Label Bytecode)]
@@ -74,6 +76,12 @@
(type: #export Host
(generation.Host (Bytecode Any) Definition))
+(def: prefix "lux/")
+
+(def: #export (class-name [module id])
+ (-> generation.Context Text)
+ (format ..prefix module "/" (%.nat id)))
+
(def: #export class (type.class "LuxRuntime" (list)))
(def: procedure
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
index 222bb2479..534749ace 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
@@ -11,8 +11,8 @@
(type: #export ID Nat)
(type: Artifact
- (#Resource ID)
- (#Definition [ID Text]))
+ {#id ID
+ #name (Maybe Text)})
(abstract: #export Registry
{}
@@ -33,7 +33,8 @@
(|> registry
:representation
(update@ #next inc)
- (update@ #artifacts (row.add (#Resource id)))
+ (update@ #artifacts (row.add {#id id
+ #name #.None}))
:abstraction)]))
(def: #export (definition name registry)
@@ -43,6 +44,13 @@
(|> registry
:representation
(update@ #next inc)
- (update@ #artifacts (row.add (#Definition id name)))
+ (update@ #artifacts (row.add {#id id
+ #name (#.Some name)}))
:abstraction)]))
+
+ (def: #export (remember name registry)
+ (-> Text Registry (Maybe ID))
+ (|> (:representation registry)
+ (get@ #resolver)
+ (dictionary.get name)))
)
diff --git a/stdlib/source/lux/tool/compiler/name.lux b/stdlib/source/lux/tool/compiler/name.lux
deleted file mode 100644
index 19a7f5dae..000000000
--- a/stdlib/source/lux/tool/compiler/name.lux
+++ /dev/null
@@ -1,54 +0,0 @@
-(.module:
- [lux #*
- [data
- ["." maybe]
- [number
- ["n" nat]]
- ["." text
- ["%" format (#+ format)]]]])
-
-(`` (template: (!sanitize char)
- ("lux syntax char case!" char
- [["*"] "_AS"
- ["+"] "_PL"
- ["-"] "_DS"
- ["/"] "_SL"
- ["\"] "_BS"
- ["_"] "_US"
- ["%"] "_PC"
- ["$"] "_DL"
- ["'"] "_QU"
- ["`"] "_BQ"
- ["@"] "_AT"
- ["^"] "_CR"
- ["&"] "_AA"
- ["="] "_EQ"
- ["!"] "_BG"
- ["?"] "_QM"
- [":"] "_CO"
- [";"] "_SC"
- ["."] "_PD"
- [","] "_CM"
- ["<"] "_LT"
- [">"] "_GT"
- ["~"] "_TI"
- ["|"] "_PI"
- [" "] "_SP"]
- (text.from-code char))))
-
-(def: #export (normalize name)
- (-> Text Text)
- (let [name/size (text.size name)]
- (loop [idx 0
- output ""]
- (if (n.< name/size idx)
- (recur (inc idx)
- (|> name
- ("lux text char" idx)
- !sanitize
- (format output)))
- output))))
-
-(def: #export (definition [module short])
- (-> Name Text)
- (format (normalize module) "___" (normalize short)))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 43e58cf50..886582c34 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Module)
[type (#+ :share)]
["@" target (#+ Host)]
[abstract
@@ -12,7 +12,7 @@
[security
["!" capability]]
[concurrency
- ["." promise (#+ Promise)]]]
+ ["." promise (#+ Promise) ("#@." monad)]]]
[data
[binary (#+ Binary)]
["." product]
@@ -20,7 +20,7 @@
["%" format (#+ format)]]
[collection
["." dictionary]
- ["." row]
+ ["." row (#+ Row)]
["." list ("#@." functor fold)]]]
[time
["." instant (#+ Instant)]]
@@ -42,7 +42,8 @@
[phase
[extension (#+ Extender)]]]]
[meta
- ["." archive (#+ Archive)]]]
+ ["." archive (#+ Archive)
+ [descriptor (#+ Module)]]]]
## ["." interpreter]
]]
[/
@@ -64,31 +65,32 @@
(wrap output))))
(with-expansions [<parameters> (as-is anchor expression artifact)]
- (def: (save-artifacts! system state [packager package])
- (All [<parameters>]
- (-> (file.System Promise)
- (directive.State+ <parameters>)
- [(-> (generation.Output artifact) Binary) Path]
- (Promise (Try Any))))
- (let [?outcome (phase.run' state
- (:share [<parameters>]
- {(directive.State+ <parameters>)
- state}
- {(directive.Operation <parameters>
- (generation.Output artifact))
- (directive.lift-generation generation.output)}))]
- (case ?outcome
- (#try.Success [state output])
- (do (try.with promise.monad)
- [file (: (Promise (Try (File Promise)))
- (file.get-file promise.monad system package))]
- (!.use (:: file over-write) (packager output)))
+ ## TODO: Clean-up ASAP.
+ ## (def: (save-artifacts! system state [packager package])
+ ## (All [<parameters>]
+ ## (-> (file.System Promise)
+ ## (directive.State+ <parameters>)
+ ## [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
+ ## (Promise (Try Any))))
+ ## (let [?outcome (phase.run' state
+ ## (:share [<parameters>]
+ ## {(directive.State+ <parameters>)
+ ## state}
+ ## {(directive.Operation <parameters>
+ ## (generation.Output artifact))
+ ## (directive.lift-generation generation.output)}))]
+ ## (case ?outcome
+ ## (#try.Success [state output])
+ ## (do (try.with promise.monad)
+ ## [file (: (Promise (Try (File Promise)))
+ ## (file.get-file promise.monad system package))]
+ ## (!.use (:: file over-write) (packager output)))
- (#try.Failure error)
- (:: promise.monad wrap (#try.Failure error)))))
+ ## (#try.Failure error)
+ ## (promise@wrap (#try.Failure error)))))
(def: #export (compiler target partial-host-extension
- expander host-analysis platform host generation-bundle host-directive-bundle program extender
+ expander host-analysis platform host module generation-bundle host-directive-bundle program extender
service
packager,package)
(All [<parameters>]
@@ -98,12 +100,13 @@
analysis.Bundle
(IO (Platform <parameters>))
Host
+ Module
(generation.Bundle <parameters>)
(directive.Bundle <parameters>)
(-> expression artifact)
Extender
Service
- [(-> (generation.Output artifact) Binary) Path]
+ [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
(Promise Any)))
(do promise.monad
[platform (promise.future platform)
@@ -118,13 +121,13 @@
{(Platform <parameters>)
platform}
{(Promise (Try (directive.State+ <parameters>)))
- (platform.initialize target host expander host-analysis platform generation-bundle host-directive-bundle program extender)})
+ (platform.initialize target host module expander host-analysis platform generation-bundle host-directive-bundle program extender)})
[archive state] (:share [<parameters>]
{(Platform <parameters>)
platform}
{(Promise (Try [Archive (directive.State+ <parameters>)]))
(platform.compile target partial-host-extension expander platform host configuration archive.empty state)})
- _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
+ ## _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
## _ (cache/io.clean target ...)
]
(wrap (log! "Compilation complete!"))))