- Finished a working implementation of parallel compilation, that doesn't rely on core.async.

9 files changed, 241 insertions, 71 deletions

diff --git a/project.clj b/project.clj
index 5ea065037..726b3b120 100644
--- a/project.clj
+++ b/project.clj
@@ -13,8 +13,7 @@
                               [:url "https://github.com/eduardoejp"]]]
   :dependencies [[org.clojure/clojure "1.6.0"]
                  [org.clojure/core.match "0.2.1"]
-                 [org.ow2.asm/asm-all "5.0.3"]
-                 [org.clojure/core.async "0.2.391"]]
+                 [org.ow2.asm/asm-all "5.0.3"]]
   :warn-on-reflection true
   :main lux
   :repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index b84b31dff..ff998c2d5 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -935,7 +935,7 @@
 (defn ^:private analyse-jvm-interface [analyse compile-interface interface-decl supers =anns =methods]
   (|do [module &/get-module-name
         _ (compile-interface interface-decl supers =anns =methods)
-        :let [_ (println 'INTERFACE (str module "." (&/|first interface-decl)))]
+        :let [_ (&/|log! 'INTERFACE (str module "." (&/|first interface-decl)))]
         _cursor &/cursor]
     (return (&/|list (&&/|meta &/$UnitT _cursor
                                (&&/$tuple (&/|list)))))))
@@ -954,7 +954,7 @@
           _ (check-method-completion all-supers =methods)
           _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None)
           _ &/pop-dummy-name
-          :let [_ (println 'CLASS full-name)]
+          :let [_ (&/|log! 'CLASS full-name)]
           _cursor &/cursor]
       (return (&/|list (&&/|meta &/$UnitT _cursor
                                  (&&/$tuple (&/|list))))))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 208890d78..b755a6b0b 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -4,7 +4,8 @@
 ;;  You can obtain one at http://mozilla.org/MPL/2.0/.
 
 (ns lux.analyser.lux
-  (:require (clojure [template :refer [do-template]])
+  (:require (clojure [template :refer [do-template]]
+                     [set :as set])
             clojure.core.match
             clojure.core.match.array
             (lux [base :as & :refer [|do return return* fail fail* |let |list |case]]
@@ -575,6 +576,78 @@
         (return &/$Nil))
       )))
 
+(defn ^:private merge-hosts
+  "(-> Host Host Host)"
+  [new old]
+  (|let [merged-module-states (&/fold (fn [total m-state]
+                                        (|let [[_name _state] m-state]
+                                          (|case _state
+                                            (&/$Cached)
+                                            (&/|put _name _state total)
+                                            
+                                            (&/$Compiled)
+                                            (&/|put _name _state total)
+
+                                            _
+                                            total)))
+                                      (&/get$ &/$module-states old)
+                                      (&/get$ &/$module-states new))]
+    (->> old
+         (&/set$ &/$module-states merged-module-states))))
+
+(defn ^:private merge-modules
+  "(-> Text Module Module Module)"
+  [current-module new old]
+  (do ;; (&/|log! 'old (->> old (&/|map &/|first) &/->seq set)
+      ;;          "\n"
+      ;;          'new (->> new (&/|map &/|first) &/->seq set)
+      ;;          "\n"
+      ;;          'old+new (set/union (->> old (&/|map &/|first) &/->seq set)
+      ;;                              (->> new (&/|map &/|first) &/->seq set)))
+      (&/fold (fn [total* entry]
+                (|let [[_name _module] entry]
+                  (if (or (= current-module _name)
+                          (->> _module
+                               (&/get$ &&module/$defs)
+                               &/|length
+                               (= 0)))
+                    ;; Don't modify the entry of the current module, to
+                    ;; avoid overwritting it's data in improper ways.
+                    ;; Since it's assumed the "original" old module
+                    ;; contains all the proper own-module information.
+                    total*
+                    (do ;; (&/|log! "Adding:" _name "to" current-module
+                        ;;          (->> _module
+                        ;;               (&/get$ &&module/$defs)
+                        ;;               &/|length)
+                        ;;          (->> _module
+                        ;;               (&/get$ &&module/$defs)
+                        ;;               (&/|filter (comp &&module/exported? &/|second))
+                        ;;               (&/|map &/|first)
+                        ;;               &/->seq pr-str))
+                      (&/|put _name _module total*)))))
+              old new)))
+
+(defn ^:private merge-compilers
+  "(-> Text Compiler Compiler Compiler)"
+  [current-module new old]
+  (->> old
+       (&/set$ &/$modules (merge-modules current-module
+                                         (&/get$ &/$modules new)
+                                         (&/get$ &/$modules old)))
+       (&/set$ &/$seed (max (&/get$ &/$seed new)
+                            (&/get$ &/$seed old)))
+       (&/set$ &/$host (merge-hosts (&/get$ &/$host new)
+                                    (&/get$ &/$host old)))))
+
+(def ^:private get-compiler
+  (fn [compiler]
+    (return* compiler compiler)))
+
+(defn ^:private set-compiler [compiler*]
+  (fn [_]
+    (return* compiler* compiler*)))
+
 (defn analyse-module [analyse optimize eval! compile-module ?meta]
   (|do [_ &/ensure-statement
         =anns (&&/analyse-1 analyse &type/Anns ?meta)
@@ -582,27 +655,53 @@
         module-name &/get-module-name
         _ (&&module/set-anns ==anns module-name)
         _imports (&&module/fetch-imports ==anns)
-        current-module &/get-module-name]
-    (&/map% (fn [_import]
-              (|let [[path alias] _import]
-                (&/without-repl
-                 (&/save-module
-                  (|do [_ (if (= current-module path)
-                            (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path))
-                            (return nil))
-                        already-compiled? (&&module/exists? path)
-                        active? (&/active-module? path)
-                        _ (&/assert! (not active?)
-                                     (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module))
-                        _ (&&module/add-import path)
-                        ?module-hash (if (not already-compiled?)
-                                       (compile-module path)
-                                       (&&module/module-hash path))
-                        _ (if (= "" alias)
-                            (return nil)
-                            (&&module/alias current-module alias path))]
-                    (return &/$Nil))))))
-            _imports)))
+        current-module &/get-module-name
+        ;; :let [_ (&/|log! 'analyse-module module-name (->> _imports (&/|map &/|first) &/->seq))]
+        =asyncs (&/map% (fn [_import]
+                          (|let [[path alias] _import]
+                            (&/without-repl
+                             (&/save-module
+                              (|do [_ (if (= current-module path)
+                                        (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path))
+                                        (return nil))
+                                    already-compiled? (&&module/exists? path)
+                                    active? (&/active-module? path)
+                                    _ (&/assert! (not active?)
+                                                 (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module))
+                                    _ (&&module/add-import path)
+                                    ?async (if (not already-compiled?)
+                                             (compile-module path)
+                                             (|do [_module (&&module/find-module path)
+                                                   ;; :let [_ (&/|log! "Already compiled:" path (->> _module
+                                                   ;;                                                (&/get$ &&module/$defs)
+                                                   ;;                                                &/|length))]
+                                                   _compiler get-compiler]
+                                               (return (doto (promise)
+                                                         (deliver _compiler)))))
+                                    _ (if (= "" alias)
+                                        (return nil)
+                                        (&&module/alias current-module alias path))]
+                                (return ?async))))))
+                        _imports)
+        _compiler get-compiler
+        :let [_compiler* (&/fold2 (fn [compiler _import _async]
+                                    (|let [[path alias] _import
+                                           ;; _ (&/|log! 'import-compiler 'PRE [module-name path])
+                                           import-compiler @_async
+                                           ;; _ (&/|log! 'import-compiler 'POST [module-name path] import-compiler)
+                                           ]
+                                      (merge-compilers current-module import-compiler compiler)))
+                                  _compiler
+                                  _imports
+                                  =asyncs)]
+        _ (set-compiler _compiler*)
+        ;; _ (->> _imports
+        ;;        (&/|map &/|first)
+        ;;        (&/|filter (partial not= "lux"))
+        ;;        (&/map% &&module/add-import))
+        ;; :let [_ (&/|log! "CONTINUE" module-name (->> _imports (&/|map &/|first) &/->seq))]
+        ]
+    (return &/$Nil)))
 
 (defn ^:private coerce [new-type analysis]
   "(-> Type Analysis Analysis)"
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 6af4adff6..d60298b4a 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -141,9 +141,21 @@
 (defn dealias [name]
   (|do [current-module &/get-module-name]
     (fn [state]
-      (if-let [real-name (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $module-aliases) (&/|get name))]
+      (if-let [real-name (->> state
+                              (&/get$ &/$modules)
+                              (&/|get current-module)
+                              (&/get$ $module-aliases)
+                              (&/|get name))]
         (return* state real-name)
-        ((&/fail-with-loc (str "[Analyser Error] Unknown alias: " name))
+        ((&/fail-with-loc (str "[Analyser Error] Unknown alias: " name
+                               "\n"
+                               "@@@ " (->> state
+                                           (&/get$ &/$modules)
+                                           (&/|get current-module)
+                                           (&/get$ $module-aliases)
+                                           (&/|map &/|first)
+                                           &/->seq
+                                           pr-str)))
          state)))))
 
 (defn alias [module alias reference]
@@ -167,12 +179,12 @@
                    nil))))
     ))
 
-(defn ^:private imports? [state imported-module source-module]
+(defn ^:private imports? [state imported-module-name source-module-name]
   (->> state
        (&/get$ &/$modules)
-       (&/|get source-module)
+       (&/|get source-module-name)
        (&/get$ $imports)
-       (&/|any? (partial = imported-module))))
+       (&/|any? (partial = imported-module-name))))
 
 (defn get-anns [module-name]
   (fn [state]
@@ -193,6 +205,17 @@
                                           ms))))
              nil)))
 
+(defn exported?
+  "(-> Def Bool)"
+  [?def]
+  (|let [[?type ?ann ?value] ?def]
+    (|case (&meta/meta-get &meta/export?-tag ?ann)
+      (&/$Some (&/$BoolM true))
+      true
+
+      _
+      false)))
+
 (defn find-def [module name]
   (|do [current-module &/get-module-name]
     (fn [state]
@@ -215,13 +238,27 @@
                   (return* state (&/T [(&/T [module name]) $def]))
 
                   _
-                  ((&/fail-with-loc (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))
+                  ((&/fail-with-loc (str "[Analyser Error @ find-def] Can't use unexported definition: " (str module &/+name-separator+ name)))
                    state))))
-            ((&/fail-with-loc (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))
+            ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name)
+                                   "\n @@@"
+                                   (->> $module (&/get$ $defs) (&/|map &/|first) &/->seq pr-str)))
              state))
-          ((&/fail-with-loc (str "[Analyser Error] Module doesn't exist: " module))
+          ((&/fail-with-loc (str "[Analyser Error @ find-def] Module doesn't exist: " module))
            state))
-        ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module))
+        ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module
+                               "\n"
+                               "@@@ " current-module " :: "
+                               (->> state
+                                    (&/get$ &/$modules)
+                                    (&/|get current-module)
+                                    (&/get$ $imports)
+                                    &/->seq)
+                               " "
+                               (->> state
+                                    (&/get$ &/$modules)
+                                    (&/|map &/|first)
+                                    &/->seq)))
          state))
       )))
 
@@ -400,3 +437,12 @@
 
     _
     (&/fail-with-loc "[Analyser Error] No import meta-data.")))
+
+(defn find-module
+  "(-> Text (Lux Module))"
+  [module-name]
+  (fn [state]
+    (if-let [module (->> state (&/get$ &/$modules) (&/|get module-name))]
+      (return* state module)
+      ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module-name))
+       state))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 88d50002b..68406ed1b 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -2,6 +2,7 @@
 ;;  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
 ;;  If a copy of the MPL was not distributed with this file,
 ;;  You can obtain one at http://mozilla.org/MPL/2.0/.
+
 (ns lux.base
   (:require (clojure [template :refer [do-template]]
                      [string :as string])
@@ -1444,3 +1445,9 @@
 
                   _
                   class-name)]))))
+
+(let [!out! *out*]
+  (defn |log! [& parts]
+    (binding [*out* !out!]
+      (do (print (apply println-str parts))
+        (flush)))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 5dd2e3684..8b9e8bbed 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -257,14 +257,14 @@
       )))
 
 (defn compile-program [mode program-module source-dirs]
-  (init!)
-  (let [m-action (&/map% (&&parallel/parallel-compilation (partial compile-module source-dirs))
-                         (&/|list "lux" program-module))]
-    (|case (m-action (&/init-state mode))
-      (&/$Right ?state _)
-      (do (println "Compilation complete!")
-        (&&cache/clean ?state)
-        (&packager-program/package program-module))
+  (do (init!)
+    (let [m-action (|do [_ (compile-module source-dirs "lux")]
+                     (compile-module source-dirs program-module))]
+      (|case (m-action (&/init-state mode))
+        (&/$Right ?state _)
+        (do (println "Compilation complete!")
+          (&&cache/clean ?state)
+          (&packager-program/package program-module))
 
-      (&/$Left ?message)
-      (assert false ?message))))
+        (&/$Left ?message)
+        (assert false ?message)))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 976bdfa15..551572a87 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -346,7 +346,7 @@
 
                       [_ (&/$None)]
                       (return nil))
-                  :let [_ (println 'DEF (str module-name ";" ?name))]]
+                  :let [_ (&/|log! 'DEF (str module-name ";" ?name))]]
               (return nil)))
 
           _
@@ -428,7 +428,7 @@
 
                     [_ (&/$None)]
                     (return nil))
-                :let [_ (println 'DEF (str module-name ";" ?name))]]
+                :let [_ (&/|log! 'DEF (str module-name ";" ?name))]]
             (return nil)))
         ))))
 
diff --git a/src/lux/compiler/parallel.clj b/src/lux/compiler/parallel.clj
index 92ff0a79e..42598ef7e 100644
--- a/src/lux/compiler/parallel.clj
+++ b/src/lux/compiler/parallel.clj
@@ -7,44 +7,64 @@
   (:require (clojure [string :as string]
                      [set :as set]
                      [template :refer [do-template]])
-            clojure.core.async
             clojure.core.match
             clojure.core.match.array
-            (lux [base :as & :refer [|let |do return* return fail fail* |case]])))
+            (lux [base :as & :refer [|let |do return* return fail fail* |case]])
+            (lux.analyser [base :as &a]
+                          [module :as &a-module])))
 
 ;; [Utils]
-(def ^:private !state! (atom {}))
+(def ^:private !state! (ref {}))
 
 (def ^:private get-compiler
   (fn [compiler]
     (return* compiler compiler)))
 
-(defn ^:private set-compiler [compiler*]
-  (fn [_]
-    (return* compiler* compiler*)))
+(defn ^:private compilation-task [compile-module* module-name]
+  (|do [current-module &/get-module-name
+        compiler get-compiler
+        :let [[task new?] (dosync (if-let [existing-task (get @!state! module-name)]
+                                    (&/T [existing-task false])
+                                    (let [new-task (promise)]
+                                      (do (alter !state! assoc module-name new-task)
+                                        (&/T [new-task true])))))
+              result (when new?
+                       (doto (new Thread
+                                  (fn []
+                                    (do ;; (&/|log! 'THREAD-START [current-module module-name])
+                                      (|case (&/run-state (|do [_ (compile-module* module-name)
+                                                                _module (&a-module/find-module module-name)
+                                                                ;; :let [_ (&/|log! "Just compiled:" module-name (->> _module
+                                                                ;;                                                    (&/get$ &a-module/$defs)
+                                                                ;;                                                    &/|length))]
+                                                                ]
+                                                            (return nil))
+                                                          compiler)
+                                        (&/$Right post-compiler _)
+                                        (do ;; (&/|log! 'FINISHED 'compilation-task [current-module module-name] post-compiler)
+                                          (deliver task post-compiler))
 
-(defn ^:private merge-modules
-  "(-> Compiler Compiler)"
-  [new old]
-  (->> old
-       (&/set$ &/$source (&/get$ &/$source new))
-       (&/set$ &/$modules (&/get$ &/$modules new))
-       (&/set$ &/$seed (&/get$ &/$seed new))
-       (&/set$ &/$host (&/get$ &/$host new))))
+                                        (&/$Left ?error)
+                                        (do (&/|log! ?error)
+                                          ;; (System/exit 1)
+                                          )))))
+                         (.start)))
+              ;; _ (&/|log! 'parallel-compilation [current-module module-name] new? result)
+              ]]
+    (return task)))
 
 ;; [Exports]
 (defn setup!
   "Must always call this function before using parallel compilation to make sure that the state that is being tracked is in proper shape."
   []
-  (reset! !state! {}))
+  (dosync (ref-set !state! {})))
 
 (defn parallel-compilation [compile-module*]
   (fn [module-name]
-    (|do [:let [_ (prn 'parallel-compilation module-name)]
-          pre get-compiler
-          output (compile-module* module-name)
-          post get-compiler
-          post* (set-compiler (merge-modules post pre))
+    (|do [;; pre get-compiler
+          ?async (compilation-task compile-module* module-name)
+          ;; post get-compiler
+          ;; post* (set-compiler (merge-compilers post pre))
           ;; TODO: Some type-vars in the typing environment stay in
           ;; the environment forever, making type-checking slower.
           ;; The merging process for modules more-or-less "fixes" the
@@ -56,5 +76,5 @@
           ;;              'POST (->> post (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length)
           ;;              'POST* (->> post* (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))]
           ]
-      (return output)
+      (return ?async)
       )))
diff --git a/src/lux/packager/program.clj b/src/lux/packager/program.clj
index 27484c300..2afda2674 100644
--- a/src/lux/packager/program.clj
+++ b/src/lux/packager/program.clj
@@ -86,7 +86,7 @@
        (filter #(not (or (.contains ^String % "org/ow2/asm/asm-all")
                          (.contains ^String % "org/clojure/core.match")
                          (.contains ^String % "org/clojure/clojure")
-                         (.contains ^String % "org/clojure/core.async"))))))
+                         )))))
 
 (let [init-capacity (* 100 1024)
       buffer-size 1024]
@@ -133,8 +133,7 @@
                          (not (.endsWith ^String % "tools.nrepl-0.2.3.jar"))
                          (not (.endsWith ^String % "clojure-complete-0.2.3.jar"))
                          (not (.endsWith ^String % "clojure-1.6.0.jar"))
-                         (not (.endsWith ^String % "core.match-0.2.1.jar"))
-                         (not (.endsWith ^String % "core.async-0.2.391.jar"))))
+                         (not (.endsWith ^String % "core.match-0.2.1.jar"))))
            (reduce (fn [s ^String j] (add-jar! (new File ^String j) s out))
                    #{"META-INF/MANIFEST.MF"}))
       nil)