aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--luxc/src/lux/base.clj9
-rw-r--r--luxc/src/lux/compiler.clj141
-rw-r--r--luxc/src/lux/compiler/cache.clj129
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!! (&&parallel/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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 21:38:37 +0000