diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/compiler/parallel.clj | 62 |
1 files changed, 41 insertions, 21 deletions
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) ))) |