- Added parallel compilation.

- Added aliasing.
- Several bug fixes.
- Some minor refactoring.

6 files changed, 219 insertions, 53 deletions

diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index 49e135709..7a16a749a 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -2,7 +2,7 @@
   [lux #- function]
   (lux (control ["ex" exception #+ exception:])
        [io]
-       (concurrency ["A" atom])
+       (concurrency [atom #+ Atom atom])
        (data ["e" error]
              [text]
              text/format
@@ -30,7 +30,7 @@
 
 (type: #export Bytecode Blob)
 
-(type: #export Class-Store (A;Atom (Dict Text Bytecode)))
+(type: #export Class-Store (Atom (Dict Text Bytecode)))
 
 (type: #export Artifacts (Dict File Blob))
 
@@ -84,16 +84,16 @@
     (let [store (|> (get@ #;host compiler)
                     (:! Host)
                     (get@ #store))]
-      (if (dict;contains? name (|> store A;get io;run))
+      (if (dict;contains? name (|> store atom;read io;run))
         (ex;throw Class-Already-Stored name)
-        (#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))])
+        (#e;Success [compiler (io;run (atom;update (dict;put name byte-code) store))])
         ))))
 
 (def: #export (load-class name)
   (-> Text (Meta (Class Object)))
   (;function [compiler]
     (let [host (:! Host (get@ #;host compiler))
-          store (|> host (get@ #store) A;get io;run)]
+          store (|> host (get@ #store) atom;read io;run)]
       (if (dict;contains? name store)
         (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
         (ex;throw Unknown-Class name)))))
diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
index 11baa3856..6b9ee9743 100644
--- a/new-luxc/source/luxc/lang/translation/eval.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
@@ -1,7 +1,8 @@
 (;module:
   lux
   (lux (control monad)
-       (data text/format)
+       (data [text]
+             text/format)
        [macro]
        [host #+ do-to])
   (luxc ["&" lang]
@@ -56,8 +57,10 @@
 (def: #export (eval valueI)
   (-> $;Inst (Meta Top))
   (do macro;Monad<Meta>
-    [class-name (:: @ map %code (macro;gensym "eval"))
-     #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+    [current-module macro;current-module-name
+     class-name (:: @ map %code (macro;gensym (format current-module "/eval")))
+     #let [store-name (text;replace-all "/" "." class-name)
+           writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
                         (ClassWriter.visit [commonT;bytecode-version
                                             (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER)
                                             class-name
@@ -70,11 +73,11 @@
                                  "<clinit>"
                                  ($t;method (list) #;None (list))
                                  (|>. valueI
-                                      ($i;PUTSTATIC class-name commonT;value-field commonT;$Object)
+                                      ($i;PUTSTATIC store-name commonT;value-field commonT;$Object)
                                       $i;RETURN)))
            bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
-     _ (commonT;store-class class-name bytecode)
-     class (commonT;load-class class-name)]
+     _ (commonT;store-class store-name bytecode)
+     class (commonT;load-class store-name)]
     (wrap (|> class
               (Class.getField [commonT;value-field])
               (Field.get (host;null))))))
diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux
index d8a2077bc..ab3382952 100644
--- a/new-luxc/source/luxc/lang/translation/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -291,6 +291,8 @@
      [function-class bodyI] (hostL;with-sub-context
                               (hostL;with-anchor [@begin +1]
                                 (translate bodyS)))
+     this-module macro;current-module-name
+     #let [function-class (format (text;replace-all "/" "." this-module) "." function-class)]
      [functionD instanceI] (with-function @begin function-class env arity bodyI)
      _ (commonT;store-class function-class
                             ($d;class #$;V1.6 #$;Public $;finalC
diff --git a/new-luxc/source/luxc/lang/translation/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/imports.jvm.lux
new file mode 100644
index 000000000..c30f61225
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/imports.jvm.lux
@@ -0,0 +1,150 @@
+(;module:
+  lux
+  (lux (control [monad #+ do]
+                ["p" parser]
+                ["ex" exception #+ exception:]
+                pipe)
+       (concurrency [promise #+ Promise]
+                    [stm #+ Var STM])
+       (data ["e" error #+ Error]
+             [maybe]
+             [product]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]
+                   [dict #+ Dict]))
+       [macro]
+       (macro [code]
+              ["s" syntax])
+       [io #+ IO Process io]
+       [host])
+  (luxc ["&" lang]
+        (lang [";L" module])))
+
+(exception: #export Invalid-Imports)
+(exception: #export Module-Cannot-Import-Itself)
+(exception: #export Circular-Dependency)
+
+(host;import (java.util.concurrent.Future a)
+  (get [] #io a))
+
+(host;import (java.util.concurrent.CompletableFuture a)
+  (new [])
+  (complete [a] boolean)
+  (#static [a] completedFuture [a] (CompletableFuture a)))
+
+(type: Import
+  {#module Text
+   #alias Text})
+
+(def: import (s;Syntax Import) (s;tuple (p;seq s;text s;text)))
+
+(def: compilations
+  (Var (Dict Text (CompletableFuture (Error Compiler))))
+  (stm;var (dict;new text;Hash<Text>)))
+
+(def: (promise-to-future promise)
+  (All [a] (-> (Promise a) (Future a)))
+  (let [future (CompletableFuture.new [])]
+    (exec (:: promise;Functor<Promise> map
+              (function [value] (CompletableFuture.complete [value] future))
+              promise)
+      future)))
+
+(def: from-io
+  (All [a] (-> (IO a) (Process a)))
+  (:: io;Monad<IO> map (|>. #e;Success)))
+
+(def: (translate-dependency translate-module dependency compiler)
+  (-> (-> Text Compiler (Process Compiler))
+      (-> Text Compiler (IO (Future (Error Compiler)))))
+  (<| (Future.get [])
+      promise-to-future
+      (do promise;Monad<Promise>
+        [[new? future] (stm;commit (: (STM [Bool (CompletableFuture (Error Compiler))])
+                                      (do stm;Monad<STM>
+                                        [current-compilations (stm;read compilations)]
+                                        (case (dict;get dependency current-compilations)
+                                          (#;Some ongoing)
+                                          (wrap [false ongoing])
+                                          
+                                          #;None
+                                          (do @
+                                            [#let [pending (: (CompletableFuture (Error Compiler))
+                                                              (CompletableFuture.new []))]
+                                             _ (stm;write (dict;put dependency pending current-compilations)
+                                                          compilations)]
+                                            (wrap [true pending]))))))]
+        (if new?
+          (exec (promise;future (io (CompletableFuture.complete [(io;run (translate-module dependency compiler))]
+                                                                future)))
+            (wrap future))
+          (wrap future)))))
+
+(def: compiled?
+  (-> Module Bool)
+  (|>. (get@ #;module-state)
+       (case>
+        (^or #;Cached #;Compiled)
+        true
+
+        _
+        false)))
+
+(def: (merge-modules current-module from-dependency from-current)
+  (-> Text (List [Text Module]) (List [Text Module]) (List [Text Module]))
+  (|> from-dependency
+      (list;filter (|>. product;right compiled?))
+      (list/fold (function [[dep-name dep-module] total] (&;pl-put dep-name dep-module total))
+                 from-current)))
+
+(def: (merge-compilers current-module dependency total)
+  (-> Text Compiler Compiler Compiler)
+  (|> total
+      (update@ #;modules (merge-modules current-module (get@ #;modules dependency)))
+      (set@ #;seed (get@ #;seed dependency))))
+
+(def: #export (translate-imports translate-module annotations)
+  (-> (-> Text Compiler (Process Compiler))
+      Code
+      (Meta (Process Compiler)))
+  (do macro;Monad<Meta>
+    [_ (moduleL;set-annotations annotations)
+     current-module macro;current-module-name
+     #let [_ (log! (format "{translate-imports} " current-module))]
+     imports (let [imports (|> (macro;get-tuple-ann (ident-for #;imports) annotations)
+                               (maybe;default (list)))]
+               (case (s;run imports (p;some import))
+                 (#e;Success imports)
+                 (wrap imports)
+                 
+                 (#e;Error error)
+                 (&;throw Invalid-Imports (%code (code;tuple imports)))))
+     dependencies (monad;map @ (: (-> [Text Text] (Meta (IO (Future (Error Compiler)))))
+                                  (function [[dependency alias]]
+                                    (do @
+                                      [_ (&;assert Module-Cannot-Import-Itself current-module
+                                                   (not (text/= current-module dependency)))
+                                       already-seen? (moduleL;exists? dependency)
+                                       circular-dependency? (if already-seen?
+                                                              (moduleL;active? dependency)
+                                                              (wrap false))
+                                       _ (&;assert Circular-Dependency (format "From: " current-module "\n"
+                                                                               "  To: " dependency)
+                                                   (not circular-dependency?))
+                                       _ (moduleL;import dependency)
+                                       _ (if (text/= "" alias)
+                                           (wrap [])
+                                           (moduleL;alias alias dependency))
+                                       compiler macro;get-compiler]
+                                      (if already-seen?
+                                        (wrap (io (CompletableFuture.completedFuture [(#e;Success compiler)])))
+                                        (wrap (translate-dependency translate-module dependency compiler))))))
+                             imports)
+     compiler macro;get-compiler]
+    (wrap (do io;Monad<Process>
+            [dependencies (monad;seq io;Monad<Process> (list/map from-io dependencies))
+             dependencies (|> dependencies
+                              (list/map (Future.get []))
+                              (monad;seq io;Monad<Process>))]
+            (wrap (list/fold (merge-compilers current-module) compiler dependencies))))))
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
index 9d0cc91e4..bfc838041 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -25,7 +25,9 @@
 (def: #export (translate-captured variable)
   (-> Variable (Meta $;Inst))
   (do macro;Monad<Meta>
-    [function-class hostL;context]
+    [this-module macro;current-module-name
+     function-class hostL;context
+     #let [function-class (format (text;replace-all "/" "." this-module) "." function-class)]]
     (wrap (|>. ($i;ALOAD +0)
                ($i;GETFIELD function-class
                             (|> variable i.inc (i.* -1) int-to-nat captured)
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
index 387181f98..df7e26741 100644
--- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -36,48 +36,57 @@
   (-> Text Type $;Inst $;Inst Code (Meta Unit))
   (do macro;Monad<Meta>
     [current-module macro;current-module-name
-     #let [def-ident [current-module def-name]
-           normal-name (format (&;normalize-name def-name) (%n (text/hash 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) commonT;value-field commonT;$Object)
-                                   ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
-                                              (|>. valueI
-                                                   ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object)
-                                                   $i;RETURN))))]
-     _ (commonT;store-class class-name bytecode)
-     class (commonT;load-class class-name)
-     valueV (: (Meta Top)
-               (case (do e;Monad<Error>
-                       [field (Class.getField [commonT;value-field] class)]
-                       (Field.get [#;None] field))
-                 (#e;Success #;None)
-                 (&;throw Invalid-Definition-Value (%ident def-ident))
-                 
-                 (#e;Success (#;Some valueV))
-                 (wrap valueV)
-                 
-                 (#e;Error error)
-                 (&;throw Cannot-Evaluate-Definition
-                          (format "Definition: " (%ident def-ident) "\n"
-                                  "Error:\n"
-                                  error))))
-     _ (&module;define def-ident [valueT metaV valueV])
-     _ (if (macro;type? metaV)
-         (case (macro;declared-tags metaV)
-           #;Nil
-           (wrap [])
+     #let [def-ident [current-module def-name]]]
+    (case (macro;get-symbol-ann (ident-for #;alias) metaV)
+      (#;Some real-def)
+      (do @
+        [[realT realA realV] (macro;find-def real-def)
+         _ (&module;define def-ident [realT metaV realV])]
+        (wrap []))
 
-           tags
-           (&module;declare-tags tags (macro;export? metaV) (:! Type valueV)))
-         (wrap []))
-     #let [_ (log! (format "DEF " (%ident def-ident)))]]
-    (commonT;record-artifact (format bytecode-name ".class") bytecode)))
+      _
+      (do @
+        [#let [normal-name (format (&;normalize-name def-name) (%n (text/hash def-name)))
+               bytecode-name (format current-module "/" normal-name)
+               class-name (format (text;replace-all "/" "." 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) commonT;value-field commonT;$Object)
+                                       ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
+                                                  (|>. valueI
+                                                       ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object)
+                                                       $i;RETURN))))]
+         _ (commonT;store-class class-name bytecode)
+         class (commonT;load-class class-name)
+         valueV (: (Meta Top)
+                   (case (do e;Monad<Error>
+                           [field (Class.getField [commonT;value-field] class)]
+                           (Field.get [#;None] field))
+                     (#e;Success #;None)
+                     (&;throw Invalid-Definition-Value (%ident def-ident))
+                     
+                     (#e;Success (#;Some valueV))
+                     (wrap valueV)
+                     
+                     (#e;Error error)
+                     (&;throw Cannot-Evaluate-Definition
+                              (format "Definition: " (%ident def-ident) "\n"
+                                      "Error:\n"
+                                      error))))
+         _ (&module;define def-ident [valueT metaV valueV])
+         _ (if (macro;type? metaV)
+             (case (macro;declared-tags metaV)
+               #;Nil
+               (wrap [])
+
+               tags
+               (&module;declare-tags tags (macro;export? metaV) (:! Type valueV)))
+             (wrap []))
+         #let [_ (log! (format "DEF " (%ident def-ident)))]]
+        (commonT;record-artifact (format bytecode-name ".class") bytecode)))))
 
 (def: #export (translate-program program-args programI)
   (-> Text $;Inst (Meta Unit))