- WIP: Wiring everything to get the compiler to work fully.

- Fixed a bug when combining field/method/class modifiers.

7 files changed, 150 insertions, 44 deletions

diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux
index 150e68e4f..4439ae51d 100644
--- a/new-luxc/source/luxc/generator/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/common.jvm.lux
@@ -4,8 +4,11 @@
        [io]
        (concurrency ["A" atom])
        (data ["e" error]
-             (coll ["d" dict]))
-       [host])
+             [text]
+             text/format
+             (coll [dict #+ Dict]))
+       [host]
+       (world [blob #+ Blob]))
   (luxc (generator (host ["$" jvm]
                          (jvm ["$t" type]
                               ["$d" def]
@@ -23,16 +26,52 @@
 
 (type: #export Bytecode (host;type (Array byte)))
 
-(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))
+(type: #export Class-Store (A;Atom (Dict Text Bytecode)))
+
+(type: #export Artifacts (Dict Text Blob))
 
 (type: #export Host
   {#loader ClassLoader
    #store Class-Store
-   #function-class (Maybe Text)})
+   #function-class (Maybe Text)
+   #artifacts Artifacts})
 
 (exception: Unknown-Class)
 (exception: Class-Already-Stored)
 (exception: No-Function-Being-Compiled)
+(exception: Cannot-Overwrite-Artifact)
+
+(def: #export (with-artifacts action)
+  (All [a] (-> (Meta a) (Meta [Artifacts a])))
+  (;function [compiler]
+    (case (action (update@ #;host
+                           (|>. (:! Host)
+                                (set@ #artifacts (dict;new text;Hash<Text>))
+                                (:! Void))
+                           compiler))
+      (#e;Success [compiler' output])
+      (#e;Success [(update@ #;host
+                            (|>. (:! Host)
+                                 (set@ #artifacts (|> (get@ #;host compiler) (:! Host) (get@ #artifacts)))
+                                 (:! Void))
+                            compiler')
+                   [(|> compiler' (get@ #;host) (:! Host) (get@ #artifacts))
+                    output]])
+      
+      (#e;Error error)
+      (#e;Error error))))
+
+(def: #export (record-artifact name content)
+  (-> Text Blob (Meta Unit))
+  (;function [compiler]
+    (if (|> compiler (get@ #;host) (:! Host) (get@ #artifacts) (dict;contains? name))
+      (ex;throw Cannot-Overwrite-Artifact name)
+      (#e;Success [(update@ #;host
+                            (|>. (:! Host)
+                                 (update@ #artifacts (dict;put name content))
+                                 (:! Void))
+                            compiler)
+                   []]))))
 
 (def: #export (store-class name byte-code)
   (-> Text Bytecode (Meta Unit))
@@ -40,9 +79,9 @@
     (let [store (|> (get@ #;host compiler)
                     (:! Host)
                     (get@ #store))]
-      (if (d;contains? name (|> store A;get io;run))
+      (if (dict;contains? name (|> store A;get io;run))
         (ex;throw Class-Already-Stored name)
-        (#e;Success [compiler (io;run (A;update (d;put name byte-code) store))])
+        (#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))])
         ))))
 
 (def: #export (load-class name)
@@ -50,7 +89,7 @@
   (;function [compiler]
     (let [host (:! Host (get@ #;host compiler))
           store (|> host (get@ #store) A;get io;run)]
-      (if (d;contains? name store)
+      (if (dict;contains? name store)
         (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
         (ex;throw Unknown-Class name)))))
 
@@ -87,3 +126,6 @@
         (#e;Success [compiler function-class])))))
 
 (def: #export bytecode-version Int Opcodes.V1_6)
+
+(def: #export value-field Text "_value")
+(def: #export $Object $;Type ($t;class "java.lang.Object" (list)))
diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux
index 20c02af4c..842199a47 100644
--- a/new-luxc/source/luxc/generator/eval.jvm.lux
+++ b/new-luxc/source/luxc/generator/eval.jvm.lux
@@ -56,9 +56,6 @@
   (visitMethod [int String String String (Array String)] MethodVisitor)
   (toByteArray [] (Array byte)))
 
-(def: eval-field Text "_value")
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
-
 (def: #export (eval valueI)
   (-> $;Inst (Meta Top))
   (do Monad<Meta>
@@ -70,17 +67,17 @@
                                             (host;null)
                                             "java/lang/Object"
                                             (host;null)]))
-                      ($d;field #$;Public $;staticF
-                                eval-field $Object)
+                      ($d;field #$;Public ($_ $;++F $;finalF $;staticF)
+                                &common;value-field &common;$Object)
                       ($d;method #$;Public ($_ $;++M $;staticM $;strictM)
                                  "<clinit>"
                                  ($t;method (list) #;None (list))
                                  (|>. valueI
-                                      ($i;PUTSTATIC class-name eval-field $Object)
+                                      ($i;PUTSTATIC class-name &common;value-field &common;$Object)
                                       $i;RETURN)))
            bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
      _ (&common;store-class class-name bytecode)
      class (&common;load-class class-name)]
     (wrap (|> class
-              (Class.getField [eval-field])
+              (Class.getField [&common;value-field])
               (Field.get (host;null))))))
diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux
index c7fdcf2af..116c29fb5 100644
--- a/new-luxc/source/luxc/generator/expr.jvm.lux
+++ b/new-luxc/source/luxc/generator/expr.jvm.lux
@@ -44,6 +44,9 @@
       (&reference;generate-captured var)
       (&reference;generate-variable var))
 
+    (#ls;Definition definition)
+    (&reference;generate-definition definition)
+
     (#ls;Function arity env body)
     (&function;generate-function generate env arity body)
 
@@ -54,7 +57,8 @@
     (&procedure;generate-procedure generate name args)
 
     _
-    (meta;fail "Unrecognized synthesis.")))
+    (meta;fail "Unrecognized synthesis.")
+    ))
 
 ## (def: #export (eval type code)
 ##   (-> Type Code (Meta Top))
diff --git a/new-luxc/source/luxc/generator/host/jvm.lux b/new-luxc/source/luxc/generator/host/jvm.lux
index c985efc9a..24d4a9ea9 100644
--- a/new-luxc/source/luxc/generator/host/jvm.lux
+++ b/new-luxc/source/luxc/generator/host/jvm.lux
@@ -109,8 +109,8 @@
                  (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right))
                       (-> (~ g!type) (~ g!type) (~ g!type))
                       (~ (code;record (list/map (function [tag]
-                                                  [tag (` (and (get@ (~ tag) (~ g!_left))
-                                                               (get@ (~ tag) (~ g!_right))))])
+                                                  [tag (` (or (get@ (~ tag) (~ g!_left))
+                                                              (get@ (~ tag) (~ g!_right))))])
                                                 g!tags+)))))
 
                  g!options+))))
diff --git a/new-luxc/source/luxc/generator/reference.jvm.lux b/new-luxc/source/luxc/generator/reference.jvm.lux
index 063994bac..0e77b1819 100644
--- a/new-luxc/source/luxc/generator/reference.jvm.lux
+++ b/new-luxc/source/luxc/generator/reference.jvm.lux
@@ -3,15 +3,14 @@
   (lux (control [monad #+ do])
        (data text/format)
        [meta "meta/" Monad<Meta>])
-  (luxc (lang ["ls" synthesis])
+  (luxc ["&" base]
+        (lang ["ls" synthesis])
         (generator [";G" common]
                    [";G" function]
                    (host ["$" jvm]
                          (jvm ["$t" type]
                               ["$i" inst])))))
 
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
-
 (def: #export (generate-captured variable)
   (-> ls;Variable (Meta $;Inst))
   (do meta;Monad<Meta>
@@ -19,8 +18,13 @@
     (wrap (|>. ($i;ALOAD +0)
                ($i;GETFIELD function-class
                             (|> variable i.inc (i.* -1) int-to-nat functionG;captured)
-                            $Object)))))
+                            commonG;$Object)))))
 
 (def: #export (generate-variable variable)
   (-> ls;Variable (Meta $;Inst))
   (meta/wrap ($i;ALOAD (int-to-nat variable))))
+
+(def: #export (generate-definition [def-module def-name])
+  (-> Ident (Meta $;Inst))
+  (let [bytecode-name (format def-module "/" (&;normalize-name def-name))]
+    (meta/wrap ($i;GETSTATIC bytecode-name commonG;value-field commonG;$Object))))
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index 32e792638..66dd43019 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -504,8 +504,8 @@
     (wrap bytecode)))
 
 (def: #export generate
-  (Meta Unit)
+  (Meta [&common;Bytecode &common;Bytecode])
   (do Monad<Meta>
-    [_ generate-runtime
-     _ generate-function]
-    (wrap [])))
+    [runtime-bc generate-runtime
+     function-bc generate-function]
+    (wrap [runtime-bc function-bc])))
diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux
index ed66f3ecb..830935dda 100644
--- a/new-luxc/source/luxc/generator/statement.jvm.lux
+++ b/new-luxc/source/luxc/generator/statement.jvm.lux
@@ -1,25 +1,84 @@
 (;module:
   lux
-  (lux (control monad)
-       [io #- run]
-       (data [text "T/" Eq<Text>]
-             text/format)
-       [meta #+ Monad<Meta>])
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (concurrency ["T" task])
+       (data ["e" error]
+             [maybe]
+             [text "text/" Monoid<Text>]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [meta]
+       [host])
   (luxc ["&" base]
-        ["&;" module]
         ["&;" scope]
-        (compiler ["&;" expr])))
+        ["&;" module]
+        ["&;" io]
+        (generator ["&;" expr]
+                   ["&;" eval]
+                   ["&;" common]
+                   (host ["$" jvm]
+                         (jvm ["$t" type]
+                              ["$d" def]
+                              ["$i" inst])))))
+
+(exception: #export Invalid-Definition-Value)
+
+(host;import java.lang.Object
+  (toString [] String))
+
+(host;import java.lang.reflect.Field
+  (get [#? Object] #try #? Object))
+
+(host;import (java.lang.Class c)
+  (getField [String] #try Field))
+
+(def: #export (generate-def def-name valueT valueI metaI metaV)
+  (-> Text Type $;Inst $;Inst Code (Meta Unit))
+  (do meta;Monad<Meta>
+    [current-module meta;current-module-name
+     #let [def-ident [current-module def-name]
+           normal-name (&;normalize-name def-name)
+           bytecode-name (format current-module "/" normal-name)
+           class-name (format current-module "." normal-name)
+           bytecode ($d;class #$;V1.6
+                              #$;Public $;finalC
+                              bytecode-name
+                              (list) ["java.lang.Object" (list)]
+                              (list)
+                              (|>. ($d;field #$;Public ($;++F $;finalF $;staticF) &common;value-field &common;$Object)
+                                   ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
+                                              (|>. valueI
+                                                   ($i;PUTSTATIC bytecode-name &common;value-field &common;$Object)
+                                                   $i;RETURN))))]
+     _ (&common;store-class class-name bytecode)
+     class (&common;load-class class-name)
+     valueV (: (Meta Top)
+               (case (do e;Monad<Error>
+                       [field (Class.getField [&common;value-field] class)]
+                       (Field.get [#;None] field))
+                 (#e;Success #;None)
+                 (&;throw Invalid-Definition-Value (format current-module ";" def-name))
+                 
+                 (#e;Success (#;Some valueV))
+                 (wrap valueV)
+                 
+                 (#e;Error error)
+                 (&;fail error)))
+     _ (&module;define [current-module def-name] [valueT metaV valueV])
+     _ (if (meta;type? metaV)
+         (case (meta;declared-tags metaV)
+           #;Nil
+           (wrap [])
 
-(def: #export (compile-def def-name def-value def-meta)
-  (-> Text Code Code (Meta Unit))
-  (do Monad<Meta>
-    [=def-value (&expr;compile def-value)
-     =def-meta (&expr;compile def-meta)]
-    (undefined)))
+           tags
+           (&module;declare-tags tags (meta;export? metaV) (:! Type valueV)))
+         (wrap []))
+     #let [_ (log! (format "DEF " current-module ";" def-name))]]
+    (&common;record-artifact bytecode-name bytecode)))
 
-(def: #export (compile-program prog-args prog-body)
-  (-> Text Code (Meta Unit))
-  (do Monad<Meta>
-    [=prog-body (&scope;with-local [prog-args (type (List Text))]
-                  (&expr;compile prog-body))]
-    (undefined)))
+(def: #export (generate-program program-args programI)
+  (-> Text $;Inst (Meta Unit))
+  (do meta;Monad<Meta>
+    []
+    (&;fail "'lux program' is unimplemented.")))