aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/host.clj4
-rw-r--r--src/lux/analyser/lux.clj143
-rw-r--r--src/lux/analyser/module.clj64
-rw-r--r--src/lux/base.clj7
-rw-r--r--src/lux/compiler.clj20
-rw-r--r--src/lux/compiler/lux.clj4
-rw-r--r--src/lux/compiler/parallel.clj62
-rw-r--r--src/lux/packager/program.clj5
8 files changed, 240 insertions, 69 deletions
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 10:33:27 +0000