From ee646a676e3fa240e696178bcebe852c454e1b16 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 11 Oct 2016 08:11:49 -0400 Subject: - Finished a working implementation of parallel compilation, that doesn't rely on core.async. --- project.clj | 3 +- src/lux/analyser/host.clj | 4 +- src/lux/analyser/lux.clj | 143 +++++++++++++++++++++++++++++++++++------- src/lux/analyser/module.clj | 64 ++++++++++++++++--- src/lux/base.clj | 7 +++ src/lux/compiler.clj | 20 +++--- src/lux/compiler/lux.clj | 4 +- src/lux/compiler/parallel.clj | 62 +++++++++++------- src/lux/packager/program.clj | 5 +- 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% (&¶llel/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) -- cgit v1.2.3