diff options
Diffstat (limited to 'luxc/src/lux/compiler/jvm/cache.clj')
| -rw-r--r-- | luxc/src/lux/compiler/jvm/cache.clj | 263 |
1 files changed, 32 insertions, 231 deletions
diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj index b2b4f2bac..c6549a718 100644 --- a/luxc/src/lux/compiler/jvm/cache.clj +++ b/luxc/src/lux/compiler/jvm/cache.clj @@ -13,12 +13,8 @@ [meta :as &a-meta]) (lux.compiler [core :as &&core] [io :as &&io]) - (lux.compiler.cache [type :as &&&type] - [ann :as &&&ann]) (lux.compiler.jvm [base :as &&])) - (:import (java.io File - BufferedOutputStream - FileOutputStream) + (:import (java.io File) (java.lang.reflect Field) )) @@ -35,231 +31,36 @@ "(-> Text Class Object)" (-> class ^Field (.getField field-name) (.get nil))) -;; [Resources] -(def module-class-file (str &/module-class-name ".class")) - -(defn ^:private delete-all-module-files [^File file] - (doseq [^File f (seq (.listFiles file)) - :when (not (.isDirectory f))] - (.delete f))) - -(defn ^:private module-path [module] - (str @&&core/!output-dir - java.io.File/separator - (.replace ^String (&host/->module-class module) "/" java.io.File/separator))) - -(defn cached? [module] - "(-> Text Bool)" - (.exists (new File (str (module-path module) java.io.File/separator &&core/lux-module-descriptor-name)))) - -(defn delete [module] - "(-> Text (Lux Null))" - (fn [state] - (do (delete-all-module-files (new File (module-path module))) - (return* state nil)))) - -(defn ^:private module-dirs - "(-> File (clojure.Seq File))" - [^File module] - (->> module - .listFiles - (filter #(.isDirectory ^File %)) - (map module-dirs) - (apply concat) - (list* module))) - -(defn clean [state] - "(-> Compiler Null)" - (let [needed-modules (->> state (&/get$ &/$modules) &/|keys &/->seq set) - output-dir-prefix (str (.getAbsolutePath (new File ^String @&&core/!output-dir)) java.io.File/separator) - outdated? #(->> % (contains? needed-modules) not) - outdated-modules (->> (new File ^String @&&core/!output-dir) - .listFiles (filter #(.isDirectory ^File %)) - (map module-dirs) doall (apply concat) - (map (fn [^File dir-file] - (let [^String dir-module (-> dir-file - .getAbsolutePath - (string/replace output-dir-prefix "")) - corrected-dir-module (.replace dir-module java.io.File/separator "/")] - corrected-dir-module))) - (filter outdated?))] - (doseq [^String f outdated-modules] - (delete-all-module-files (new File (str output-dir-prefix f)))) - nil)) - -(defn ^:private install-all-defs-in-module [!classes module* ^String module-path] - (let [file-name+content (for [^File file (seq (.listFiles (File. module-path))) - :when (not (.isDirectory file)) - :let [file-name (.getName file)] - :when (not= module-class-file file-name)] - [(second (re-find #"^(.*)\.class$" file-name)) - (read-file file)]) - _ (doseq [[file-name content] file-name+content] - (swap! !classes assoc (str module* "." file-name) content))] - (map first file-name+content))) - -(defn ^:private parse-tag-groups [^String tags-section] - (if (= "" tags-section) - &/$Nil - (-> tags-section - (.split &&core/entry-separator) - seq - (->> (map (fn [^String _group] - (let [[_type & _tags] (.split _group &&core/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 &&core/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 (&/$IdentA (&/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 uninstall-cache [module] - (|do [_ (delete module)] - (return false))) +(def ^:private module-class-file (str &/module-class-name ".class")) -(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/flag-cached-module module) - _ (&a-module/set-anns module-anns 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 [pre-load! source-dirs cache-table module-name module-hash loader - _imports-section _tags-section _module-anns-section _defs-section] - (|do [^String descriptor (&&core/read-module-descriptor! module-name) - :let [imports (let [imports (vec (.split ^String _imports-section &&core/entry-separator)) - imports (if (= [""] imports) - &/$Nil - (&/->list imports))] - (&/|map #(.split ^String % &&core/datum-separator 2) imports))] - cache-table* (&/fold% (fn [cache-table* _import] - (|do [:let [[_module _hash] _import] - file-content (&&io/read-file source-dirs (str _module ".lux")) - output (pre-load! source-dirs cache-table* _module (hash file-content))] - (return output))) - 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 &&core/entry-separator))] - (if (= [""] def-entries) - &/$Nil - (&/->list def-entries)))] - (|do [_ (install-module loader module-name module-hash - imports tag-groups module-anns def-entries) - =module (&/find-module module-name)] - (return (&/T [true (assoc cache-table* module-name =module)])))) - (return (&/T [false cache-table*]))))) - -(defn ^:private enumerate-cached-modules!* [^File parent] - (if (.isDirectory parent) - (let [children (for [^File child (seq (.listFiles parent)) - entry (enumerate-cached-modules!* child)] - entry)] - (if (.exists (new File parent "_.class")) - (list* (.getAbsolutePath parent) - children) - children)) - (list))) - -(defn ^:private enumerate-cached-modules! [] - (let [output-dir (new File ^String @&&core/!output-dir) - prefix-to-subtract (inc (.length (.getAbsolutePath output-dir)))] - (->> output-dir - enumerate-cached-modules!* - rest - (map #(-> ^String % - (.replace java.io.File/separator "/") - (.substring prefix-to-subtract))) - &/->list))) - -(defn ^:private pre-load! [source-dirs cache-table module-name module-hash] - (cond (contains? cache-table module-name) - (return cache-table) - - (not (cached? module-name)) - (return cache-table) - - :else - (|do [loader &/loader - !classes &/classes - ^String descriptor (&&core/read-module-descriptor! module-name) - :let [module* (&host-generics/->class-name module-name) - module-path (str @&&core/!output-dir java.io.File/separator module-name) - class-name (str module* "." &/module-class-name) - ^Class module-class (do (swap! !classes assoc class-name (read-file (new File (str module-path java.io.File/separator module-class-file)))) - (&&/load-class! loader class-name)) - installed-classes (install-all-defs-in-module !classes module* module-path) - [_compiler _hash _imports-section _tags-section _module-anns-section _defs-section] (.split descriptor &&core/section-separator) - drop-cache! (|do [_ (uninstall-cache module-name) - :let [_ (swap! !classes (fn [_classes-dict] - (reduce dissoc _classes-dict installed-classes)))]] - (return cache-table))]] - (if (and (= module-hash (Long/parseUnsignedLong ^String _hash)) - (= &/compiler-version _compiler)) - (|do [[success? cache-table*] (process-module pre-load! source-dirs cache-table module-name module-hash loader - _imports-section _tags-section _module-anns-section _defs-section) - _ (if success? - (return nil) - drop-cache!)] - (return cache-table*)) - drop-cache!)))) - -(def ^:private !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] - (fn [_compiler] - (|case ((&&io/read-file source-dirs (str module-name ".lux")) - _compiler) - (&/$Left error) - (return* _compiler cache-table) - - (&/$Right _compiler* file-content) - ((pre-load! source-dirs cache-table module-name (hash file-content)) - _compiler*)))) - {} - fs-cached-modules) - :let [_ (reset! !pre-loaded-cache pre-loaded-modules)]] +;; [Resources] +(defn load-def-value [module name] + (|do [loader &/loader + :let [def-class (&&/load-class! loader (str (&host-generics/->class-name module) "." (&host/def-name name)))]] + (return (get-field &/value-field def-class)))) + +(defn install-all-defs-in-module [module-name] + (|do [!classes &/classes + :let [module-path (str @&&core/!output-dir java.io.File/separator module-name) + file-name+content (for [^File file (seq (.listFiles (new File module-path))) + :when (not (.isDirectory file)) + :let [file-name (.getName file)]] + [(second (re-find #"^(.*)\.class$" file-name)) + (read-file file)]) + _ (doseq [[file-name content] file-name+content] + (swap! !classes assoc (str (&host-generics/->class-name module-name) + "." + file-name) + content))]] + (return (map first file-name+content)))) + +(defn uninstall-all-defs-in-module [module-name] + (|do [!classes &/classes + :let [module-path (str @&&core/!output-dir java.io.File/separator module-name) + installed-files (for [^File file (seq (.listFiles (new File module-path))) + :when (not (.isDirectory file)) + :let [file-name (.getName file)]] + (second (re-find #"^(.*)\.class$" file-name))) + _ (swap! !classes (fn [_classes-dict] + (reduce dissoc _classes-dict installed-files)))]] (return nil))) - -(defn ^:private inject-module - "(-> (Module Compiler) (-> Compiler (Lux Null)))" - [module-name module] - (fn [compiler] - (return* (&/update$ &/$modules - #(&/|put module-name module %) - compiler) - 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)] - (return nil)) - (&/fail (str "[Cache Error] Module is not cached: " module-name)))) |