diff options
author | Eduardo Julian | 2016-12-30 19:11:22 -0400 |
---|---|---|
committer | Eduardo Julian | 2016-12-30 19:11:22 -0400 |
commit | 00cdab25b25822c3ee08c3cce43dcc05a8b64b5b (patch) | |
tree | 8110bc970057cfeee67159a58e33e69c565eb4c0 | |
parent | 30d58c84feb08150acd8e4f378b14e753538499c (diff) |
- Refactored caching mechanism.
-rw-r--r-- | luxc/src/lux/compiler/cache.clj | 180 |
1 files changed, 100 insertions, 80 deletions
diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index e1951c0d5..9ba3ac815 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -103,86 +103,106 @@ (&/$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 + (-> tags-section + (.split &&/entry-separator) + seq + (->> (map (fn [^String _group] + (let [[_type & _tags] (.split _group &&/datum-separator)] + (&/T [_type (->> _tags seq &/->list)]))))) + &/->list))) + +(defn ^:private process-tag-group [module group] + (|let [[_type _tags] group] + (|do [[was-exported? =type] (&a-module/type-def module _type)] + (&a-module/declare-tags module _tags was-exported? =type)))) + +(defn ^:private process-def-entry [loader module ^String _def-entry] + (let [parts (.split _def-entry &&/datum-separator)] + (case (alength parts) + 2 (let [[_name _alias] parts + [_ __module __name] (re-find #"^(.*);(.*)$" _alias) + def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name))) + def-anns (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))])) + def-value (get-field &/value-field def-class)] + (|do [def-type (&a-module/def-type __module __name)] + (&a-module/define module _name def-type def-anns def-value))) + 3 (let [[_name _type _anns] parts + def-class (&&/load-class! loader (str (&host-generics/->class-name module) "." (&host/def-name _name))) + [def-anns _] (&&&ann/deserialize-anns _anns) + [def-type _] (&&&type/deserialize-type _type) + def-value (get-field &/value-field def-class)] + (&a-module/define module _name def-type def-anns def-value))))) + +(defn ^:private redo-cache [compile-module module] + (|do [_ (delete module) + ;; async (compile-module module) + ] + ;; (assume-async-result @async) + (compile-module module) + )) + +(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) + :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?)) + (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)) + (redo-cache compile-module module)))) + (defn load [source-dirs module module-hash compile-module] - "(-> (List Text) Text Int (-> Text (Lux (,))) (Lux Bool))" + "(-> (List Text) Text Int (-> Text (Lux [])) (Lux Bool))" (|do [already-loaded? (&a-module/exists? module)] (if already-loaded? - (return module-hash) - (|let [redo-cache (|do [_ (delete module) - ;; async (compile-module module) - ] - ;; (assume-async-result @async) - (compile-module module))] - (if (cached? module) - (|do [loader &/loader - !classes &/classes - :let [module* (&host-generics/->class-name module) - module-path (str @&&/!output-dir "/" module) - class-name (str module* "._") - old-classes @!classes - ^Class module-class (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (&&/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))) - (|do [^String descriptor (&&/read-module-descriptor! module) - :let [sections (.split descriptor &&/section-separator) - [^String imports-section ^String tags-section module-anns-section ^String defs-section] sections - imports (vec (.split imports-section &&/entry-separator))] - loads (&/map% (fn [^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?))))) - (if (= [""] imports) - &/$Nil - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (|do [:let [tag-groups (if (= "" tags-section) - &/$Nil - (-> tags-section - (.split &&/entry-separator) - seq - (->> (map (fn [^String _group] - (let [[_type & _tags] (.split _group &&/datum-separator)] - (&/T [_type (->> _tags seq &/->list)]))))) - &/->list))] - _ (&a-module/create-module module module-hash) - _ (&a-module/set-anns (&&&ann/deserialize-anns module-anns-section) module) - _ (&/flag-cached-module module) - _ (&a-module/set-imports imports) - :let [desc-defs (vec (.split defs-section &&/entry-separator))] - _ (&/map% (fn [^String _def-entry] - (let [parts (.split _def-entry &&/datum-separator)] - (case (alength parts) - 2 (let [[_name _alias] parts - [_ __module __name] (re-find #"^(.*);(.*)$" _alias) - def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name))) - def-anns (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))])) - def-value (get-field &/value-field def-class)] - (|do [def-type (&a-module/def-type __module __name)] - (&a-module/define module _name def-type def-anns def-value))) - 3 (let [[_name _type _anns] parts - def-class (&&/load-class! loader (str module* "." (&host/def-name _name))) - [def-anns _] (&&&ann/deserialize-anns _anns) - [def-type _] (&&&type/deserialize-type _type) - def-value (get-field &/value-field def-class)] - (&a-module/define module _name def-type def-anns def-value))))) - (if (= [""] desc-defs) - &/$Nil - (&/->list desc-defs))) - _ (&/map% (fn [group] - (|let [[_type _tags] group] - (|do [[was-exported? =type] (&a-module/type-def module _type)] - (&a-module/declare-tags module _tags was-exported? =type)))) - tag-groups)] - (return module-hash)) - redo-cache)) - (do (reset! !classes old-classes) - redo-cache))) - redo-cache))))) + (return nil) + (if (cached? module) + (|do [loader &/loader + !classes &/classes + :let [module* (&host-generics/->class-name module) + module-path (str @&&/!output-dir "/" module) + class-name (str module* "._") + old-classes @!classes + ^Class module-class (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (&&/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) + (redo-cache compile-module module)))) + (redo-cache compile-module module))))) |