diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/packager.lux | 110 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/extension.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/extension/common.lux (renamed from new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux) | 0 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/extension/host.lux (renamed from new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux) | 0 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.lux | 8 | ||||
| -rw-r--r-- | new-luxc/source/program.lux | 64 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/init.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/packager/js.lux (renamed from stdlib/source/lux/tool/compiler/meta/packager/script.lux) | 19 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 20 |
11 files changed, 207 insertions, 61 deletions
diff --git a/new-luxc/source/luxc/lang/packager.lux b/new-luxc/source/luxc/lang/packager.lux new file mode 100644 index 000000000..f18055b18 --- /dev/null +++ b/new-luxc/source/luxc/lang/packager.lux @@ -0,0 +1,110 @@ +(.module: + [lux #* + ["." host (#+ import: do-to)] + [data + ["." binary (#+ Binary)] + ["." text] + [number + ["n" nat]] + [collection + ["." row] + ["." list ("#@." fold)]]] + [target + [jvm + [encoding + ["." name (#+ External)]]]] + [tool + [compiler + [phase + [generation (#+ Buffer Output)]] + [meta + [archive + [descriptor (#+ Module)]]]]]] + [// + [host + [jvm (#+ Definition)]]]) + +(import: #long java/lang/Object) + +(import: #long java/lang/String) + +(import: #long java/util/jar/Attributes + (put [java/lang/Object java/lang/Object] #? java/lang/Object)) + +(import: #long java/util/jar/Attributes$Name + (#static MAIN_CLASS java/util/jar/Attributes$Name) + (#static MANIFEST_VERSION java/util/jar/Attributes$Name)) + +(import: #long java/util/jar/Manifest + (new []) + (getMainAttributes [] java/util/jar/Attributes)) + +(import: #long java/io/Flushable + (flush [] void)) + +(import: #long java/io/Closeable + (close [] void)) + +(import: #long java/io/OutputStream) + +(import: #long java/io/ByteArrayOutputStream + (new [int]) + (toByteArray [] [byte])) + +(import: #long java/util/zip/ZipEntry) + +(import: #long java/util/zip/ZipOutputStream + (write [[byte] int int] void) + (closeEntry [] void)) + +(import: #long java/util/jar/JarEntry + (new [java/lang/String])) + +(import: #long java/util/jar/JarOutputStream + (new [java/io/OutputStream java/util/jar/Manifest]) + (putNextEntry [java/util/zip/ZipEntry] void)) + +(def: byte 1) +(def: kilo-byte (n.* 1,000 byte)) +(def: mega-byte (n.* 1,000 kilo-byte)) + +(def: manifest-version "1.0") + +(def: class-name + (-> Text Text) + (text.suffix ".class")) + +(def: (manifest program-class) + (-> External java/util/jar/Manifest) + (let [manifest (java/util/jar/Manifest::new)] + (exec (do-to (java/util/jar/Manifest::getMainAttributes manifest) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) program-class) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest-version)) + manifest))) + +(def: (write-class [def-name [class-name bytecode]] sink) + (-> [Name Definition] java/util/jar/JarOutputStream java/util/jar/JarOutputStream) + (let [class-name (|> class-name name.internal name.read ..class-name)] + (do-to sink + (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class-name)) + (java/util/zip/ZipOutputStream::write bytecode +0 (.int (binary.size bytecode))) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry)))) + +(def: (write-module [module classes] sink) + (-> [Module (Buffer Definition)] java/util/jar/JarOutputStream java/util/jar/JarOutputStream) + (|> classes + row.to-list + (list@fold ..write-class sink))) + +(def: #export (package program-class outputs) + (-> External (Output Definition) Binary) + (let [buffer (java/io/ByteArrayOutputStream::new (.int mega-byte)) + sink (java/util/jar/JarOutputStream::new buffer (manifest program-class))] + (exec (|> outputs + row.to-list + (list@fold ..write-module sink)) + (do-to sink + (java/io/Flushable::flush) + (java/io/Closeable::close)) + (java/io/ByteArrayOutputStream::toByteArray buffer)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension.lux b/new-luxc/source/luxc/lang/translation/jvm/extension.lux new file mode 100644 index 000000000..9066dd156 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/jvm/extension.lux @@ -0,0 +1,16 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [//// + [host + [jvm (#+ Bundle)]]] + ["." / #_ + ["#." common] + ["#." host]]) + +(def: #export bundle + Bundle + (dictionary.merge /common.bundle + /host.bundle)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux index a46813232..a46813232 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux index ca6e31bfd..ca6e31bfd 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index d616d62e9..f97831ac5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux @@ -322,7 +322,7 @@ (def: reflection (|>> type.reflection reflection.reflection)) (def: translate-runtime - (Operation ByteCode) + (Operation Any) (let [runtime-class (..reflection //.$Runtime) bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime-class (list) (type.class "java.lang.Object" (list)) (list) (|>> adt-methods @@ -331,10 +331,10 @@ io-methods))] (do phase.monad [_ (generation.execute! runtime-class [runtime-class bytecode])] - (wrap bytecode)))) + (generation.save! false ["" runtime-class] [runtime-class bytecode])))) (def: translate-function - (Operation ByteCode) + (Operation Any) (let [applyI (|> (list.n/range 2 num-apply-variants) (list@map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) @@ -363,7 +363,7 @@ applyI))] (do phase.monad [_ (generation.execute! function-class [function-class bytecode])] - (wrap bytecode)))) + (generation.save! false ["" function-class] [function-class bytecode])))) (def: #export translate (Operation Any) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index b579b0df0..91b42c981 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -10,6 +10,8 @@ [parser [cli (#+ program:)]]] [data + [text + ["%" format (#+ format)]] [collection [array (#+ Array)] ["." dictionary]]] @@ -22,8 +24,8 @@ [compiler [phase ["." macro (#+ Expander)] - ["." extension #_ - [analysis + [extension + ["." analysis #_ ["#" jvm]]]] [default ["." platform (#+ Platform)]]]]] @@ -32,19 +34,18 @@ ["/." cli]]] [luxc [lang + ["." packager] [host ["_" jvm ["$d" def] ["$i" inst]]] - [directive - [".S" jvm]] + ["." directive #_ + ["#" jvm]] [translation ["." jvm ["." runtime] ["." expression] - [procedure - [".E" common] - [".E" host]]]]]]) + ["translation" extension]]]]]) (import: #long java/lang/reflect/Method (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) @@ -80,7 +81,7 @@ (host.array-write 1 (:coerce java/lang/Object lux))) apply-method)))) -(def: #export jvm +(def: #export platform (IO (Platform IO _.Anchor _.Inst _.Definition)) (do io.monad [host jvm.host] @@ -90,6 +91,8 @@ #platform.phase expression.translate #platform.runtime runtime.translate}))) +(def: program-class "LuxProgram") + (def: #export (program programI) (-> _.Inst _.Definition) (let [$Object ($t.class "java.lang.Object" (list)) @@ -134,40 +137,39 @@ $i.SWAP ($i.GOTO @loop) ($i.label @end) - $i.POP - ($i.ASTORE 0))) + $i.POP)) + feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)) run-ioI (|>> ($i.CHECKCAST jvm.$Function) $i.NULL ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))) main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list)))) $t.void - (list)]) - bytecode-name "_"] - [bytecode-name + (list)])] + [..program-class ($d.class #_.V1_6 #_.Public _.finalC - bytecode-name + ..program-class (list) $Object (list) (|>> ($d.method #_.Public _.staticM "main" main-type - (|>> prepare-input-listI - programI + (|>> programI + prepare-input-listI + feed-inputsI run-ioI - $i.POP $i.RETURN))))])) -(def: #export bundle - _.Bundle - (dictionary.merge commonE.bundle - hostE.bundle)) - (program: [{service /cli.service}] - (/.compiler @.jvm - ".jvm" - ..expander - extension.bundle - ..jvm - ..bundle - jvmS.bundle - ..program - service)) + (let [(^slots [#/cli.target #/cli.module]) (case service + (#/cli.Compilation configuration) configuration + (#/cli.Interpretation configuration) configuration) + jar-path (format target (:: file.system separator) "program.jar")] + (/.compiler @.jvm + ".jvm" + ..expander + analysis.bundle + ..platform + translation.bundle + directive.bundle + ..program + service + [(packager.package ..program-class) jar-path]))) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index fc9a805f7..40549f8d0 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -237,7 +237,10 @@ ///directive.lift-analysis extension.lift macro.current-module) - _ (monad.map @ execute! (get@ #///directive.referrals requirements))] + _ (///directive.lift-generation + (generation.set-buffer buffer)) + _ (monad.map @ execute! (get@ #///directive.referrals requirements)) + buffer (..get-current-buffer buffer)] (..iterate expander module source buffer (..module-aliases analysis-module))))))})]) )))))})))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 4ed6d6d42..04937092a 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -24,7 +24,7 @@ [macro (#+ Expander)] ## TODO: Get rid of this import ASAP [extension (#+)] - ["." generation] + ["." generation (#+ Buffer)] [analysis ["." module]]] [meta @@ -67,8 +67,26 @@ (///directive.Bundle anchor expression directive) (-> expression directive) (! (Try <State+>)))) - (|> platform - (get@ #runtime) + (|> (do ///phase.monad + [_ (:share [anchor expression directive] + {(///directive.Bundle anchor expression directive) + host-directive-bundle} + {(generation.Operation anchor expression directive Any) + (generation.set-buffer (:share [anchor expression directive] + {(///directive.Bundle anchor expression directive) + host-directive-bundle} + {(Buffer directive) + generation.empty-buffer}))}) + _ (:share [anchor expression directive] + {(///directive.Bundle anchor expression directive) + host-directive-bundle} + {(generation.Operation anchor expression directive Any) + (get@ #runtime platform)})] + (:share [anchor expression directive] + {(///directive.Bundle anchor expression directive) + host-directive-bundle} + {(generation.Operation anchor expression directive Any) + (generation.save-buffer! "")})) ///directive.lift-generation (///phase.run' (//init.state target expander diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/js.lux index 8e7988f37..e4c52af5a 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/js.lux @@ -1,7 +1,8 @@ (.module: [lux #* [control - [pipe (#+ case>)]] + [pipe (#+ case>)] + ["." function]] [data [binary (#+ Binary)] ["." product] @@ -18,21 +19,15 @@ [generation (#+ Output)]]]]]) (def: #export (package outputs) - (All [statements] - (-> (Output statements) Binary)) + (-> (Output _.Statement) Binary) (|> outputs row.to-list - (list@map (function (_ [module buffer]) - (|> buffer - row.to-list - (:coerce (List [Name _.Statement])) - (list@map product.right)))) + (list@map (|>> product.right + row.to-list + (list@map product.right))) list@join (case> (#.Cons head tail) - (|> (list@fold (function (_ post! pre!) - (_.then pre! post!)) - head - tail) + (|> (list@fold (function.flip _.then) head tail) (: _.Statement) _.code encoding.to-utf8) diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index cbd0bba9b..198ca4bb4 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -233,7 +233,7 @@ (case ?buffer (#.Some buffer) (if (row.any? (|>> product.left (name@= name)) buffer) - (//.throw cannot-overwrite-output name) + (//.throw ..cannot-overwrite-output name) (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) #.None diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 1725e80e5..b9b2995ad 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -11,6 +11,7 @@ [security ["!" capability]]] [data + [binary (#+ Binary)] ["." product] ["." text ["%" format (#+ format)]] @@ -21,7 +22,7 @@ [time ["." instant (#+ Instant)]] [world - ["." file (#+ File)] + ["." file (#+ File Path)] ["." console]] [tool [compiler @@ -34,9 +35,7 @@ ["." platform (#+ Platform)] ["." syntax]] [meta - ["." archive (#+ Archive)] - [packager - ["." script]]]] + ["." archive (#+ Archive)]]] ## ["." interpreter] ]] [/ @@ -57,10 +56,11 @@ (#try.Success output) (wrap output)))) -(def: (save-artifacts! system state) +(def: (save-artifacts! system state [packager package]) (All [anchor expression directive] (-> (file.System IO) (directive.State+ anchor expression directive) + [(-> (generation.Output directive) Binary) Path] (IO (Try Any)))) (let [?outcome (phase.run' state (:share [anchor expression directive] @@ -73,13 +73,14 @@ (#try.Success [state output]) (do (try.with io.monad) [file (: (IO (Try (File IO))) - (file.get-file io.monad system "program.js"))] - (!.use (:: file over-write) (script.package output))) + (file.get-file io.monad system package))] + (!.use (:: file over-write) (packager output))) (#try.Failure error) (:: io.monad wrap (#try.Failure error))))) -(def: #export (compiler target partial-host-extension expander host-analysis platform generation-bundle host-directive-bundle program service) +(def: #export (compiler target partial-host-extension expander host-analysis platform generation-bundle host-directive-bundle program service + packager,package) (All [anchor expression directive] (-> Text Text @@ -90,6 +91,7 @@ (directive.Bundle anchor expression directive) (-> expression directive) Service + [(-> (generation.Output directive) Binary) Path] (IO Any))) (do io.monad [platform platform @@ -108,7 +110,7 @@ platform} {(IO (Try [Archive (directive.State+ anchor expression directive)])) (platform.compile partial-host-extension expander platform configuration archive.empty state)}) - _ (save-artifacts! (get@ #platform.&file-system platform) state) + _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package) ## _ (cache/io.clean target ...) ] (wrap (log! "Compilation complete!")))) |