aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/lux.clj125
-rw-r--r--src/lux/analyser/module.clj47
-rw-r--r--src/lux/base.clj9
-rw-r--r--src/lux/compiler.clj30
-rw-r--r--src/lux/compiler/cache.clj2
-rw-r--r--src/lux/compiler/parallel.clj47
-rw-r--r--src/lux/packager/program.clj3
7 files changed, 204 insertions, 59 deletions
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 208890d78..8a8f22586 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]]
@@ -32,7 +33,7 @@
0))
;; TODO: This technique won't work if the body of the type contains
-;; nested quantifications that are cannot be directly counted.
+;; nested quantifications that cannot be directly counted.
(defn ^:private next-bound-type [type]
"(-> Type Type)"
(&/$BoundT (->> (count-univq type) (* 2) (+ 1))))
@@ -521,8 +522,6 @@
(return (&&/|meta exo-type* _cursor
(&&/$lambda =scope =captured =body))))
-
-
_
(fail "")))
(fn [err]
@@ -575,6 +574,63 @@
(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]
+ (&/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*
+ (&/|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 +638,46 @@
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
+ =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 [_compiler get-compiler]
+ (return (doto (promise)
+ (deliver (&/$Right _compiler))))))
+ _ (if (= "" alias)
+ (return nil)
+ (&&module/alias current-module alias path))]
+ (return ?async))))))
+ _imports)
+ _compiler get-compiler
+ ;; Some type-vars in the typing environment stay in
+ ;; the environment forever, making type-checking slower.
+ ;; The merging process for compilers more-or-less "fixes" the
+ ;; problem by resetting the typing enviroment, but ideally
+ ;; those type-vars shouldn't survive in the first place.
+ ;; TODO: MUST FIX
+ _ (&/fold% (fn [compiler _async]
+ (|case @_async
+ (&/$Right _new-compiler)
+ (set-compiler (merge-compilers current-module _new-compiler compiler))
+
+ (&/$Left ?error)
+ (fail ?error)))
+ _compiler
+ =asyncs)]
+ (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 a06988a3f..21aa324e8 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)))))
@@ -162,12 +167,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]
@@ -210,18 +215,19 @@
(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)))
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))
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/base.clj b/src/lux/base.clj
index 88d50002b..54a0354c6 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])
@@ -901,7 +902,7 @@
(fn [state]
(if-let [module (|get name (get$ $modules state))]
(return* state module)
- ((fail-with-loc (str "Unknown module: " name)) state))))
+ ((fail-with-loc (str "[Error] Unknown module: " name)) state))))
(def get-current-module
"(Lux (Module Compiler))"
@@ -1444,3 +1445,9 @@
_
class-name)]))))
+
+(let [!out! *out*]
+ (defn |log! [& parts]
+ (binding [*out* !out!]
+ (do (print (apply str parts))
+ (flush)))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 7bf53ada7..6506c867b 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 &&parallel])
[lux.packager.program :as &packager-program])
(:import (org.objectweb.asm Opcodes
Label
@@ -118,6 +119,7 @@
))
(defn init! []
+ (&&parallel/setup!)
(reset! !source->last-line {})
(.mkdirs (java.io.File. &&/output-dir))
(doto (.getDeclaredMethod java.net.URLClassLoader "addURL" (into-array [java.net.URL]))
@@ -167,10 +169,11 @@
(defn compile-module [source-dirs name]
(let [file-name (str name ".lux")]
(|do [file-content (&&io/read-file source-dirs file-name)
- :let [file-hash (hash file-content)]]
+ :let [file-hash (hash file-content)
+ compile-module!! (&&parallel/parallel-compilation (partial compile-module source-dirs))]]
(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)]
+ (&&cache/load source-dirs name file-hash compile-module!!)
+ (let [compiler-step (&analyser/analyse &optimizer/optimize eval! compile-module!! all-compilers)]
(|do [module-exists? (&a-module/exists? name)]
(if module-exists?
(fail "[Compiler Error] Can't redefine a module!")
@@ -252,13 +255,14 @@
)))
(defn compile-program [mode program-module source-dirs]
- (init!)
- (let [m-action (&/map% (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/cache.clj b/src/lux/compiler/cache.clj
index f2668f8b5..4f90c7cce 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -89,7 +89,7 @@
(if already-loaded?
(return module-hash)
(|let [redo-cache (|do [_ (delete module)]
- (compile-module source-dirs module))]
+ (compile-module module))]
(if (cached? module)
(|do [loader &/loader
!classes &/classes
diff --git a/src/lux/compiler/parallel.clj b/src/lux/compiler/parallel.clj
new file mode 100644
index 000000000..8f6fee99d
--- /dev/null
+++ b/src/lux/compiler/parallel.clj
@@ -0,0 +1,47 @@
+;; 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.match
+ clojure.core.match.array
+ (lux [base :as & :refer [|let |do return* return fail fail* |case]])))
+
+;; [Utils]
+(def ^:private !state! (ref {}))
+
+(def ^:private get-compiler
+ (fn [compiler]
+ (return* compiler compiler)))
+
+;; [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."
+ []
+ (dosync (ref-set !state! {})))
+
+(defn parallel-compilation [compile-module*]
+ (fn [module-name]
+ (|do [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])))))
+ _ (when new?
+ (.start (new Thread
+ (fn []
+ (let [out-str (with-out-str
+ (|case (&/run-state (compile-module* module-name)
+ compiler)
+ (&/$Right post-compiler _)
+ (deliver task (&/$Right post-compiler))
+
+ (&/$Left ?error)
+ (deliver task (&/$Left ?error))))]
+ (&/|log! out-str))))))]]
+ (return task))))
diff --git a/src/lux/packager/program.clj b/src/lux/packager/program.clj
index 54cc8a813..2afda2674 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")
+ )))))
(let [init-capacity (* 100 1024)
buffer-size 1024]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 05:55:53 +0000