diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser/module.clj | 33 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 12 | ||||
| -rw-r--r-- | src/lux/compiler/parallel.clj | 60 | ||||
| -rw-r--r-- | src/lux/packager/program.clj | 6 |
4 files changed, 95 insertions, 16 deletions
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index a06988a3f..6af4adff6 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -43,8 +43,9 @@ )) ;; [Exports] -(defn add-import [module] +(defn add-import "(-> Text (Lux Null))" + [module] (|do [current-module &/get-module-name] (fn [state] (if (&/|member? module (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $imports))) @@ -58,8 +59,9 @@ state) nil))))) -(defn set-imports [imports] +(defn set-imports "(-> (List Text) (Lux Null))" + [imports] (|do [current-module &/get-module-name] (fn [state] (return* (&/update$ &/$modules @@ -91,8 +93,9 @@ ((&/fail-with-loc (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name)) state)))) -(defn def-type [module name] +(defn def-type "(-> Text Text (Lux Type))" + [module name] (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] @@ -103,8 +106,9 @@ ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module)) state)))) -(defn type-def [module name] +(defn type-def "(-> Text Text (Lux [Bool Type]))" + [module name] (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] @@ -127,8 +131,9 @@ ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module)) state)))) -(defn exists? [name] +(defn exists? "(-> Text (Lux Bool))" + [name] (fn [state] (return* state (->> state (&/get$ &/$modules) (&/|contains? name))))) @@ -220,8 +225,9 @@ state)) ))) -(defn ensure-type-def [def-data] +(defn ensure-type-def "(-> DefData (Lux Type))" + [def-data] (|let [[?type ?meta ?value] def-data] (|case (&meta/meta-get &meta/type?-tag ?meta) (&/$Some _) @@ -235,8 +241,9 @@ (return true)) (return false)))) -(defn create-module [name hash] +(defn create-module "(-> Text Hash-Code (Lux Null))" + [name hash] (fn [state] (return* (->> state (&/update$ &/$modules #(&/|put name (new-module hash) %)) @@ -244,8 +251,9 @@ nil))) (do-template [<name> <tag> <type>] - (defn <name> [module] + (defn <name> <type> + [module] (fn [state] (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))] (return* state (&/get$ <tag> =module)) @@ -282,8 +290,9 @@ (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T [module name]))))] (return nil))) -(defn declare-tags [module tag-names was-exported? type] +(defn declare-tags "(-> Text (List Text) Bool Type (Lux Null))" + [module tag-names was-exported? type] (|do [_ (ensure-undeclared-tags module tag-names) type-name (&type/type-name type) :let [[_module _name] type-name] @@ -309,8 +318,9 @@ ((&/fail-with-loc (str "[Lux Error] Unknown module: " module)) state))))) -(defn ensure-can-see-tag [module tag-name] +(defn ensure-can-see-tag "(-> Text Text (Lux Unit))" + [module tag-name] (|do [current-module &/get-module-name] (fn [state] (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))] @@ -327,8 +337,9 @@ state))))) (do-template [<name> <part> <doc>] - (defn <name> [module tag-name] + (defn <name> <doc> + [module tag-name] (fn [state] (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [^objects idx+tags+exported+type (&/|get tag-name (&/get$ $tags =module))] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 7bf53ada7..5dd2e3684 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -29,7 +29,8 @@ [case :as &&case] [lambda :as &&lambda] [module :as &&module] - [io :as &&io]) + [io :as &&io] + [parallel :as &¶llel]) [lux.packager.program :as &packager-program]) (:import (org.objectweb.asm Opcodes Label @@ -118,6 +119,7 @@ )) (defn init! [] + (&¶llel/setup!) (reset! !source->last-line {}) (.mkdirs (java.io.File. &&/output-dir)) (doto (.getDeclaredMethod java.net.URLClassLoader "addURL" (into-array [java.net.URL])) @@ -170,7 +172,10 @@ :let [file-hash (hash file-content)]] (if (&&cache/cached? name) (&&cache/load source-dirs name file-hash compile-module) - (let [compiler-step (&analyser/analyse &optimizer/optimize eval! (partial compile-module source-dirs) all-compilers)] + (let [compiler-step (&analyser/analyse &optimizer/optimize + eval! + (&¶llel/parallel-compilation (partial compile-module source-dirs)) + all-compilers)] (|do [module-exists? (&a-module/exists? name)] (if module-exists? (fail "[Compiler Error] Can't redefine a module!") @@ -253,7 +258,8 @@ (defn compile-program [mode program-module source-dirs] (init!) - (let [m-action (&/map% (partial compile-module source-dirs) (&/|list "lux" program-module))] + (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!") diff --git a/src/lux/compiler/parallel.clj b/src/lux/compiler/parallel.clj new file mode 100644 index 000000000..92ff0a79e --- /dev/null +++ b/src/lux/compiler/parallel.clj @@ -0,0 +1,60 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; 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.compiler.parallel + (: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]]))) + +;; [Utils] +(def ^:private !state! (atom {})) + +(def ^:private get-compiler + (fn [compiler] + (return* compiler compiler))) + +(defn ^:private set-compiler [compiler*] + (fn [_] + (return* compiler* 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)))) + +;; [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! {})) + +(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)) + ;; 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 + ;; problem by resetting the typing enviroment, but ideally + ;; those type-vars shouldn't survive in the first place. + ;; MUST FIX + ;; :let [_ (prn 'parallel-compilation module-name + ;; 'PRE (->> pre (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length) + ;; 'POST (->> post (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length) + ;; 'POST* (->> post* (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))] + ] + (return output) + ))) diff --git a/src/lux/packager/program.clj b/src/lux/packager/program.clj index 54cc8a813..27484c300 100644 --- a/src/lux/packager/program.clj +++ b/src/lux/packager/program.clj @@ -85,7 +85,8 @@ (filter #(.endsWith ^String % ".jar")) (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/clojure") + (.contains ^String % "org/clojure/core.async")))))) (let [init-capacity (* 100 1024) buffer-size 1024] @@ -132,7 +133,8 @@ (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.match-0.2.1.jar")) + (not (.endsWith ^String % "core.async-0.2.391.jar")))) (reduce (fn [s ^String j] (add-jar! (new File ^String j) s out)) #{"META-INF/MANIFEST.MF"})) nil) |