aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/packager.lux110
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension.lux16
-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.lux8
-rw-r--r--new-luxc/source/program.lux64
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux24
-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.lux2
-rw-r--r--stdlib/source/program/compositor.lux20
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!"))))