From b103dafd2c60b91a9c02bbfcee6c2fcb30e40582 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 11 Oct 2016 15:50:24 -0400 Subject: - Refactored the code. --- src/lux/analyser/lux.clj | 77 +++++++++++++++---------------------------- src/lux/analyser/module.clj | 54 +++--------------------------- src/lux/base.clj | 2 +- src/lux/compiler/parallel.clj | 56 +++++++------------------------ 4 files changed, 43 insertions(+), 146 deletions(-) (limited to 'src') 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))) -- cgit v1.2.3