1 files changed, 150 insertions, 0 deletions
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))))))