aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/lux.clj77
-rw-r--r--src/lux/analyser/module.clj54
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler/parallel.clj56
4 files changed, 43 insertions, 146 deletions
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index b755a6b0b..69b389e70 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -33,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))))
@@ -522,8 +522,6 @@
(return (&&/|meta exo-type* _cursor
(&&/$lambda =scope =captured =body))))
-
-
_
(fail "")))
(fn [err]
@@ -598,35 +596,20 @@
(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)))
+ (&/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)"
@@ -656,7 +639,6 @@
_ (&&module/set-anns ==anns module-name)
_imports (&&module/fetch-imports ==anns)
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
@@ -671,10 +653,7 @@
_ (&&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))]
+ (|do [_module (&/find-module path)
_compiler get-compiler]
(return (doto (promise)
(deliver _compiler)))))
@@ -684,23 +663,19 @@
(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)))
+ :let [;; 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
+ _compiler* (&/fold2 (fn [compiler _import _async]
+ (|let [[path alias] _import]
+ (merge-compilers current-module @_async 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))]
- ]
+ _ (set-compiler _compiler*)]
(return &/$Nil)))
(defn ^:private coerce [new-type analysis]
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index d60298b4a..21aa324e8 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -141,21 +141,9 @@
(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
- "\n"
- "@@@ " (->> state
- (&/get$ &/$modules)
- (&/|get current-module)
- (&/get$ $module-aliases)
- (&/|map &/|first)
- &/->seq
- pr-str)))
+ ((&/fail-with-loc (str "[Analyser Error] Unknown alias: " name))
state)))))
(defn alias [module alias reference]
@@ -205,17 +193,6 @@
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]
@@ -240,25 +217,11 @@
_
((&/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 @ find-def] Definition does not exist: " (str module &/+name-separator+ name)
- "\n @@@"
- (->> $module (&/get$ $defs) (&/|map &/|first) &/->seq pr-str)))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name)))
state))
((&/fail-with-loc (str "[Analyser Error @ find-def] Module doesn't exist: " module))
state))
- ((&/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)))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module))
state))
)))
@@ -437,12 +400,3 @@
_
(&/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 68406ed1b..b59141b34 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -902,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))"
diff --git a/src/lux/compiler/parallel.clj b/src/lux/compiler/parallel.clj
index 42598ef7e..453033287 100644
--- a/src/lux/compiler/parallel.clj
+++ b/src/lux/compiler/parallel.clj
@@ -9,9 +9,7 @@
[template :refer [do-template]])
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return* return fail fail* |case]])
- (lux.analyser [base :as &a]
- [module :as &a-module])))
+ (lux [base :as & :refer [|let |do return* return fail fail* |case]])))
;; [Utils]
(def ^:private !state! (ref {}))
@@ -21,36 +19,22 @@
(return* compiler compiler)))
(defn ^:private compilation-task [compile-module* module-name]
- (|do [current-module &/get-module-name
- compiler get-compiler
+ (|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])))))
- 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))
+ _ (when new?
+ (.start (new Thread
+ (fn []
+ (|case (&/run-state (compile-module* module-name)
+ compiler)
+ (&/$Right post-compiler _)
+ (deliver task post-compiler)
- (&/$Left ?error)
- (do (&/|log! ?error)
- ;; (System/exit 1)
- )))))
- (.start)))
- ;; _ (&/|log! 'parallel-compilation [current-module module-name] new? result)
- ]]
+ (&/$Left ?error)
+ (&/|log! ?error))))))]]
(return task)))
;; [Exports]
@@ -61,20 +45,4 @@
(defn parallel-compilation [compile-module*]
(fn [module-name]
- (|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
- ;; 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 ?async)
- )))
+ (compilation-task compile-module* module-name)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 11:19:35 +0000