From 6081db0c1d9d9ca140809d9685f26cb2675b0318 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 10 Apr 2016 19:58:05 -0400 Subject: - Improved the loading of classes when testing whether a module is cached. - Fixed a bug in which null-pointers where being compiled, rather than references to the "unit" value. --- src/lux/compiler/cache.clj | 107 +++++++++++++++++++++++---------------------- src/lux/compiler/host.clj | 2 +- 2 files changed, 56 insertions(+), 53 deletions(-) (limited to 'src') diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index 8ae2eb113..8d7b4b55c 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -67,6 +67,15 @@ (clean-file f)) nil)) +(defn ^:private install-all-classes-in-module [!classes module* module-path] + (doseq [^File file (seq (.listFiles (File. module-path))) + :when (not (.isDirectory file)) + :let [file-name (.getName file)] + :when (not= module-class file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file)] + (swap! !classes assoc (str module* "." real-name) bytecode)))) + (let [->regex (fn [text] (re-pattern (java.util.regex.Pattern/quote text))) import-separator-re (->regex &&/import-separator) type-separator-re (->regex &&/type-separator) @@ -88,8 +97,10 @@ (let [module* (&host-generics/->class-name module) module-path (str &&/output-dir "/" module) class-name (str module* "._") + old-classes @!classes ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (&&/load-class! loader class-name))] + (&&/load-class! loader class-name)) + _ (install-all-classes-in-module !classes module* module-path)] (if (and (= module-hash (get-field &/hash-field module-meta)) (= &/compiler-version (get-field &/compiler-field module-meta))) (let [imports (string/split (get-field &/imports-field module-meta) import-separator-re)] @@ -101,57 +112,49 @@ &/$Nil (&/->list imports)))] (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :when (not (.isDirectory file)) - :let [file-name (.getName file)] - :when (not= module-class file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file)] - (swap! !classes assoc (str module* "." real-name) bytecode))) - ;; (doseq [_class-name_ (keys @!classes)] - ;; (&&/load-class! loader _class-name_)) - (let [defs (string/split (get-field &/defs-field module-meta) def-separator-re) - tag-groups (let [all-tags (get-field &/tags-field module-meta)] - (if (= "" all-tags) - &/$Nil - (-> all-tags - (string/split tag-group-separator-re) - (->> (map (fn [_group] - (let [[_type _tags] (string/split _group type-separator-re)] - (&/T [_type (&/->list (string/split (or _tags "") tag-separator-re))]))))) - &/->list)))] - (|do [_ (&a-module/enter-module module) - _ (&/flag-cached-module module) - _ (&a-module/set-imports imports) - _ (&/map% (fn [_def] - (let [[_name _alias] (string/split _def #" ")] - (if (= nil _alias) - (let [def-class (&&/load-class! loader (str module* "." (&host/def-name _name))) - def-meta (get-field &/meta-field def-class) - def-type (|case (&a-meta/meta-get &a-meta/type?-tag def-meta) - (&/$Some (&/$BoolM true)) - &type/Type + (let [defs (string/split (get-field &/defs-field module-meta) def-separator-re) + tag-groups (let [all-tags (get-field &/tags-field module-meta)] + (if (= "" all-tags) + &/$Nil + (-> all-tags + (string/split tag-group-separator-re) + (->> (map (fn [_group] + (let [[_type _tags] (string/split _group type-separator-re)] + (&/T [_type (&/->list (string/split (or _tags "") tag-separator-re))]))))) + &/->list)))] + (|do [_ (&a-module/enter-module module) + _ (&/flag-cached-module module) + _ (&a-module/set-imports imports) + _ (&/map% (fn [_def] + (let [[_name _alias] (string/split _def #" ")] + (if (= nil _alias) + (let [def-class (&&/load-class! loader (str module* "." (&host/def-name _name))) + def-meta (get-field &/meta-field def-class) + def-type (|case (&a-meta/meta-get &a-meta/type?-tag def-meta) + (&/$Some (&/$BoolM true)) + &type/Type - _ - (get-field &/type-field def-class)) - def-value (get-field &/value-field def-class)] - (&a-module/define module _name def-type def-meta def-value)) - (let [[_ __module __name] (re-find #"^(.*);(.*)$" _alias) - def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name))) - def-type (get-field &/type-field def-class) - def-meta (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))])) - def-value (get-field &/value-field def-class)] - (&a-module/define module _name def-type def-meta def-value))) - )) - (if (= [""] defs) - &/$Nil - (&/->list 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 true)))) + _ + (get-field &/type-field def-class)) + def-value (get-field &/value-field def-class)] + (&a-module/define module _name def-type def-meta def-value)) + (let [[_ __module __name] (re-find #"^(.*);(.*)$" _alias) + def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name))) + def-type (get-field &/type-field def-class) + def-meta (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))])) + def-value (get-field &/value-field def-class)] + (&a-module/define module _name def-type def-meta def-value))) + )) + (if (= [""] defs) + &/$Nil + (&/->list 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 true))) redo-cache))) - redo-cache)) + (do (reset! !classes old-classes) + redo-cache))) redo-cache))))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index b94dc0e7c..b9a91b356 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -54,7 +54,7 @@ (defn prepare-return! [^MethodVisitor *writer* *type*] (|case *type* (&/$UnitT) - (.visitInsn *writer* Opcodes/ACONST_NULL) + (.visitLdcInsn *writer* &/unit-tag) (&/$DataT "boolean" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) -- cgit v1.2.3