diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/base.clj | 3 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 61 | ||||
| -rw-r--r-- | src/lux/compiler/cache.clj | 114 |
3 files changed, 87 insertions, 91 deletions
diff --git a/src/lux/base.clj b/src/lux/base.clj index b6aaa57b4..fd8cc2423 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -230,12 +230,9 @@ ;; [Exports] (def ^:const name-field "_name") (def ^:const hash-field "_hash") -(def ^:const type-field "_type") (def ^:const value-field "_value") (def ^:const compiler-field "_compiler") -(def ^:const imports-field "_imports") (def ^:const eval-field "_eval") -(def ^:const tags-field "_tags") (def ^:const module-class-name "_") (def ^:const +name-separator+ ";") diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 71a83b559..e33b833ec 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -209,42 +209,41 @@ (&/exhaust% compiler-step)) (&/set$ &/$source (&reader/from name file-content) state)) (&/$Right ?state _) - (&/run-state (|do [module-anns (&a-module/get-anns name) + (&/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 [^String def-entries (->> defs - (&/|map (fn [_def] - (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def] - (if (= "" ?alias) - (str ?name &&/def-datum-separator (&&&type/serialize-type ?def-type) &&/def-datum-separator (&&&ann/serialize-anns ?def-anns)) - (str ?name &&/def-datum-separator ?alias))))) - (&/|interpose &&/def-entry-separator) - (&/fold str "") - (str (&&&ann/serialize-anns module-anns) &&/section-separator)) - _ (doto =class - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/imports-field "Ljava/lang/String;" nil - (->> imports - (&/|map (fn [import] - (|let [[_module _hash] import] - (str _module &&/field-separator _hash)))) - (&/|interpose &&/entry-separator) - (&/fold str ""))) - .visitEnd) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/tags-field "Ljava/lang/String;" nil - (->> tag-groups - (&/|map (fn [group] - (|let [[type tags] group] - (->> tags (&/|interpose &&/tag-separator) (&/fold str "") - (str type &&/type-separator))))) - (&/|interpose &&/tag-group-separator) - (&/fold str ""))) - .visitEnd) - )] - :let [_ (.visitEnd =class)] + :let [def-entries (->> defs + (&/|map (fn [_def] + (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def] + (if (= "" ?alias) + (str ?name &&/def-datum-separator (&&&type/serialize-type ?def-type) &&/def-datum-separator (&&&ann/serialize-anns ?def-anns)) + (str ?name &&/def-datum-separator ?alias))))) + (&/|interpose &&/def-entry-separator) + (&/fold str "")) + import-entries (->> imports + (&/|map (fn [import] + (|let [[_module _hash] import] + (str _module &&/field-separator _hash)))) + (&/|interpose &&/entry-separator) + (&/fold str "")) + tag-entries (->> tag-groups + (&/|map (fn [group] + (|let [[type tags] group] + (->> tags (&/|interpose &&/tag-separator) (&/fold str "") + (str type &&/type-separator))))) + (&/|interpose &&/tag-group-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 def-entries)] + _ (&&/write-module-descriptor! name module-descriptor)] (return file-hash)) ?state) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index 9de105aa4..92e86dd0c 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -128,63 +128,63 @@ _ (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))) - (let [imports (string/split (get-field &/imports-field module-class) entry-separator-re)] - (|do [loads (&/map% (fn [_import] - (let [[_module _hash] (string/split _import field-separator-re)] - (|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?)) - (let [tag-groups (let [all-tags (get-field &/tags-field module-class)] - (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/create-module module module-hash) - ^String descriptor (&&/read-module-descriptor! module) - :let [[module-anns-section ^String defs-section] (.split descriptor &&/section-separator)] - _ (&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 &&/def-entry-separator))] - _ (&/map% (fn [^String _def-entry] - (let [parts (.split _def-entry &&/def-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-type (&a-module/def-type __module __name) - def-anns (&/|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-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 [^String descriptor (&&/read-module-descriptor! module) + :let [sections (.split descriptor &&/section-separator) + [imports-section tags-section module-anns-section ^String defs-section] sections + imports (string/split imports-section entry-separator-re)] + loads (&/map% (fn [_import] + (let [[_module _hash] (string/split _import field-separator-re)] + (|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 + (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))] + _ (&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 &&/def-entry-separator))] + _ (&/map% (fn [^String _def-entry] + (let [parts (.split _def-entry &&/def-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-type (&a-module/def-type __module __name) + def-anns (&/|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-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)))))) |