diff options
author | Eduardo Julian | 2015-07-25 20:19:43 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-07-25 20:19:43 -0400 |
commit | 4cd9b0c9242f1105e50ad9b42b7f6f5d074f14b4 (patch) | |
tree | d8828396e3f76e5b5dabb1f530234047ec239794 | |
parent | 6c51e5e50aa98bb26a3e2b34f57a0e24f8537d93 (diff) |
- The output directory is now being used as the cache.
- "input" has been renamed as "source" and "output" has been renamed as "target".
-rw-r--r-- | source/lux.lux (renamed from input/lux.lux) | 10 | ||||
-rw-r--r-- | source/lux/codata/stream.lux (renamed from input/lux/codata/stream.lux) | 0 | ||||
-rw-r--r-- | source/lux/control/comonad.lux (renamed from input/lux/control/comonad.lux) | 0 | ||||
-rw-r--r-- | source/lux/control/functor.lux (renamed from input/lux/control/functor.lux) | 0 | ||||
-rw-r--r-- | source/lux/control/lazy.lux (renamed from input/lux/control/lazy.lux) | 0 | ||||
-rw-r--r-- | source/lux/control/monad.lux (renamed from input/lux/control/monad.lux) | 0 | ||||
-rw-r--r-- | source/lux/control/monoid.lux (renamed from input/lux/control/monoid.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/bool.lux (renamed from input/lux/data/bool.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/bounded.lux (renamed from input/lux/data/bounded.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/char.lux (renamed from input/lux/data/char.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/dict.lux (renamed from input/lux/data/dict.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/either.lux (renamed from input/lux/data/either.lux) | 2 | ||||
-rw-r--r-- | source/lux/data/eq.lux (renamed from input/lux/data/eq.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/error.lux (renamed from input/lux/data/error.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/id.lux (renamed from input/lux/data/id.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/io.lux (renamed from input/lux/data/io.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/list.lux (renamed from input/lux/data/list.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/maybe.lux (renamed from input/lux/data/maybe.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/number.lux (renamed from input/lux/data/number.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/ord.lux (renamed from input/lux/data/ord.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/reader.lux (renamed from input/lux/data/reader.lux) | 2 | ||||
-rw-r--r-- | source/lux/data/show.lux (renamed from input/lux/data/show.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/state.lux (renamed from input/lux/data/state.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/text.lux (renamed from input/lux/data/text.lux) | 0 | ||||
-rw-r--r-- | source/lux/data/writer.lux (renamed from input/lux/data/writer.lux) | 0 | ||||
-rw-r--r-- | source/lux/host/java.lux (renamed from input/lux/host/java.lux) | 0 | ||||
-rw-r--r-- | source/lux/math.lux (renamed from input/lux/math.lux) | 0 | ||||
-rw-r--r-- | source/lux/meta/lux.lux (renamed from input/lux/meta/lux.lux) | 0 | ||||
-rw-r--r-- | source/lux/meta/macro.lux (renamed from input/lux/meta/macro.lux) | 0 | ||||
-rw-r--r-- | source/lux/meta/syntax.lux (renamed from input/lux/meta/syntax.lux) | 0 | ||||
-rw-r--r-- | source/program.lux (renamed from input/program.lux) | 2 | ||||
-rw-r--r-- | src/lux.clj | 4 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 6 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 2 | ||||
-rw-r--r-- | src/lux/compiler.clj | 34 | ||||
-rw-r--r-- | src/lux/compiler/base.clj | 144 | ||||
-rw-r--r-- | src/lux/compiler/cache.clj | 135 |
37 files changed, 173 insertions, 168 deletions
diff --git a/input/lux.lux b/source/lux.lux index 61d99396c..50f8f1af2 100644 --- a/input/lux.lux +++ b/source/lux.lux @@ -1880,7 +1880,7 @@ (deftype Referrals (| #All (#Only (List Text)) - (#Except (List Text)) + (#Exclude (List Text)) #Nothing)) (deftype Import @@ -1896,7 +1896,7 @@ (return name) _ - (fail "only/except requires symbols.")))) + (fail "only/exclude requires symbols.")))) defs)) (def (parse-alias tokens) @@ -1921,10 +1921,10 @@ [defs' (extract-defs defs)] (return (: (, Referrals (List Syntax)) [(#Only defs') tokens']))) - (\ (#Meta [_ (#FormS (list& (#Meta [_ (#TagS ["" "except"])]) defs))])) + (\ (#Meta [_ (#FormS (list& (#Meta [_ (#TagS ["" "exclude"])]) defs))])) (do Lux/Monad [defs' (extract-defs defs)] - (return (: (, Referrals (List Syntax)) [(#Except defs') tokens']))) + (return (: (, Referrals (List Syntax)) [(#Exclude defs') tokens']))) _ (fail "Incorrect syntax for referral.")) @@ -2166,7 +2166,7 @@ [*defs (exported-defs m-name)] (;return (filter (is-member? +defs) *defs))) - (#Except -defs) + (#Exclude -defs) (do Lux/Monad [*defs (exported-defs m-name)] (;return (filter (. not (is-member? -defs)) *defs))) diff --git a/input/lux/codata/stream.lux b/source/lux/codata/stream.lux index 1d6dd1b50..1d6dd1b50 100644 --- a/input/lux/codata/stream.lux +++ b/source/lux/codata/stream.lux diff --git a/input/lux/control/comonad.lux b/source/lux/control/comonad.lux index 1830ff44f..1830ff44f 100644 --- a/input/lux/control/comonad.lux +++ b/source/lux/control/comonad.lux diff --git a/input/lux/control/functor.lux b/source/lux/control/functor.lux index 6a9dcfff8..6a9dcfff8 100644 --- a/input/lux/control/functor.lux +++ b/source/lux/control/functor.lux diff --git a/input/lux/control/lazy.lux b/source/lux/control/lazy.lux index 22dac74fe..22dac74fe 100644 --- a/input/lux/control/lazy.lux +++ b/source/lux/control/lazy.lux diff --git a/input/lux/control/monad.lux b/source/lux/control/monad.lux index b5552f987..b5552f987 100644 --- a/input/lux/control/monad.lux +++ b/source/lux/control/monad.lux diff --git a/input/lux/control/monoid.lux b/source/lux/control/monoid.lux index d32baabc5..d32baabc5 100644 --- a/input/lux/control/monoid.lux +++ b/source/lux/control/monoid.lux diff --git a/input/lux/data/bool.lux b/source/lux/data/bool.lux index d4f223612..d4f223612 100644 --- a/input/lux/data/bool.lux +++ b/source/lux/data/bool.lux diff --git a/input/lux/data/bounded.lux b/source/lux/data/bounded.lux index 9d2dabde1..9d2dabde1 100644 --- a/input/lux/data/bounded.lux +++ b/source/lux/data/bounded.lux diff --git a/input/lux/data/char.lux b/source/lux/data/char.lux index 42e57509e..42e57509e 100644 --- a/input/lux/data/char.lux +++ b/source/lux/data/char.lux diff --git a/input/lux/data/dict.lux b/source/lux/data/dict.lux index 63a66d49b..63a66d49b 100644 --- a/input/lux/data/dict.lux +++ b/source/lux/data/dict.lux diff --git a/input/lux/data/either.lux b/source/lux/data/either.lux index 7166688b5..eba6438db 100644 --- a/input/lux/data/either.lux +++ b/source/lux/data/either.lux @@ -7,7 +7,7 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/data (list #refer (#except partition)))) + (lux/data (list #refer (#exclude partition)))) ## [Types] ## (deftype (Either l r) diff --git a/input/lux/data/eq.lux b/source/lux/data/eq.lux index be3400208..be3400208 100644 --- a/input/lux/data/eq.lux +++ b/source/lux/data/eq.lux diff --git a/input/lux/data/error.lux b/source/lux/data/error.lux index cb5c309a6..cb5c309a6 100644 --- a/input/lux/data/error.lux +++ b/source/lux/data/error.lux diff --git a/input/lux/data/id.lux b/source/lux/data/id.lux index 0e3bdbee6..0e3bdbee6 100644 --- a/input/lux/data/id.lux +++ b/source/lux/data/id.lux diff --git a/input/lux/data/io.lux b/source/lux/data/io.lux index c08023df5..c08023df5 100644 --- a/input/lux/data/io.lux +++ b/source/lux/data/io.lux diff --git a/input/lux/data/list.lux b/source/lux/data/list.lux index 450dee275..450dee275 100644 --- a/input/lux/data/list.lux +++ b/source/lux/data/list.lux diff --git a/input/lux/data/maybe.lux b/source/lux/data/maybe.lux index faec53c2e..faec53c2e 100644 --- a/input/lux/data/maybe.lux +++ b/source/lux/data/maybe.lux diff --git a/input/lux/data/number.lux b/source/lux/data/number.lux index 8da674d88..8da674d88 100644 --- a/input/lux/data/number.lux +++ b/source/lux/data/number.lux diff --git a/input/lux/data/ord.lux b/source/lux/data/ord.lux index 80f2e4fb5..80f2e4fb5 100644 --- a/input/lux/data/ord.lux +++ b/source/lux/data/ord.lux diff --git a/input/lux/data/reader.lux b/source/lux/data/reader.lux index c3bbc2830..e91687c3a 100644 --- a/input/lux/data/reader.lux +++ b/source/lux/data/reader.lux @@ -6,7 +6,7 @@ ## the terms of this license. ## You must not remove this notice, or any other, from this software. -(;import (lux #refer (#except Reader)) +(;import (lux #refer (#exclude Reader)) (lux/control (functor #as F #refer #all) (monad #as M #refer #all))) diff --git a/input/lux/data/show.lux b/source/lux/data/show.lux index f4e1cf762..f4e1cf762 100644 --- a/input/lux/data/show.lux +++ b/source/lux/data/show.lux diff --git a/input/lux/data/state.lux b/source/lux/data/state.lux index bc9858a29..bc9858a29 100644 --- a/input/lux/data/state.lux +++ b/source/lux/data/state.lux diff --git a/input/lux/data/text.lux b/source/lux/data/text.lux index a3192a1d5..a3192a1d5 100644 --- a/input/lux/data/text.lux +++ b/source/lux/data/text.lux diff --git a/input/lux/data/writer.lux b/source/lux/data/writer.lux index f71492e35..f71492e35 100644 --- a/input/lux/data/writer.lux +++ b/source/lux/data/writer.lux diff --git a/input/lux/host/java.lux b/source/lux/host/java.lux index 12525d3f2..12525d3f2 100644 --- a/input/lux/host/java.lux +++ b/source/lux/host/java.lux diff --git a/input/lux/math.lux b/source/lux/math.lux index 2e29c5da7..2e29c5da7 100644 --- a/input/lux/math.lux +++ b/source/lux/math.lux diff --git a/input/lux/meta/lux.lux b/source/lux/meta/lux.lux index a28d6e5d4..a28d6e5d4 100644 --- a/input/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux diff --git a/input/lux/meta/macro.lux b/source/lux/meta/macro.lux index 22aeaf874..22aeaf874 100644 --- a/input/lux/meta/macro.lux +++ b/source/lux/meta/macro.lux diff --git a/input/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 1fe85c32f..1fe85c32f 100644 --- a/input/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux diff --git a/input/program.lux b/source/program.lux index 984d8610f..052c0bf41 100644 --- a/input/program.lux +++ b/source/program.lux @@ -36,7 +36,7 @@ (meta lux macro syntax) - math + (math #as m) )) (program args diff --git a/src/lux.clj b/src/lux.clj index 7ff8fda37..9c913c9ac 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -14,9 +14,7 @@ :reload-all)) (defn -main [& _] - (do (time (&compiler/compile-all (&/|list "lux" "program"))) - ;; (prn @&type/counter) - ) + (time (&compiler/compile-all (&/|list "lux" "program"))) (System/exit 0)) (comment diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 68bd627fc..e490bc62f 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -117,9 +117,9 @@ (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] (|do [=classes (&/map% &host/extract-jvm-param ?classes) =return (&host/lookup-static-method ?class ?method =classes) - :let [_ (matchv ::M/objects [=return] - [["lux;DataT" _return-class]] - (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] + ;; :let [_ (matchv ::M/objects [=return] + ;; [["lux;DataT" _return-class]] + ;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] =args (&/map2% (fn [_class _arg] (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg)) =classes diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6acae193f..b25dff9eb 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -394,7 +394,7 @@ (return nil))] (&/save-module (|do [already-compiled? (&&module/exists? ?path) - :let [_ (prn 'analyse-import module-name ?path already-compiled?)] + ;; :let [_ (prn 'analyse-import module-name ?path already-compiled?)] _ (&&module/add-import ?path) _ (&/when% (not already-compiled?) (compile-module ?path))] (return (&/|list)))))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 05ab12bf1..bb1c72f66 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -24,6 +24,7 @@ [lux.analyser.base :as &a] [lux.analyser.module :as &a-module] (lux.compiler [base :as &&] + [cache :as &&cache] [lux :as &&lux] [host :as &&host] [case :as &&case] @@ -369,12 +370,12 @@ return)))) (defn ^:private compile-module [name] - ;; (prn 'compile-module name (&&/cached? name)) - (let [file-name (str "input/" name ".lux") + ;; (prn 'compile-module name (&&cache/cached? name)) + (let [file-name (str &&/input-dir "/" name ".lux") file-content (slurp file-name) file-hash (hash file-content)] - (if (&&/cached? name) - (&&/load-cache name file-hash compile-module) + (if (&&cache/cached? name) + (&&cache/load name file-hash compile-module) (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] (&/map% compile-statement analysis+))] (|do [module-exists? (&a-module/exists? name)] @@ -416,31 +417,16 @@ (fail* ?message))))))) ))) -(defn ^:private clean-file [^java.io.File file] - (if (.isDirectory file) - (do (doseq [f (seq (.listFiles file))] - (clean-file f)) - (.delete file)) - (.delete file))) - -(defn ^:private setup-dirs! [] - (.mkdir (java.io.File. "cache")) - (.mkdir (java.io.File. "cache/jvm")) - (.mkdir (java.io.File. "output")) - (.mkdir (java.io.File. "output/jvm")) - (doseq [f (seq (.listFiles (java.io.File. "output/jvm")))] - (clean-file f))) +(defn ^:private init! [] + (.mkdirs (java.io.File. &&/output-dir))) ;; [Resources] (defn compile-all [modules] - (setup-dirs!) + (init!) (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))] [["lux;Right" [?state _]]] - (println "Compilation complete!") + (do (println "Compilation complete!") + (&&cache/clean ?state)) [["lux;Left" ?message]] (assert false ?message))) - -(comment - (compile-all ["lux"]) - ) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index d3dfc8746..e7b338b16 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -25,43 +25,28 @@ FileOutputStream) (java.lang.reflect Field))) +;; [Constants] +(def ^String version "0.2") +(def ^String input-dir "source") +(def ^String output-dir "target/jvm") + +(def ^String local-prefix "l") +(def ^String partial-prefix "p") +(def ^String closure-prefix "c") +(def ^String apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") + ;; [Utils] (defn ^:private write-file [^String file ^bytes data] (with-open [stream (BufferedOutputStream. (FileOutputStream. file))] (.write stream data))) (defn ^:private write-output [module name data] - (let [module* (&host/->module-class module)] - (.mkdirs (File. (str "output/jvm/" module*))) - (write-file (str "output/jvm/" module* "/" name ".class") data))) - -(defn ^:private write-cache [module name data] - (let [module* (&host/->module-class module)] - (.mkdirs (File. (str "cache/jvm/" module*))) - (write-file (str "cache/jvm/" module* "/" name ".class") data))) - -(defn ^:private clean-file [^File file] - (if (.isDirectory file) - (do (doseq [f (seq (.listFiles file))] - (clean-file f)) - (.delete file)) - (.delete file))) - -(defn ^:private read-file [^File file] - (with-open [reader (io/input-stream file)] - (let [length (.length file) - buffer (byte-array length)] - (.read reader buffer 0 length) - buffer))) + (let [module* (&host/->module-class module) + module-dir (str output-dir "/" module*)] + (.mkdirs (File. module-dir)) + (write-file (str module-dir "/" name ".class") data))) ;; [Exports] -(def version "0.2") - -(def local-prefix "l") -(def partial-prefix "p") -(def closure-prefix "c") -(def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") - (defn load-class! [^ClassLoader loader name] ;; (prn 'load-class! name) (.loadClass loader name)) @@ -75,104 +60,5 @@ _ (swap! !classes assoc real-name bytecode) _ (load-class! loader real-name) _ (when (not eval?) - (do (write-output module name bytecode) - (write-cache module name bytecode)))]] + (write-output module name bytecode))]] (return nil))) - -(defn cached? [module] - (.exists (File. (str "cache/jvm/" (&host/->module-class module) "/_.class")))) - -(defn delete-cache [module] - (fn [state] - (do (clean-file (File. (str "cache/jvm/" (&host/->module-class module)))) - (return* state nil)))) - -(defn ^:private replace-several [content & replacements] - (let [replacement-list (partition 2 replacements)] - (reduce #(try (let [[_pattern _rep] %2] - (string/replace %1 _pattern (string/re-quote-replacement _rep))) - (catch Exception e - (prn 'replace-several content %1 %2) - (throw e))) - content replacement-list))) - -(defn ^:private get-field [^String field-name ^Class class] - (-> class ^Field (.getField field-name) (.get nil)) - ;; (try (-> class ^Field (.getField field-name) (.get nil)) - ;; (catch Error e - ;; (assert false (prn-str 'get-field field-name class)))) - ) - -(defn load-cache [module module-hash compile-module] - (|do [loader &/loader - !classes &/classes - already-loaded? (&a-module/exists? module) - _modules &/modules - :let [redo-cache (|do [_ (delete-cache module) - _ (compile-module module)] - (return false))]] - (do (prn 'load-cache module 'sources already-loaded? - (&/->seq _modules)) - (if already-loaded? - (return true) - (if (cached? module) - (do (prn 'load-cache/HASH module module-hash) - (let [module* (&host/->module-class module) - module-path (str "cache/jvm/" module*) - class-name (str module* "._") - ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (get-field "_hash" module-meta)) - (= version (get-field "_compiler" module-meta))) - (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") - _ (prn 'load-cache/IMPORTS module imports) - ] - (|do [loads (&/map% (fn [_import] - (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) - (if (= [""] imports) - (&/|list) - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :let [file-name (.getName file)] - :when (not= "_.class" file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file) - ;; _ (prn 'load-cache module real-name) - ] - (swap! !classes assoc (str module* "." real-name) bytecode) - (write-output module real-name bytecode))) - (let [defs (string/split (get-field "_defs" module-meta) #"\t")] - ;; (prn 'load-cache module defs) - (|do [_ (&a-module/enter-module module) - _ (&/map% (fn [_def] - (let [[_exported? _name _ann] (string/split _def #" ") - ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) - ] - (|do [_ (case _ann - "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) - "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] - (&a-module/declare-macro module _name)) - "V" (let [def-class (load-class! loader (str module* "." (&/normalize-name _name))) - ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) - def-type (get-field "_meta" def-class)] - (matchv ::M/objects [def-type] - [["lux;ValueD" _def-type]] - (&a-module/define module _name def-type _def-type))) - ;; else - (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] - (|do [__type (&a-module/def-type __module __name)] - (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module _name __module __name __type)))))] - (if (= "1" _exported?) - (&a-module/export module _name) - (return nil))) - )) - (if (= [""] defs) - (&/|list) - (&/->list defs)))] - (return true)))) - redo-cache))) - redo-cache) - )) - redo-cache))))) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj new file mode 100644 index 000000000..d6f0b1db7 --- /dev/null +++ b/src/lux/compiler/cache.clj @@ -0,0 +1,135 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns lux.compiler.cache + (:refer-clojure :exclude [load]) + (:require [clojure.string :as string] + [clojure.java.io :as io] + [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|do return* return fail fail*]] + [type :as &type] + [host :as &host]) + (lux.analyser [base :as &a] + [module :as &a-module]) + (lux.compiler [base :as &&])) + (:import (java.io File + BufferedOutputStream + FileOutputStream) + (java.lang.reflect Field))) + +;; [Utils] +(defn ^:private read-file [^File file] + (with-open [reader (io/input-stream file)] + (let [length (.length file) + buffer (byte-array length)] + (.read reader buffer 0 length) + buffer))) + +(defn ^:private clean-file [^File file] + (if (.isDirectory file) + (do (doseq [f (seq (.listFiles file))] + (clean-file f)) + (.delete file)) + (.delete file))) + +(defn ^:private get-field [^String field-name ^Class class] + (-> class ^Field (.getField field-name) (.get nil))) + +;; [Resources] +(defn cached? [module] + "(-> Text Bool)" + (.exists (new File (str &&/output-dir "/" (&host/->module-class module) "/_.class")))) + +(defn delete [module] + "(-> Text (Lux (,)))" + (fn [state] + (do (clean-file (new File (str &&/output-dir "/" (&host/->module-class module)))) + (return* state nil)))) + +(defn clean [state] + "(-> Compiler (,))" + (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set) + outdated? #(-> % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) + outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))] + (doseq [f outdate-files] + (clean-file f)) + nil)) + +(defn load [module module-hash compile-module] + (|do [loader &/loader + !classes &/classes + already-loaded? (&a-module/exists? module) + _modules &/modules + :let [redo-cache (|do [_ (delete module) + _ (compile-module module)] + (return false))]] + (do ;; (prn 'load module 'sources already-loaded? + ;; (&/->seq _modules)) + (if already-loaded? + (return true) + (if (cached? module) + (do ;; (prn 'load/HASH module module-hash) + (let [module* (&host/->module-class module) + module-path (str &&/output-dir "/" module*) + class-name (str module* "._") + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (&&/load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= &&/version (get-field "_compiler" module-meta))) + (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") + ;; _ (prn 'load/IMPORTS module imports) + ] + (|do [loads (&/map% (fn [_import] + (load _import (-> (str &&/input-dir "/" _import ".lux") slurp hash) compile-module)) + (if (= [""] imports) + (&/|list) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file) + ;; _ (prn 'load module real-name) + ] + (swap! !classes assoc (str module* "." real-name) bytecode))) + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] + ;; (prn 'load module defs) + (|do [_ (&a-module/enter-module module) + _ (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ") + ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) + ] + (|do [_ (case _ann + "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) + "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] + (&a-module/declare-macro module _name)) + "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) + ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) + def-type (get-field "_meta" def-class)] + (matchv ::M/objects [def-type] + [["lux;ValueD" _def-type]] + (&a-module/define module _name def-type _def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (do ;; (prn '__type [__module __name] (&type/show-type __type)) + (&a-module/def-alias module _name __module __name __type)))))] + (if (= "1" _exported?) + (&a-module/export module _name) + (return nil))) + )) + (if (= [""] defs) + (&/|list) + (&/->list defs)))] + (return true)))) + redo-cache))) + redo-cache) + )) + redo-cache))))) |