From 0f545b7e57d2564e351d907befd2ce26900c5521 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 24 Jul 2021 02:14:12 -0400 Subject: Now packaging JVM programs as "fat" jars in new JVM compiler. --- stdlib/source/library/lux/program.lux | 3 +- .../library/lux/tool/compiler/default/platform.lux | 2 +- .../library/lux/tool/compiler/meta/packager.lux | 13 +- .../lux/tool/compiler/meta/packager/jvm.lux | 180 +++++++++++++++++---- .../lux/tool/compiler/meta/packager/scheme.lux | 2 +- .../lux/tool/compiler/meta/packager/script.lux | 2 +- 6 files changed, 161 insertions(+), 41 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index bd486796b..51c22c701 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -73,7 +73,8 @@ [(~+ (|> args (list\map (function (_ [binding parser]) (list binding parser))) - list\join))] + list\join)) + (~ g!_) (~! .end)] ((~' wrap) (~ initialization+event_loop)))) (~ g!args)) (#.Right (~ g!output)) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index bc0e9b3cc..3d3f4cde0 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -520,7 +520,7 @@ (def: #export (compile import static expander platform compilation context) (All [] (-> Import Static Expander Compilation )) - (let [[compilation_sources compilation_libraries compilation_target compilation_module] compilation + (let [[compilation_sources compilation_host_dependencies compilation_libraries compilation_target compilation_module] compilation base_compiler (:share [] context diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 621045e33..6cb17c7b6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -1,20 +1,16 @@ (.module: [library [lux #* - [abstract - [monad (#+ Monad)]] [control [try (#+ Try)]] [data [binary (#+ Binary)] [collection + [dictionary (#+ Dictionary)] ["." row] ["." list ("#\." functor)]]] [world - ["." file (#+ Path)]]]] - [program - [compositor - [static (#+ Static)]]] + ["." file]]]] [// [cache ["." dependency]] @@ -27,7 +23,10 @@ [generation (#+ Context)]]]]]) (type: #export Packager - (-> Archive Context (Try Binary))) + (-> (Dictionary file.Path Binary) + Archive + Context + (Try Binary))) (type: #export Order (List [archive.ID (List artifact.ID)])) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux index 7e79903d5..7794d3f5e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -15,15 +15,20 @@ ["." text ["%" format (#+ format)]] [collection - ["." row (#+ Row) ("#\." fold)] - ["." list ("#\." functor fold)]]] + ["." row] + ["." list ("#\." functor)] + ["." dictionary] + ["." set (#+ Set)]]] [math [number - ["n" nat]]] + ["n" nat] + ["i" int]]] [target [jvm [encoding - ["." name]]]]]] + ["." name]]]] + [world + ["." file]]]] [program [compositor ["." static (#+ Static)]]] @@ -71,14 +76,20 @@ ["#::." (close [] void)]) -(import: java/io/OutputStream) +(import: java/io/OutputStream + ["#::." + (write [[byte] int int] void)]) (import: java/io/ByteArrayOutputStream ["#::." (new [int]) (toByteArray [] [byte])]) -(import: java/util/zip/ZipEntry) +(import: java/util/zip/ZipEntry + ["#::." + (getName [] java/lang/String) + (isDirectory [] boolean) + (getSize [] long)]) (import: java/util/zip/ZipOutputStream ["#::." @@ -92,15 +103,34 @@ (import: java/util/jar/JarOutputStream ["#::." (new [java/io/OutputStream java/util/jar/Manifest]) - (putNextEntry [java/util/zip/ZipEntry] void)]) + (putNextEntry [java/util/zip/ZipEntry] #try void)]) + +(import: java/io/ByteArrayInputStream + ["#::." + (new [[byte]])]) + +(import: java/io/InputStream + ["#::." + (read [[byte] int int] int)]) + +(import: java/util/jar/JarInputStream + ["#::." + (new [java/io/InputStream]) + (getNextJarEntry [] #try #? java/util/jar/JarEntry)]) + +(def: byte + 1) -(def: byte 1) ## https://en.wikipedia.org/wiki/Kibibyte -(def: kibi_byte (n.* 1,024 byte)) +(def: kibi_byte + (n.* 1,024 byte)) + ## https://en.wikipedia.org/wiki/Mebibyte -(def: mebi_byte (n.* 1,024 kibi_byte)) +(def: mebi_byte + (n.* 1,024 kibi_byte)) -(def: manifest_version "1.0") +(def: manifest_version + "1.0") (def: (manifest program) (-> Context java/util/jar/Manifest) @@ -112,37 +142,127 @@ (def: (write_class static module artifact custom content sink) (-> Static archive.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream - java/util/jar/JarOutputStream) + (Try java/util/jar/JarOutputStream)) (let [class_path (|> custom (maybe\map (|>> name.internal name.read)) (maybe.default (runtime.class_name [module artifact])) (text.suffix (get@ #static.artifact_extension static)))] - (do_to sink - (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path)) - (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) - (java/io/Flushable::flush) - (java/util/zip/ZipOutputStream::closeEntry)))) + (do try.monad + [_ (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path) sink)] + (wrap (do_to sink + (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry)))))) (def: (write_module static [module output] sink) (-> Static [archive.ID Output] java/util/jar/JarOutputStream - java/util/jar/JarOutputStream) - (row\fold (function (_ [artifact custom content] sink) - (..write_class static module artifact custom content sink)) - sink - output)) + (Try java/util/jar/JarOutputStream)) + (monad.fold try.monad + (function (_ [artifact custom content] sink) + (..write_class static module artifact custom content sink)) + sink + (row.to_list output))) + +(def: (read_jar_entry_with_unknown_size input) + (-> java/util/jar/JarInputStream [Nat Binary]) + (let [chunk (binary.create ..mebi_byte) + chunk_size (.int ..mebi_byte) + buffer (java/io/ByteArrayOutputStream::new chunk_size)] + (loop [so_far 0] + (case (java/io/InputStream::read chunk 0 chunk_size input) + -1 + [so_far + (java/io/ByteArrayOutputStream::toByteArray buffer)] + + bytes_read + (exec + (java/io/OutputStream::write chunk +0 bytes_read buffer) + (recur (|> bytes_read .nat (n.+ so_far)))))))) + +(def: (read_jar_entry_with_known_size expected_size input) + (-> Nat java/util/jar/JarInputStream [Nat Binary]) + (let [buffer (binary.create expected_size)] + (loop [so_far 0] + (let [so_far' (|> input + (java/io/InputStream::read buffer (.int so_far) (.int (n.- so_far expected_size))) + .nat + (n.+ so_far))] + (if (n.= expected_size so_far') + [expected_size buffer] + (recur so_far')))))) + +(def: (read_jar_entry entry input) + (-> java/util/jar/JarEntry java/util/jar/JarInputStream [Nat Binary]) + (case (java/util/zip/ZipEntry::getSize entry) + -1 + (..read_jar_entry_with_unknown_size input) + + entry_size + (..read_jar_entry_with_known_size (.nat entry_size) input))) + +(def: (write_host_dependency jar [entries duplicates sink]) + (-> Binary + [(Set file.Path) (Set file.Path) java/util/jar/JarOutputStream] + (Try [(Set file.Path) (Set file.Path) java/util/jar/JarOutputStream])) + (let [input (|> jar + java/io/ByteArrayInputStream::new + java/util/jar/JarInputStream::new)] + (loop [entries entries + duplicates duplicates + sink sink] + (case (java/util/jar/JarInputStream::getNextJarEntry input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success ?entry) + (case ?entry + #.None + (exec + (java/io/Closeable::close input) + (#try.Success [entries duplicates sink])) + + (#.Some entry) + (let [entry_path (java/util/zip/ZipEntry::getName entry) + entry_size (java/util/zip/ZipEntry::getSize entry)] + (if (not (or (java/util/zip/ZipEntry::isDirectory entry) + (text.starts_with? "META-INF/maven/" entry_path) + (text.starts_with? "META-INF/leiningen/" entry_path))) + (case (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new entry_path) sink) + (#try.Failure error) + (recur entries + (set.add entry_path duplicates) + sink) + + (#try.Success _) + (let [[entry_size entry_data] (read_jar_entry entry input)] + (recur (set.add entry_path entries) + duplicates + (do_to sink + (java/util/zip/ZipOutputStream::write entry_data +0 (.int entry_size)) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry))))) + (recur entries + duplicates + sink)))))))) (def: #export (package static) (-> Static Packager) - (function (_ archive program) + (function (_ host_dependencies archive program) (do {! try.monad} [order (dependency.load_order $.key archive) - #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte)) - sink (|> order - (list\map (function (_ [module [module_id [descriptor document output]]]) - [module_id output])) - (list\fold (..write_module static) - (java/util/jar/JarOutputStream::new buffer (..manifest program)))) - _ (do_to sink + #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))] + sink (|> order + (list\map (function (_ [module [module_id [descriptor document output]]]) + [module_id output])) + (monad.fold ! (..write_module static) + (java/util/jar/JarOutputStream::new buffer (..manifest program)))) + [entries duplicates sink] (|> host_dependencies + dictionary.values + (monad.fold ! ..write_host_dependency + [(set.new text.hash) + (set.new text.hash) + sink])) + #let [_ (do_to sink (java/io/Flushable::flush) (java/io/Closeable::close))]] (wrap (java/io/ByteArrayOutputStream::toByteArray buffer))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux index bcd06b6fd..514de6852 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux @@ -118,7 +118,7 @@ (def: #export (package now) (-> Instant Packager) - (function (package archive program) + (function (package host_dependencies archive program) (do {! try.monad} [order (dependency.load_order $.key archive) #let [mapping (|> order diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux index 36b1db690..404b3d800 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -61,7 +61,7 @@ (-> directive directive directive) (-> directive directive) Packager)) - (function (package archive program) + (function (package host_dependencies archive program) (do {! try.monad} [order (dependency.load_order $.key archive)] (|> order -- cgit v1.2.3