diff options
Diffstat (limited to 'stdlib/source')
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!")))) |