From 5d9fe393959c4c9c9bcbd04cef3115f7f834612f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 18 Sep 2019 19:20:50 -0400
Subject: Added packaging machinery for the JVM compiler.

---
 new-luxc/source/luxc/lang/packager.lux             | 112 +++++++++++++++++++++
 .../source/luxc/lang/translation/jvm/runtime.lux   |   8 +-
 2 files changed, 116 insertions(+), 4 deletions(-)
 create mode 100644 new-luxc/source/luxc/lang/packager.lux

(limited to 'new-luxc/source/luxc/lang')

diff --git a/new-luxc/source/luxc/lang/packager.lux b/new-luxc/source/luxc/lang/packager.lux
new file mode 100644
index 000000000..3f8cb36cb
--- /dev/null
+++ b/new-luxc/source/luxc/lang/packager.lux
@@ -0,0 +1,112 @@
+(.module:
+  [lux #*
+   ["." host (#+ import: do-to)]
+   [data
+    ["." binary (#+ Binary)]
+    ["." text]
+    [number
+     ["n" nat]]
+    [collection
+     ["." row]
+     ["." list ("#@." fold)]]]
+   [target
+    [jvm
+     [encoding
+      ["." name]]]]
+   [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
+  (-> Module Text)
+  (text.suffix ".class"))
+
+(def: main "_")
+
+(def: (manifest module)
+  (-> Module 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) ..main)
+            (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 module outputs)
+  (-> Module (Output Definition) Binary)
+  (let [buffer (java/io/ByteArrayOutputStream::new (.int mega-byte))
+        sink (java/util/jar/JarOutputStream::new buffer (manifest module))]
+    (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/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)
-- 
cgit v1.2.3