Ported program generation, host environment and packaging machinery to stdlib.

4 files changed, 20 insertions, 621 deletions

diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux
deleted file mode 100644
index 5c1ddee0d..000000000
--- a/new-luxc/source/luxc/lang/directive/jvm.lux
+++ /dev/null
@@ -1,263 +0,0 @@
-(.module:
-  [lux (#- Type Definition)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["<>" parser
-     ["<c>" code (#+ Parser)]
-     ["<t>" text]]]
-   [data
-    ["." product]
-    [text
-     ["%" format (#+ format)]]
-    [collection
-     ["." list ("#@." functor fold)]
-     ["." dictionary]]]
-   [type
-    ["." check (#+ Check)]]
-   [target
-    [jvm
-     ["." type (#+ Type Constraint Argument Typed)
-      [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
-      [".T" lux]
-      ["." signature]
-      ["." descriptor (#+ Descriptor)]
-      ["." parser]]]]
-   [tool
-    [compiler
-     ["." directive (#+ Handler Bundle)]
-     ["." phase
-      ["." generation]
-      [analysis
-       [".A" type]]
-      ["." extension
-       ["." bundle]
-       [analysis
-        ["." jvm]]
-       [directive
-        ["/" lux]]]]]]]
-  [luxc
-   [lang
-    [host
-     ["$" jvm (#+ Anchor Inst Definition Operation Phase)
-      ["_." def]]]]])
-
-(def: signature (|>> type.signature signature.signature))
-
-(type: Declaration
-  [Text (List (Type Var))])
-
-(def: declaration
-  (Parser Declaration)
-  (<c>.form (<>.and <c>.text (<>.some jvm.var))))
-
-(type: Inheritance
-  #FinalI
-  #AbstractI
-  #DefaultI)
-
-(def: inheritance
-  (Parser Inheritance)
-  ($_ <>.or
-      (<c>.text! "final")
-      (<c>.text! "abstract")
-      (<c>.text! "default")))
-
-(type: State
-  #VolatileS
-  #FinalS
-  #DefaultS)
-
-(def: state
-  (Parser State)
-  ($_ <>.or
-      (<c>.text! "volatile")
-      (<c>.text! "final")
-      (<c>.text! "default")))
-
-(type: Annotation Any)
-
-(def: annotation
-  (Parser Annotation)
-  <c>.any)
-
-(def: field-type
-  (Parser (Type Value))
-  (<t>.embed parser.value <c>.text))
-
-(type: Constant
-  [Text (List Annotation) (Type Value) Code])
-
-(def: constant
-  (Parser Constant)
-  (<| <c>.form
-      (<>.after (<c>.text! "constant"))
-      ($_ <>.and
-          <c>.text
-          (<c>.tuple (<>.some ..annotation))
-          ..field-type
-          <c>.any
-          )))
-
-(type: Variable
-  [Text jvm.Visibility State (List Annotation) (Type Value)])
-
-(def: variable
-  (Parser Variable)
-  (<| <c>.form
-      (<>.after (<c>.text! "variable"))
-      ($_ <>.and
-          <c>.text
-          jvm.visibility
-          ..state
-          (<c>.tuple (<>.some ..annotation))
-          ..field-type
-          )))
-
-(type: Field
-  (#Constant Constant)
-  (#Variable Variable))
-
-(def: field
-  (Parser Field)
-  ($_ <>.or
-      ..constant
-      ..variable
-      ))
-
-(type: Method-Definition
-  (#Constructor (jvm.Constructor Code))
-  (#Virtual-Method (jvm.Virtual-Method Code))
-  (#Static-Method (jvm.Static-Method Code))
-  (#Overriden-Method (jvm.Overriden-Method Code)))
-
-(def: method
-  (Parser Method-Definition)
-  ($_ <>.or
-      jvm.constructor-definition
-      jvm.virtual-method-definition
-      jvm.static-method-definition
-      jvm.overriden-method-definition
-      ))
-
-(def: (constraint name)
-  (-> Text Constraint)
-  {#type.name name
-   #type.super-class (type.class "java.lang.Object" (list))
-   #type.super-interfaces (list)})
-
-(def: jvm::class
-  (Handler Anchor Inst Definition)
-  (/.custom
-   [($_ <>.and
-        ..declaration
-        jvm.class
-        (<c>.tuple (<>.some jvm.class))
-        ..inheritance
-        (<c>.tuple (<>.some ..annotation))
-        (<c>.tuple (<>.some ..field))
-        (<c>.tuple (<>.some ..method)))
-    (function (_ extension phase
-                 [[name parameters]
-                  super-class
-                  super-interfaces
-                  inheritance
-                  ## TODO: Handle annotations.
-                  annotations
-                  fields
-                  methods])
-      (do phase.monad
-        [parameters (directive.lift-analysis
-                     (typeA.with-env
-                       (jvm.parameter-types parameters)))
-         #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping)
-                                    (dictionary.put (parser.name parameterJ) parameterT mapping))
-                                  luxT.fresh
-                                  parameters)
-               field-definitions (|> fields
-                                     (list@map (function (_ field)
-                                                 (case field
-                                                   ## TODO: Handle annotations.
-                                                   (#Constant [name annotations type value])
-                                                   (case value
-                                                     (^template [<tag> <field>]
-                                                       [_ (<tag> value)]
-                                                       (<field> #$.Public ($.++F $.staticF $.finalF) name value))
-                                                     ([#.Bit _def.boolean-field]
-                                                      [#.Int _def.byte-field]
-                                                      [#.Int _def.short-field]
-                                                      [#.Int _def.int-field]
-                                                      [#.Int _def.long-field]
-                                                      [#.Frac _def.float-field]
-                                                      [#.Frac _def.double-field]
-                                                      [#.Nat _def.char-field]
-                                                      [#.Text _def.string-field])
-
-                                                     _
-                                                     (undefined))
-
-                                                   ## TODO: Handle annotations.
-                                                   (#Variable [name visibility state annotations type])
-                                                   (_def.field visibility
-                                                               (case state
-                                                                 ## TODO: Handle transient & static.
-                                                                 #VolatileS $.volatileF
-                                                                 #FinalS $.finalF
-                                                                 #DefaultS $.noneF)
-                                                               name
-                                                               type))))
-                                     _def.fuse)]
-         super-classT (directive.lift-analysis
-                       (typeA.with-env
-                         (luxT.check (luxT.class mapping) (..signature super-class))))
-         super-interfaceT+ (directive.lift-analysis
-                            (typeA.with-env
-                              (monad.map check.monad
-                                         (|>> ..signature (luxT.check (luxT.class mapping)))
-                                         super-interfaces)))
-         #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list@map product.right parameters))
-                                                        super-classT
-                                                        super-interfaceT+)]
-         state (extension.lift phase.get-state)
-         #let [analyse (get@ [#directive.analysis #directive.phase] state)
-               synthesize (get@ [#directive.synthesis #directive.phase] state)
-               generate (get@ [#directive.generation #directive.phase] state)]
-         methods (monad.map @ (function (_ methodC)
-                                (do @
-                                  [methodA (directive.lift-analysis
-                                            (case methodC
-                                              (#Constructor method)
-                                              (jvm.analyse-constructor-method analyse selfT mapping method)
-                                              
-                                              (#Virtual-Method method)
-                                              (jvm.analyse-virtual-method analyse selfT mapping method)
-                                              
-                                              (#Static-Method method)
-                                              (jvm.analyse-static-method analyse mapping method)
-                                              
-                                              (#Overriden-Method method)
-                                              (jvm.analyse-overriden-method analyse selfT mapping method)))]
-                                  (directive.lift-synthesis
-                                   (synthesize methodA))))
-                            methods)
-         _ (directive.lift-generation
-            (generation.save! true ["" name]
-                              [name
-                               (_def.class #$.V1_6 #$.Public
-                                           (case inheritance
-                                             #FinalI $.finalC
-                                             ## TODO: Handle abstract classes.
-                                             #AbstractI (undefined)
-                                             #DefaultI $.noneC)
-                                           name (list@map (|>> product.left parser.name ..constraint) parameters)
-                                           super-class super-interfaces
-                                           field-definitions)]))
-         #let [_ (log! (format "Class " name))]]
-        (wrap directive.no-requirements)))]))
-
-(def: #export bundle
-  (Bundle Anchor Inst Definition)
-  (<| (bundle.prefix "jvm")
-      (|> bundle.empty
-          (dictionary.put "class" jvm::class)
-          )))
diff --git a/new-luxc/source/luxc/lang/packager.lux b/new-luxc/source/luxc/lang/packager.lux
deleted file mode 100644
index d72506da2..000000000
--- a/new-luxc/source/luxc/lang/packager.lux
+++ /dev/null
@@ -1,112 +0,0 @@
-(.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)
-## https://en.wikipedia.org/wiki/Kibibyte
-(def: kibi-byte (n.* 1,024 byte))
-## https://en.wikipedia.org/wiki/Mebibyte
-(def: mebi-byte (n.* 1,024 kibi-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 ..mebi-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.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
deleted file mode 100644
index fccbd14bf..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ /dev/null
@@ -1,154 +0,0 @@
-(.module:
-  [lux (#- Definition)
-   ["." host (#+ import: do-to object)]
-   [abstract
-    [monad (#+ do)]]
-   [control
-    pipe
-    ["." try (#+ Try)]
-    ["." exception (#+ exception:)]
-    ["." io (#+ IO io)]
-    [concurrency
-     ["." atom (#+ Atom atom)]]]
-   [data
-    [binary (#+ Binary)]
-    ["." product]
-    ["." text ("#@." hash)
-     ["%" format (#+ format)]]
-    [collection
-     ["." array]
-     ["." dictionary (#+ Dictionary)]]]
-   [target
-    [jvm
-     ["." loader (#+ Library)]
-     ["." type
-      ["." descriptor]]]]
-   [tool
-    [compiler
-     ["." name]]]]
-  [///
-   [host
-    ["." jvm (#+ Inst Definition Host State)
-     ["." def]
-     ["." inst]]]]
-  )
-
-(import: org/objectweb/asm/Label)
-
-(import: java/lang/reflect/Field
-  (get [#? Object] #try #? Object))
-
-(import: (java/lang/Class a)
-  (getField [String] #try Field))
-
-(import: java/lang/Object
-  (getClass [] (Class Object)))
-
-(import: java/lang/ClassLoader)
-
-(type: #export ByteCode Binary)
-
-(def: #export value-field Text "_value")
-(def: #export $Value (type.class "java.lang.Object" (list)))
-
-(exception: #export (cannot-load {class Text} {error Text})
-  (exception.report
-   ["Class" class]
-   ["Error" error]))
-
-(exception: #export (invalid-field {class Text} {field Text} {error Text})
-  (exception.report
-   ["Class" class]
-   ["Field" field]
-   ["Error" error]))
-
-(exception: #export (invalid-value {class Text})
-  (exception.report
-   ["Class" class]))
-
-(def: (class-value class-name class)
-  (-> Text (Class Object) (Try Any))
-  (case (Class::getField ..value-field class)
-    (#try.Success field)
-    (case (Field::get #.None field)
-      (#try.Success ?value)
-      (case ?value
-        (#.Some value)
-        (#try.Success value)
-        
-        #.None
-        (exception.throw invalid-value class-name))
-      
-      (#try.Failure error)
-      (exception.throw cannot-load [class-name error]))
-    
-    (#try.Failure error)
-    (exception.throw invalid-field [class-name ..value-field error])))
-
-(def: class-path-separator ".")
-
-(def: (evaluate! library loader eval-class valueI)
-  (-> Library ClassLoader Text Inst (Try [Any Definition]))
-  (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class)
-        bytecode (def.class #jvm.V1_6
-                            #jvm.Public jvm.noneC
-                            bytecode-name
-                            (list) $Value
-                            (list)
-                            (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
-                                            ..value-field ..$Value)
-                                 (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
-                                             "<clinit>"
-                                             (type.method [(list) type.void (list)])
-                                             (|>> valueI
-                                                  (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value)
-                                                  inst.RETURN))))]
-    (io.run (do (try.with io.monad)
-              [_ (loader.store eval-class bytecode library)
-               class (loader.load eval-class loader)
-               value (:: io.monad wrap (class-value eval-class class))]
-              (wrap [value
-                     [eval-class bytecode]])))))
-
-(def: (execute! library loader temp-label [class-name class-bytecode])
-  (-> Library ClassLoader Text Definition (Try Any))
-  (io.run (do (try.with io.monad)
-            [existing-class? (|> (atom.read library)
-                                 (:: io.monad map (dictionary.contains? class-name))
-                                 (try.lift io.monad)
-                                 (: (IO (Try Bit))))
-             _ (if existing-class?
-                 (wrap [])
-                 (loader.store class-name class-bytecode library))]
-            (loader.load class-name loader))))
-
-(def: (define! library loader [module name] valueI)
-  (-> Library ClassLoader Name Inst (Try [Text Any Definition]))
-  (let [class-name (format (text.replace-all .module-separator class-path-separator module)
-                           class-path-separator (name.normalize name)
-                           "___" (%.nat (text@hash name)))]
-    (do try.monad
-      [[value definition] (evaluate! library loader class-name valueI)]
-      (wrap [class-name value definition]))))
-
-(def: #export host
-  (IO Host)
-  (io (let [library (loader.new-library [])
-            loader (loader.memory library)]
-        (: Host
-           (structure
-            (def: (evaluate! temp-label valueI)
-              (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
-                (:: try.monad map product.left
-                    (..evaluate! library loader eval-class valueI))))
-            
-            (def: execute!
-              (..execute! library loader))
-            
-            (def: define!
-              (..define! library loader)))))))
-
-(def: #export $Variant (type.array ..$Value))
-(def: #export $Tuple (type.array ..$Value))
-(def: #export $Function (type.class "LuxFunction" (list)))
-(def: #export $Runtime (type.class "LuxRuntime" (list)))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index f975d2a87..2b2278cec 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Definition)
    ["@" target]
    ["." host (#+ import:)]
    [abstract
@@ -19,33 +19,28 @@
     ["." file]]
    [target
     [jvm
-     ["$t" type]]]
+     [bytecode (#+ Bytecode)]]]
    [tool
     [compiler
      [phase
       ["." macro (#+ Expander)]
       [extension (#+ Phase Bundle Operation Handler Extender)
        ["." analysis #_
-        ["#" jvm]]]]
+        ["#" jvm]]
+       ["." directive #_
+        ["#" jvm]]]
+      ["." generation #_
+       ["#" jvm/extension]
+       ["." jvm
+        ["." runtime (#+ Anchor Definition)]
+        ["#/." program]
+        ["." packager]
+        ["#/." host]]]]
      [default
       ["." platform (#+ Platform)]]]]]
   [program
    ["/" compositor
-    ["/." cli]]]
-  [luxc
-   [lang
-    ["." packager]
-    [host
-     ["_" jvm
-      ["$d" def]
-      ["$i" inst]]]
-    ["." directive #_
-     ["#" jvm]]
-    [translation
-     ["." jvm
-      ["." runtime]
-      ["." expression]
-      ["translation" extension]]]]])
+    ["/." cli]]])
 
 (import: #long java/lang/reflect/Method
   (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
@@ -90,81 +85,14 @@
               apply-method))))
 
 (def: #export platform
-  (IO (Platform IO _.Anchor _.Inst _.Definition))
+  (IO (Platform IO Anchor (Bytecode Any) Definition))
   (do io.monad
-    [host jvm.host]
+    [host jvm/host.host]
     (wrap {#platform.&monad io.monad
            #platform.&file-system file.system
            #platform.host host
-           #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))
-        nilI runtime.noneI
-        num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
-        decI (|>> ($i.int +1) $i.ISUB)
-        headI (|>> $i.DUP
-                   ($i.ALOAD 0)
-                   $i.SWAP
-                   $i.AALOAD
-                   $i.SWAP
-                   $i.DUP_X2
-                   $i.POP)
-        pairI (|>> ($i.int +2)
-                   ($i.ANEWARRAY $Object)
-                   $i.DUP_X1
-                   $i.SWAP
-                   ($i.int +0)
-                   $i.SWAP
-                   $i.AASTORE
-                   $i.DUP_X1
-                   $i.SWAP
-                   ($i.int +1)
-                   $i.SWAP
-                   $i.AASTORE)
-        consI (|>> ($i.int +1)
-                   ($i.string "")
-                   $i.DUP2_X1
-                   $i.POP2
-                   runtime.variantI)
-        prepare-input-listI (<| $i.with-label (function (_ @loop))
-                                $i.with-label (function (_ @end))
-                                (|>> nilI
-                                     num-inputsI
-                                     ($i.label @loop)
-                                     decI
-                                     $i.DUP
-                                     ($i.IFLT @end)
-                                     headI
-                                     pairI
-                                     consI
-                                     $i.SWAP
-                                     ($i.GOTO @loop)
-                                     ($i.label @end)
-                                     $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)])]
-    [..program-class
-     ($d.class #_.V1_6
-               #_.Public _.finalC
-               ..program-class
-               (list) $Object
-               (list)
-               (|>> ($d.method #_.Public _.staticM "main" main-type
-                               (|>> programI
-                                    prepare-input-listI
-                                    feed-inputsI
-                                    run-ioI
-                                    $i.RETURN))))]))
+           #platform.phase jvm.generate
+           #platform.runtime runtime.generate})))
 
 (def: extender
   Extender
@@ -204,9 +132,9 @@
                 ..expander
                 analysis.bundle
                 ..platform
-                translation.bundle
+                generation.bundle
                 directive.bundle
-                ..program
+                jvm/program.program
                 ..extender
                 service
-                [(packager.package ..program-class) jar-path])))
+                [(packager.package jvm/program.class) jar-path])))