diff options
author | LuxLang | 2017-01-01 05:52:48 -0400 |
---|---|---|
committer | GitHub | 2017-01-01 05:52:48 -0400 |
commit | 0f445bbcb6a20873ecec5b432bbc516eee16f71d (patch) | |
tree | 676b1c1a51656d7c65b2dbfbeb19ff978e2b9efa /luxc/src | |
parent | 00cdab25b25822c3ee08c3cce43dcc05a8b64b5b (diff) | |
parent | 82514275e8cd6adc725a8b1424e470cbf49f5ac9 (diff) |
Merge pull request #22 from LuxLang/preload_cache
Preload cache & re-introduce parallel compilation
Diffstat (limited to 'luxc/src')
-rw-r--r-- | luxc/src/lux/analyser/lux.clj | 97 | ||||
-rw-r--r-- | luxc/src/lux/base.clj | 9 | ||||
-rw-r--r-- | luxc/src/lux/compiler.clj | 148 | ||||
-rw-r--r-- | luxc/src/lux/compiler/cache.clj | 170 | ||||
-rw-r--r-- | luxc/src/lux/compiler/io.clj | 15 |
5 files changed, 237 insertions, 202 deletions
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index fd1944b01..7ca31f322 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -640,65 +640,44 @@ _ (&&module/set-anns ==anns module-name) _imports (&&module/fetch-imports ==anns) current-module &/get-module-name - ;; =asyncs (&/map% (fn [_import] - ;; (|let [[path alias] _import] - ;; (&/without-repl - ;; (&/save-module - ;; (|do [_ (if (= current-module path) - ;; (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path)) - ;; (return nil)) - ;; already-compiled? (&&module/exists? path) - ;; active? (&/active-module? path) - ;; _ (&/assert! (not active?) - ;; (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module)) - ;; _ (&&module/add-import path) - ;; ?async (if (not already-compiled?) - ;; (compile-module path) - ;; (|do [_compiler get-compiler] - ;; (return (doto (promise) - ;; (deliver (&/$Right _compiler)))))) - ;; _ (if (= "" alias) - ;; (return nil) - ;; (&&module/alias current-module alias path))] - ;; (return ?async)))))) - ;; _imports) - ;; _compiler get-compiler - ;; ;; Some type-vars in the typing environment stay in - ;; ;; the environment forever, making type-checking slower. - ;; ;; The merging process for compilers more-or-less "fixes" the - ;; ;; problem by resetting the typing enviroment, but ideally - ;; ;; those type-vars shouldn't survive in the first place. - ;; ;; TODO: MUST FIX - ;; _ (&/fold% (fn [compiler _async] - ;; (|case @_async - ;; (&/$Right _new-compiler) - ;; (set-compiler (merge-compilers current-module _new-compiler compiler)) - - ;; (&/$Left ?error) - ;; (fail ?error))) - ;; _compiler - ;; =asyncs) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - _ (&/map% (fn [_import] - (|let [[path alias] _import] - (&/without-repl - (&/save-module - (|do [_ (if (= current-module path) - (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path)) - (return nil)) - already-compiled? (&&module/exists? path) - active? (&/active-module? path) - _ (&/assert! (not active?) - (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module)) - _ (&&module/add-import path) - _ (if (not already-compiled?) - (compile-module path) - (return nil)) - _ (if (= "" alias) - (return nil) - (&&module/alias current-module alias path))] - (return nil)))))) - _imports)] + =asyncs (&/map% (fn [_import] + (|let [[path alias] _import] + (&/without-repl + (&/save-module + (|do [_ (if (= current-module path) + (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path)) + (return nil)) + already-compiled? (&&module/exists? path) + active? (&/active-module? path) + _ (&/assert! (not active?) + (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module)) + _ (&&module/add-import path) + ?async (if (not already-compiled?) + (compile-module path) + (|do [_compiler get-compiler] + (return (doto (promise) + (deliver (&/$Right _compiler)))))) + _ (if (= "" alias) + (return nil) + (&&module/alias current-module alias path))] + (return ?async)))))) + _imports) + _compiler get-compiler + ;; Some type-vars in the typing environment stay in + ;; the environment forever, making type-checking slower. + ;; The merging process for compilers more-or-less "fixes" the + ;; problem by resetting the typing enviroment, but ideally + ;; those type-vars shouldn't survive in the first place. + ;; TODO: MUST FIX + _ (&/fold% (fn [compiler _async] + (|case @_async + (&/$Right _new-compiler) + (set-compiler (merge-compilers current-module _new-compiler compiler)) + + (&/$Left ?error) + (fail ?error))) + _compiler + =asyncs)] (return &/$Nil))) (defn ^:private coerce [new-type analysis] 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 b9b4e8de0..48c90e759 100644 --- a/luxc/src/lux/compiler.clj +++ b/luxc/src/lux/compiler.clj @@ -127,6 +127,7 @@ [resources-dirs ^String target-dir] (do (reset! &&/!output-dir target-dir) (&¶llel/setup!) + (&&io/init-libs!) (reset! !source->last-line {}) (.mkdirs (new java.io.File target-dir)) (let [class-loader (ClassLoader/getSystemClassLoader) @@ -180,85 +181,84 @@ (let [file-name (str name ".lux")] (|do [file-content (&&io/read-file source-dirs file-name) :let [file-hash (hash file-content) - ;; compile-module!! (&¶llel/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))))))) - )) + compile-module!! (&¶llel/parallel-compilation (partial compile-module source-dirs))]] + (&/|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*] (defn compile-program [mode program-module resources-dir source-dirs target-dir] (do (init! resources-dir target-dir) - (let [m-action (|do [_ (compile-module source-dirs "lux")] + (let [m-action (|do [_ (&&cache/pre-load-cache! source-dirs) + _ (compile-module source-dirs "lux")] (compile-module source-dirs program-module))] (|case (m-action (&/init-state mode)) (&/$Right ?state _) diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 9ba3ac815..726ea784d 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -45,13 +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))) - ;; false - ) + (.exists (new File (str @&&/!output-dir "/" (&host/->module-class module) "/" module-class-file)))) (defn delete [module] "(-> Text (Lux Null))" @@ -84,13 +82,15 @@ nil)) (defn ^:private install-all-classes-in-module [!classes module* ^String 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 [classes+bytecode (for [^File file (seq (.listFiles (File. module-path))) + :when (not (.isDirectory file)) + :let [file-name (.getName file)] + :when (not= module-class-file file-name)] + [(second (re-find #"^(.*)\.class$" file-name)) + (read-file file)]) + _ (doseq [[class-name bytecode] classes+bytecode] + (swap! !classes assoc (str module* "." class-name) bytecode))] + (map first classes+bytecode))) (defn ^:private assume-async-result "(-> (Error Compiler) (Lux Null))" @@ -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 @@ -147,62 +136,125 @@ 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 uninstall-cache [module] + (|do [_ (delete module)] + (return false))) (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] + (|do [:let [[_module _hash] _import] + file-content (&&io/read-file source-dirs (str _module ".lux")) + output (pre-load! source-dirs cache-table* _module (hash file-content))] + (return output))) + 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)) - (redo-cache compile-module module)))) - -(defn load [source-dirs module module-hash compile-module] - "(-> (List Text) Text Int (-> Text (Lux [])) (Lux Bool))" - (|do [already-loaded? (&a-module/exists? module)] - (if already-loaded? - (return nil) - (if (cached? module) + (|do [_ (install-module loader module-name module-hash + imports tag-groups module-anns def-entries) + =module (&/find-module module-name)] + (return (&/T [true (assoc cache-table* module-name =module)])))) + (return (&/T [false cache-table*]))))) + +(defn ^:private enumerate-cached-modules!* [^File parent] + (if (.isDirectory parent) + (let [children (for [^File child (seq (.listFiles parent)) + entry (enumerate-cached-modules!* child)] + entry)] + (if (.exists (new File parent "_.class")) + (list* (.getAbsolutePath parent) + children) + children)) + (list))) + +(defn ^:private enumerate-cached-modules! [] + (let [output-dir (new File @&&/!output-dir) + prefix-to-subtract (inc (.length (.getAbsolutePath output-dir)))] + (->> output-dir + enumerate-cached-modules!* + rest + (map #(.substring ^String % prefix-to-subtract)) + &/->list))) + +(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* "._") - old-classes @!classes - ^Class module-class (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + class-name (str module* "." &/module-class-name) + ^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) - (redo-cache compile-module module)))) - (redo-cache compile-module module))))) + installed-classes (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 [_ (swap! !classes (fn [_classes-dict] + (reduce dissoc _classes-dict installed-classes)))]] + (return cache-table))]] + (if valid-cache? + (|do [[success? cache-table*] (process-module pre-load! source-dirs cache-table module module-hash loader) + _ (if success? + (return nil) + drop-cache!)] + (return cache-table*)) + 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 [_ (reset! !pre-loaded-cache pre-loaded-modules)]] + (return nil))) + +(defn ^:private inject-module + "(-> (Module Compiler) (-> Compiler (Lux Null)))" + [module-name module] + (fn [compiler] + (return* (&/update$ &/$modules + #(&/|put module-name module %) + compiler) + 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)))) diff --git a/luxc/src/lux/compiler/io.clj b/luxc/src/lux/compiler/io.clj index ecb2066cd..179e2a097 100644 --- a/luxc/src/lux/compiler/io.clj +++ b/luxc/src/lux/compiler/io.clj @@ -11,13 +11,10 @@ ;; [Utils] (def ^:private !libs (atom nil)) -(defn ^:private libs-imported? [] - (not (nil? @!libs))) - -(defn ^:private init-libs! [] +;; [Resources] +(defn init-libs! [] (reset! !libs (&lib/load))) -;; [Resources] (defn read-file [source-dirs ^String file-name] (|case (&/|some (fn [source-dir] (let [file (new java.io.File (str source-dir "/" file-name))] @@ -29,8 +26,6 @@ (return (slurp file)) (&/$None) - (do (when (not (libs-imported?)) - (init-libs!)) - (if-let [code (get @!libs file-name)] - (return code) - (fail (str "[I/O Error] File doesn't exist: " file-name)))))) + (if-let [code (get @!libs file-name)] + (return code) + (fail (str "[I/O Error] File doesn't exist: " file-name))))) |