From a478cf577de872178d8e9915f03c978e15553df5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 31 Dec 2016 17:21:25 -0400 Subject: - Now pre-loading full cache, instead of loading it lazily. --- luxc/src/lux/base.clj | 9 +++ luxc/src/lux/compiler.clj | 141 ++++++++++++++++++++-------------------- luxc/src/lux/compiler/cache.clj | 129 +++++++++++++++++++++--------------- 3 files changed, 155 insertions(+), 124 deletions(-) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 823144acf..21a093272 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -1510,3 +1510,12 @@ (binding [*out* !out!] (do (print (apply str parts)) (flush))))) + +(defn |eitherL [left right] + (fn [compiler] + (|case (run-state left compiler) + ($Left _error) + (run-state right compiler) + + _output + _output))) diff --git a/luxc/src/lux/compiler.clj b/luxc/src/lux/compiler.clj index 15b74bc9e..fd76f8c41 100644 --- a/luxc/src/lux/compiler.clj +++ b/luxc/src/lux/compiler.clj @@ -183,77 +183,76 @@ :let [file-hash (hash file-content) ;; compile-module!! (&¶llel/parallel-compilation (partial compile-module source-dirs)) compile-module!! (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! compile-module!! all-compilers)] - (|do [module-exists? (&a-module/exists? name)] - (if module-exists? - (fail "[Compiler Error] Can't redefine a module!") - (|do [_ (&&cache/delete name) - _ (&a-module/create-module name file-hash) - _ (&/flag-active-module name) - :let [module-class-name (str (&host/->module-class name) "/_") - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - module-class-name nil "java/lang/Object" nil) - (-> (.visitField +field-flags+ &/hash-field "I" nil file-hash) - .visitEnd) - (-> (.visitField +field-flags+ &/compiler-field "Ljava/lang/String;" nil &/compiler-version) - .visitEnd) - (.visitSource file-name nil))] - _ (if (= "lux" name) - (|do [_ &&host/compile-Function-class - _ &&host/compile-LuxRT-class] - (return nil)) - (return nil))] - (fn [state] - (|case ((&/with-writer =class - (&/exhaust% compiler-step)) - (&/set$ &/$source (&reader/from name file-content) state)) - (&/$Right ?state _) - (&/run-state (|do [:let [_ (.visitEnd =class)] - module-anns (&a-module/get-anns name) - defs &a-module/defs - imports &a-module/imports - tag-groups &&module/tag-groups - :let [def-entries (->> defs - (&/|map (fn [_def] - (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def] - (if (= "" ?alias) - (str ?name &&/datum-separator (&&&type/serialize-type ?def-type) &&/datum-separator (&&&ann/serialize-anns ?def-anns)) - (str ?name &&/datum-separator ?alias))))) - (&/|interpose &&/entry-separator) - (&/fold str "")) - import-entries (->> imports - (&/|map (fn [import] - (|let [[_module _hash] import] - (str _module &&/datum-separator _hash)))) - (&/|interpose &&/entry-separator) - (&/fold str "")) - tag-entries (->> tag-groups - (&/|map (fn [group] - (|let [[type tags] group] - (->> tags - (&/|interpose &&/datum-separator) - (&/fold str "") - (str type &&/datum-separator))))) - (&/|interpose &&/entry-separator) - (&/fold str "")) - module-descriptor (->> (&/|list import-entries - tag-entries - (&&&ann/serialize-anns module-anns) - def-entries) - (&/|interpose &&/section-separator) - (&/fold str ""))] - _ (&/flag-compiled-module name) - _ (&&/save-class! &/module-class-name (.toByteArray =class)) - _ (&&/write-module-descriptor! name module-descriptor)] - (return file-hash)) - ?state) - - (&/$Left ?message) - (fail* ?message))))))) - )) + (&/|eitherL (&&cache/load name) + (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!") + (|do [_ (&&cache/delete name) + _ (&a-module/create-module name file-hash) + _ (&/flag-active-module name) + :let [module-class-name (str (&host/->module-class name) "/_") + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + module-class-name nil "java/lang/Object" nil) + (-> (.visitField +field-flags+ &/hash-field "I" nil file-hash) + .visitEnd) + (-> (.visitField +field-flags+ &/compiler-field "Ljava/lang/String;" nil &/compiler-version) + .visitEnd) + (.visitSource file-name nil))] + _ (if (= "lux" name) + (|do [_ &&host/compile-Function-class + _ &&host/compile-LuxRT-class] + (return nil)) + (return nil))] + (fn [state] + (|case ((&/with-writer =class + (&/exhaust% compiler-step)) + (&/set$ &/$source (&reader/from name file-content) state)) + (&/$Right ?state _) + (&/run-state (|do [:let [_ (.visitEnd =class)] + module-anns (&a-module/get-anns name) + defs &a-module/defs + imports &a-module/imports + tag-groups &&module/tag-groups + :let [def-entries (->> defs + (&/|map (fn [_def] + (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def] + (if (= "" ?alias) + (str ?name &&/datum-separator (&&&type/serialize-type ?def-type) &&/datum-separator (&&&ann/serialize-anns ?def-anns)) + (str ?name &&/datum-separator ?alias))))) + (&/|interpose &&/entry-separator) + (&/fold str "")) + import-entries (->> imports + (&/|map (fn [import] + (|let [[_module _hash] import] + (str _module &&/datum-separator _hash)))) + (&/|interpose &&/entry-separator) + (&/fold str "")) + tag-entries (->> tag-groups + (&/|map (fn [group] + (|let [[type tags] group] + (->> tags + (&/|interpose &&/datum-separator) + (&/fold str "") + (str type &&/datum-separator))))) + (&/|interpose &&/entry-separator) + (&/fold str "")) + module-descriptor (->> (&/|list import-entries + tag-entries + (&&&ann/serialize-anns module-anns) + def-entries) + (&/|interpose &&/section-separator) + (&/fold str ""))] + _ (&/flag-compiled-module name) + _ (&&/save-class! &/module-class-name (.toByteArray =class)) + _ (&&/write-module-descriptor! name module-descriptor)] + (return file-hash)) + ?state) + + (&/$Left ?message) + (fail* ?message)))))))) + ) ))) (let [!err! *err*] diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index ce0a0325b..570202789 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -45,11 +45,11 @@ (-> class ^Field (.getField field-name) (.get nil))) ;; [Resources] -(def module-class (str &/module-class-name ".class")) +(def module-class-file (str &/module-class-name ".class")) (defn cached? [module] "(-> Text Bool)" - (.exists (new File (str @&&/!output-dir "/" (&host/->module-class module) "/" module-class))) + (.exists (new File (str @&&/!output-dir "/" (&host/->module-class module) "/" module-class-file))) ;; false ) @@ -87,7 +87,7 @@ (doseq [^File file (seq (.listFiles (File. module-path))) :when (not (.isDirectory file)) :let [file-name (.getName file)] - :when (not= module-class file-name)] + :when (not= module-class-file file-name)] (let [real-name (second (re-find #"^(.*)\.class$" file-name)) bytecode (read-file file)] (swap! !classes assoc (str module* "." real-name) bytecode)))) @@ -103,17 +103,6 @@ (&/$Right compiler) (return* compiler nil)))) -(defn ^:private load-module! [load compile-module source-dirs ^String _import] - (let [[_module _hash] (.split _import &&/datum-separator 2)] - (|do [file-content (&&io/read-file source-dirs (str _module ".lux")) - :let [file-hash (hash file-content) - __hash (Integer/parseInt _hash)] - _ (load source-dirs _module file-hash compile-module) - cached? (&/cached-module? _module) - :let [consistent-cache? (= file-hash __hash)]] - (return (and cached? - consistent-cache?))))) - (defn ^:private parse-tag-groups [^String tags-section] (if (= "" tags-section) &/$Nil @@ -154,32 +143,40 @@ (defn ^:private install-module [loader module module-hash imports tag-groups module-anns def-entries] (|do [_ (&a-module/create-module module module-hash) _ (&a-module/set-anns module-anns module) - _ (&/flag-cached-module module) _ (&a-module/set-imports imports) _ (&/map% (partial process-def-entry loader module) def-entries) _ (&/map% (partial process-tag-group module) tag-groups)] (return nil))) -(defn ^:private process-module [load compile-module source-dirs loader module module-hash] - (|do [^String descriptor (&&/read-module-descriptor! module) +(defn ^:private process-module [pre-load! source-dirs cache-table module-name module-hash loader] + (|do [^String descriptor (&&/read-module-descriptor! module-name) :let [[imports-section tags-section module-anns-section defs-section] (.split descriptor &&/section-separator) - imports (let [imports (vec (.split ^String imports-section &&/entry-separator))] - (if (= [""] imports) - &/$Nil - (&/->list imports)))] - loads (&/map% (partial load-module! load compile-module source-dirs) - imports)] - (if (->> loads &/->seq (every? true?)) + imports (let [imports (vec (.split ^String imports-section &&/entry-separator)) + imports (if (= [""] imports) + &/$Nil + (&/->list imports))] + (&/|map #(.split ^String % &&/datum-separator 2) imports))] + cache-table* (&/fold% (fn [cache-table _import] + (|let [[_module _hash] _import] + (pre-load! source-dirs cache-table _module (Integer/parseInt _hash)))) + cache-table + imports)] + (if (&/|every? (fn [_import] + (|let [[_module _hash] _import] + (contains? cache-table* _module))) + imports) (let [tag-groups (parse-tag-groups tags-section) module-anns (&&&ann/deserialize-anns module-anns-section) def-entries (let [def-entries (vec (.split ^String defs-section &&/entry-separator))] (if (= [""] def-entries) &/$Nil (&/->list def-entries)))] - (install-module loader module module-hash - imports tag-groups module-anns def-entries)) - (uninstall-cache module)))) + (|do [_ (install-module loader module-name module-hash + imports tag-groups module-anns def-entries) + =module (&/find-module module-name)] + (return (assoc cache-table* module-name =module)))) + (fail (str "[Cache Error] Not all dependencies could be loaded for module: " module-name))))) (defn ^:private enumerate-cached-modules!* [^File parent] (if (.isDirectory parent) @@ -201,35 +198,61 @@ (map #(.substring ^String % prefix-to-subtract)) &/->list))) -(def !pre-loaded-cache (atom nil)) -(defn pre-load-cache! [source-dirs] - (let [cached-modules (enumerate-cached-modules!) - loaded-dict (&/fold (fn [loaded-dict present-module] - (assoc loaded-dict present-module false)) - {} - cached-modules)] - (do (&/|log! (prn-str 'pre-load-cache! (&/->seq source-dirs))) - (&/|log! (prn-str 'pre-load-cache! (&/->seq cached-modules))) - (return nil)))) - -(defn load [source-dirs module module-hash compile-module] - "(-> (List Text) Text Int (-> Text (Lux [])) (Lux Nil))" - (|do [already-loaded? (&a-module/exists? module)] - (if already-loaded? - (return nil) - (if (cached? module) +(defn ^:private pre-load! [source-dirs cache-table module module-hash] + (cond (contains? cache-table module) + (return cache-table) + + (not (cached? module)) + (return cache-table) + + :else (|do [loader &/loader !classes &/classes :let [module* (&host-generics/->class-name module) module-path (str @&&/!output-dir "/" module) - class-name (str module* "._") + class-name (str module* "." &/module-class-name) old-classes @!classes - ^Class module-class (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + ^Class module-class (do (swap! !classes assoc class-name (read-file (new File (str module-path "/" module-class-file)))) (&&/load-class! loader class-name)) - _ (install-all-classes-in-module !classes module* module-path)]] - (if (and (= module-hash (get-field &/hash-field module-class)) - (= &/compiler-version (get-field &/compiler-field module-class))) - (process-module load compile-module source-dirs loader module module-hash) - (do (reset! !classes old-classes) - (uninstall-cache module)))) - (uninstall-cache module))))) + _ (install-all-classes-in-module !classes module* module-path) + valid-cache? (and (= module-hash (get-field &/hash-field module-class)) + (= &/compiler-version (get-field &/compiler-field module-class))) + drop-cache! (|do [_ (uninstall-cache module) + :let [_ (reset! !classes old-classes)]] + (return cache-table))]] + (if valid-cache? + (&/|eitherL (process-module pre-load! source-dirs cache-table module module-hash loader) + drop-cache!) + drop-cache!)))) + +(def !pre-loaded-cache (atom nil)) +(defn pre-load-cache! [source-dirs] + (|do [:let [fs-cached-modules (enumerate-cached-modules!)] + pre-loaded-modules (&/fold% (fn [cache-table module-name] + (|do [file-content (&&io/read-file source-dirs (str module-name ".lux")) + :let [module-hash (hash file-content)]] + (pre-load! source-dirs cache-table module-name module-hash))) + {} + fs-cached-modules) + :let [_ (&/|log! (prn-str 'fs-cached-modules (&/->seq fs-cached-modules))) + _ (&/|log! (prn-str 'pre-loaded-modules (keys pre-loaded-modules))) + _ (reset! !pre-loaded-cache pre-loaded-modules)]] + (return nil))) + +(defn ^:private inject-module + "(-> (Module Compiler) (-> Compiler (Lux Null)))" + [module-name module] + (fn [compiler] + (return* (->> compiler + (&/update$ &/$modules #(&/|put module-name module %)) + ;; (&/update$ &/$host ...) + ) + nil))) + +(defn load [module-name] + "(-> Text (Lux Null))" + (if-let [module-struct (get @!pre-loaded-cache module-name)] + (|do [_ (inject-module module-name module-struct) + _ (&/flag-cached-module module-name)] + (return nil)) + (fail (str "[Cache Error] Module is not cached: " module-name)))) -- cgit v1.2.3