diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser/module.clj | 39 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 17 | ||||
| -rw-r--r-- | src/lux/compiler/base.clj | 4 | ||||
| -rw-r--r-- | src/lux/compiler/cache.clj | 151 | ||||
| -rw-r--r-- | src/lux/repl.clj | 2 |
5 files changed, 114 insertions, 99 deletions
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 4124503bd..dac7a3870 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -17,14 +17,17 @@ ;; [Utils] (deftuple - ["module-aliases" + ["module-hash" + "module-aliases" "defs" "imports" "tags" "types"]) -(def ^:private +init+ - (&/T [;; "lux;module-aliases" +(defn ^:private new-module [hash] + (&/T [;; lux;module-hash + hash + ;; "lux;module-aliases" (&/|table) ;; "lux;defs" (&/|table) @@ -197,21 +200,11 @@ (return true)) (return false)))) -(def imports - (|do [module &/get-module-name] - (fn [state] - (return* state (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $imports)))))) - -(defn create-module [name] - "(-> Text (Lux Null))" - (fn [state] - (return* (&/update$ &/$modules #(&/|put name +init+ %) state) nil))) - -(defn enter-module [name] - "(-> Text (Lux Null))" +(defn create-module [name hash] + "(-> Text Hash-Code (Lux Null))" (fn [state] (return* (->> state - (&/update$ &/$modules #(&/|put name +init+ %)) + (&/update$ &/$modules #(&/|put name (new-module hash) %)) (&/set$ &/$envs (&/|list (&/env name)))) nil))) @@ -225,10 +218,20 @@ state)) )) - tags-by-module $tags "(-> Text (Lux (List (, Text (, Int (List Text) Type)))))" - types-by-module $types "(-> Text (Lux (List (, Text (, (List Text) Type)))))" + tags-by-module $tags "(-> Text (Lux (List (, Text (, Int (List Text) Type)))))" + types-by-module $types "(-> Text (Lux (List (, Text (, (List Text) Type)))))" + module-hash $module-hash "(-> Text (Lux Int))" ) +(def imports + (|do [module &/get-module-name + _imports (fn [state] + (return* state (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $imports))))] + (&/map% (fn [_module] + (|do [_hash (module-hash _module)] + (return (&/T [_module _hash])))) + _imports))) + (defn ensure-undeclared-tags [module tags] (|do [tags-table (tags-by-module module) _ (&/map% (fn [tag] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index a5d7f7115..ef7fe9b1a 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -159,7 +159,7 @@ (if module-exists? (fail "[Compiler Error] Can't redefine a module!") (|do [_ (&&cache/delete name) - _ (&a-module/enter-module name) + _ (&a-module/create-module name file-hash) _ (&/flag-active-module name) :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) @@ -194,7 +194,12 @@ (&/fold str ""))) .visitEnd) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/imports-field "Ljava/lang/String;" nil - (->> imports (&/|interpose &&/import-separator) (&/fold str ""))) + (->> 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 @@ -205,10 +210,10 @@ (&/|interpose &&/tag-group-separator) (&/fold str ""))) .visitEnd) - (.visitEnd)) - ] - _ (&/flag-compiled-module name)] - (&&/save-class! &/module-class-name (.toByteArray =class))) + (.visitEnd))] + _ (&/flag-compiled-module name) + _ (&&/save-class! &/module-class-name (.toByteArray =class))] + (return file-hash)) ?state) (&/$Left ?message) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 5c50191fe..6f3bee1d6 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -44,11 +44,13 @@ (def exported-separator " ") (def def-separator "\t") -(def import-separator "\t") (def tag-separator " ") (def type-separator "\t") (def tag-group-separator "\n") +(def field-separator "\t") +(def entry-separator "\n") + ;; [Utils] (defn ^:private write-file [^String file-name ^bytes data] (do (assert (not (.exists (File. file-name))) (str "Can't overwrite file: " file-name)) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index 27bf56411..e573410d7 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -77,84 +77,89 @@ (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) + entry-separator-re (->regex &&/entry-separator) + field-separator-re (->regex &&/field-separator) type-separator-re (->regex &&/type-separator) tag-separator-re (->regex &&/tag-separator) def-separator-re (->regex &&/def-separator) tag-group-separator-re (->regex &&/tag-group-separator)] (defn load [source-dirs module module-hash compile-module] "(-> (List Text) Text Int (-> Text (Lux (,))) (Lux Bool))" - (|do [loader &/loader - !classes &/classes - already-loaded? (&a-module/exists? module) - _modules &/modules - :let [redo-cache (|do [_ (delete module) - _ (compile-module source-dirs module)] - (return false))]] + (|do [already-loaded? (&a-module/exists? module)] (if already-loaded? - (return true) - (if (cached? module) - (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)) - _ (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)] - (|do [loads (&/map% (fn [_import] - (|do [content (&&io/read-file source-dirs (str _import ".lux")) - _ (load source-dirs _import (hash content) compile-module)] - (&/cached-module? _import))) - (if (= [""] imports) - &/$Nil - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (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) + (return module-hash) + (|let [redo-cache (|do [_ (delete module)] + (compile-module source-dirs 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-meta (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-meta)) + (= &/compiler-version (get-field &/compiler-field module-meta))) + (let [imports (string/split (get-field &/imports-field module-meta) 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 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))) - (do (reset! !classes old-classes) - redo-cache))) - redo-cache))))) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (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/create-module module module-hash) + _ (&/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 module-hash))) + redo-cache))) + (do (reset! !classes old-classes) + redo-cache))) + redo-cache)))))) diff --git a/src/lux/repl.clj b/src/lux/repl.clj index 0c4202650..0ffbdc1af 100644 --- a/src/lux/repl.clj +++ b/src/lux/repl.clj @@ -22,7 +22,7 @@ (defn ^:private init [] (do (&compiler/init!) (|case ((|do [_ (&compiler/compile-module "lux")] - (&module/enter-module repl-module)) + (&module/create-module repl-module 0)) (&/init-state &/$Debug)) (&/$Right ?state _) (do (println) |