From 58f274ae34835d27cd17add767f6fbef13aef7c5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 19 Feb 2017 23:44:03 -0400 Subject: - Separated the platform-independent and platform-dependent components of the caching mechanism. --- luxc/src/lux/compiler/cache.clj | 230 +++++++++++++++++++++++++++++++ luxc/src/lux/compiler/jvm.clj | 10 +- luxc/src/lux/compiler/jvm/cache.clj | 263 +++++------------------------------- luxc/src/lux/repl.clj | 8 +- 4 files changed, 273 insertions(+), 238 deletions(-) create mode 100644 luxc/src/lux/compiler/cache.clj diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj new file mode 100644 index 000000000..09b688832 --- /dev/null +++ b/luxc/src/lux/compiler/cache.clj @@ -0,0 +1,230 @@ +(ns lux.compiler.cache + (:refer-clojure :exclude [load]) + (:require [clojure.string :as string] + [clojure.java.io :as io] + clojure.core.match + clojure.core.match.array + (lux [base :as & :refer [|do return* return |case |let]] + [type :as &type] + [host :as &host]) + (lux.analyser [base :as &a] + [module :as &a-module] + [meta :as &a-meta]) + (lux.compiler [core :as &&core] + [io :as &&io]) + (lux.compiler.cache [type :as &&&type] + [ann :as &&&ann])) + (:import (java.io File) + )) + +;; [Resources] +(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 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 [load-def-value 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-anns (&/|list (&/T [&a-meta/alias-tag (&/$IdentA (&/T [__module __name]))]))] + (|do [def-type (&a-module/def-type __module __name) + def-value (load-def-value __module __name)] + (&a-module/define module _name def-type def-anns def-value))) + 3 (let [[_name _type _anns] parts + def-anns (&&&ann/deserialize-anns _anns) + [def-type _] (&&&type/deserialize-type _type)] + (|do [def-value (load-def-value module _name)] + (&a-module/define module _name def-type def-anns def-value)))))) + +(defn ^:private uninstall-cache [module] + (|do [_ (delete module)] + (return false))) + +(defn ^:private install-module [load-def-value 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 load-def-value 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 + _imports-section _tags-section _module-anns-section _defs-section + load-def-value install-all-defs-in-module uninstall-all-defs-in-module] + (|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) + load-def-value install-all-defs-in-module uninstall-all-defs-in-module)] + (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 load-def-value 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 + load-def-value install-all-defs-in-module uninstall-all-defs-in-module] + (cond (contains? cache-table module-name) + (return cache-table) + + (not (cached? module-name)) + (return cache-table) + + :else + (|do [^String descriptor (&&core/read-module-descriptor! module-name) + installed-classes (install-all-defs-in-module module-name) + :let [[_compiler _hash _imports-section _tags-section _module-anns-section _defs-section] (.split descriptor &&core/section-separator) + drop-cache! (|do [_ (uninstall-cache module-name) + _ (uninstall-all-defs-in-module module-name)] + (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 + _imports-section _tags-section _module-anns-section _defs-section + load-def-value install-all-defs-in-module uninstall-all-defs-in-module) + _ (if success? + (return nil) + drop-cache!)] + (return cache-table*)) + drop-cache!)))) + +(def ^:private !pre-loaded-cache (atom nil)) +(defn pre-load-cache! [source-dirs + load-def-value install-all-defs-in-module uninstall-all-defs-in-module] + (|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) + load-def-value install-all-defs-in-module uninstall-all-defs-in-module) + _compiler*)))) + {} + fs-cached-modules) + :let [_ (reset! !pre-loaded-cache pre-loaded-modules)]] + (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)))) diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj index 68dcb0306..f09224c90 100644 --- a/luxc/src/lux/compiler/jvm.clj +++ b/luxc/src/lux/compiler/jvm.clj @@ -19,13 +19,14 @@ [lux.analyser.module :as &a-module] (lux.compiler [core :as &&core] [io :as &&io] + [cache :as &&cache] [parallel :as &¶llel]) (lux.compiler.jvm [base :as &&] - [cache :as &&cache] [lux :as &&lux] [case :as &&case] [lambda :as &&lambda] - [rt :as &&rt]) + [rt :as &&rt] + [cache :as &&jvm-cache]) (lux.compiler.jvm.proc [common :as &&proc-common] [host :as &&proc-host])) (:import (org.objectweb.asm Opcodes @@ -243,7 +244,10 @@ (let [!err! *err*] (defn compile-program [mode program-module resources-dir source-dirs target-dir] - (let [m-action (|do [_ (&&cache/pre-load-cache! source-dirs) + (let [m-action (|do [_ (&&cache/pre-load-cache! source-dirs + &&jvm-cache/load-def-value + &&jvm-cache/install-all-defs-in-module + &&jvm-cache/uninstall-all-defs-in-module) _ (compile-module source-dirs "lux")] (compile-module source-dirs program-module))] (|case (m-action (&/init-state mode (jvm-host))) 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)))) diff --git a/luxc/src/lux/repl.clj b/luxc/src/lux/repl.clj index 7562aaf70..974267486 100644 --- a/luxc/src/lux/repl.clj +++ b/luxc/src/lux/repl.clj @@ -6,10 +6,10 @@ [analyser :as &analyser] [optimizer :as &optimizer] [compiler :as &compiler]) - [lux.compiler.jvm.cache :as &cache] - [lux.analyser.base :as &a-base] - [lux.analyser.lux :as &a-lux] - [lux.analyser.module :as &module]) + [lux.compiler.cache :as &cache] + (lux.analyser [base :as &a-base] + [lux :as &a-lux] + [module :as &module])) (:import (java.io InputStreamReader BufferedReader))) -- cgit v1.2.3