aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser/lux.clj97
-rw-r--r--luxc/src/lux/base.clj9
-rw-r--r--luxc/src/lux/compiler.clj148
-rw-r--r--luxc/src/lux/compiler/cache.clj170
-rw-r--r--luxc/src/lux/compiler/io.clj15
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)
(&&parallel/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!! (&&parallel/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!! (&&parallel/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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 12:42:45 +0000