1 files changed, 149 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux
new file mode 100644
index 000000000..892dd869f
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux
@@ -0,0 +1,149 @@
+(.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
+     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))))))