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