- Refactored caching mechanism.

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)))))