diff options
| -rw-r--r-- | input/lux.lux | 36 | ||||
| -rw-r--r-- | input/lux/meta/lux.lux | 6 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 8 | ||||
| -rw-r--r-- | src/lux/base.clj | 18 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/base.clj | 140 | ||||
| -rw-r--r-- | src/lux/type.clj | 1 |
7 files changed, 102 insertions, 109 deletions
diff --git a/input/lux.lux b/input/lux.lux index 7ba6cef76..3bd4d58d0 100644 --- a/input/lux.lux +++ b/input/lux.lux @@ -267,7 +267,6 @@ ## #types (Bindings Int Type) ## #host HostState ## #seed Int -## #seen-sources (List Text) ## #eval? Bool)) (_lux_def Compiler (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" @@ -280,9 +279,8 @@ (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] (#Cons [["lux;host" HostState] (#Cons [["lux;seed" Int] - (#Cons [["lux;seen-sources" (#AppT [List Text])] - (#Cons [["lux;eval?" Bool] - #Nil])])])])])])])]))]) + (#Cons [["lux;eval?" Bool] + #Nil])])])])])])]))]) Void])) (_lux_export Compiler) @@ -1299,7 +1297,7 @@ (_lux_case state {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} + #seed seed #eval? eval?} (_lux_case (reverse envs) #Nil (#Left "Can't get the module name without a module!") @@ -1338,7 +1336,7 @@ (_lux_case state {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} + #seed seed #eval? eval?} (#Right [state (find-macro' modules current-module module name)])))))) (def'' (list:join xs) @@ -1396,7 +1394,7 @@ (as-pairs tokens))] (;return (list (`' (#;RecordT (~ (untemplate-list pairs))))))))) -(def'' (->text x) +(def'' #export (->text x) (-> (^ java.lang.Object) Text) (_jvm_invokevirtual java.lang.Object toString [] x [])) @@ -1735,10 +1733,10 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} + #seed seed #eval? eval?} (#Right [{#source source #modules modules #envs envs #types types #host host - #seed (inc seed) #seen-sources seen-sources #eval? eval?} + #seed (inc seed) #eval? eval?} (symbol$ ["__gensym__" (->text seed)])]))) (def (macro-expand-1 token) @@ -1986,7 +1984,7 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} + #seed seed #eval? eval?} (case (get module modules) (#Some =module) (#Right [state true]) @@ -2000,7 +1998,7 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} + #seed seed #eval? eval?} (case (get module modules) (#Some =module) (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))) @@ -2190,9 +2188,13 @@ _ (;return (: (List Syntax) (list:++ (map (lambda [m-name] - (` (_lux_import (~ (text$ m-name))))) + (exec (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object] + (_jvm_getstatic java.lang.System out) [($ text:++ "lux;import " m-name "\n")]) + (` (_lux_import (~ (text$ m-name)))))) unknowns) - (list (` (import (~@ tokens)))))))))) + (exec (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object] + (_jvm_getstatic java.lang.System out) ["\n"]) + (list (` (import (~@ tokens))))))))))) (def (some f xs) (All [a b] @@ -2399,7 +2401,7 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} + #seed seed #eval? eval?} (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) (lambda [env] (case env @@ -2449,7 +2451,7 @@ (let [[v-prefix v-name] name {#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} state] + #seed seed #eval? eval?} state] (case (get v-prefix modules) #None #None @@ -2472,7 +2474,7 @@ ## (let [[v-prefix v-name] name ## {#source source #modules modules ## #envs envs #types types #host host -## #seed seed #seen-sources seen-sources #eval? eval?} state] +## #seed seed #eval? eval?} state] ## (do Maybe/Monad ## [module (get v-prefix modules) ## #let [{#defs defs #module-aliases _ #imports _} module] @@ -2501,7 +2503,7 @@ _ (let [{#source source #modules modules #envs envs #types types #host host - #seed seed #seen-sources seen-sources #eval? eval?} state] + #seed seed #eval? eval?} state] (#Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs))))))))) (defmacro #export (using tokens) diff --git a/input/lux/meta/lux.lux b/input/lux/meta/lux.lux index db3c700e6..a28d6e5d4 100644 --- a/input/lux/meta/lux.lux +++ b/input/lux/meta/lux.lux @@ -227,7 +227,7 @@ (case state {#;source source #;modules modules #;envs envs #;types types #;host host - #;seed seed #;seen-sources seen-sources #;eval? eval?} + #;seed seed #;eval? eval?} (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) (lambda [env] (case env @@ -247,7 +247,7 @@ (let [[v-prefix v-name] name {#;source source #;modules modules #;envs envs #;types types #;host host - #;seed seed #;seen-sources seen-sources #;eval? eval?} state] + #;seed seed #;eval? eval?} state] (case (get v-prefix modules) #;None #;None @@ -282,6 +282,6 @@ _ (let [{#;source source #;modules modules #;envs envs #;types types #;host host - #;seed seed #;seen-sources seen-sources #;eval? eval?} state] + #;seed seed #;eval? eval?} state] (#;Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs)))))))) )) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 72923c43e..6acae193f 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -393,12 +393,10 @@ (fail (str "[Analyser Error] Module can't import itself: " ?path)) (return nil))] (&/save-module - (|do [already-compiled? (&/source-seen? ?path) - :let [must-compile? (not already-compiled?) - _ (prn 'analyse-import module-name ?path already-compiled?)] - _ (&/when% must-compile? (&/see-source ?path)) + (|do [already-compiled? (&&module/exists? ?path) + :let [_ (prn 'analyse-import module-name ?path already-compiled?)] _ (&&module/add-import ?path) - _ (&/when% must-compile? (compile-module ?path))] + _ (&/when% (not already-compiled?) (compile-module ?path))] (return (&/|list)))))) (defn analyse-export [analyse name] diff --git a/src/lux/base.clj b/src/lux/base.clj index 7b1e7139e..f88ca560e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -33,9 +33,8 @@ (def $HOST 2) (def $MODULES 3) (def $SEED 4) -(def $SEEN-SOURCES 5) -(def $SOURCE 6) -(def $TYPES 7) +(def $SOURCE 5) +(def $TYPES 6) ;; [Exports] (def +name-separator+ ";") @@ -491,8 +490,6 @@ (|table) ;; "lux;seed" 0 - ;; "lux;seen-sources" - (|list) ;; "lux;source" (V "lux;None" nil) ;; "lux;types" @@ -711,15 +708,10 @@ (defn enumerate [xs] (enumerate* 0 xs)) -(defn source-seen? [path] - "(-> Text (Lux Bool))" - (fn [state] - (return* state (fold #(or %1 (= %2 path)) false (get$ $SEEN-SOURCES state))))) - -(defn see-source [path] - "(-> Text (Lux (,)))" +(def modules + "(Lux (List Text))" (fn [state] - (return* (update$ $SEEN-SOURCES (partial |cons path) state) nil))) + (return* state (|keys (get$ $MODULES state))))) (defn when% [test body] "(-> Bool (Lux (,)) (Lux (,)))" diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index fbf8afb89..9ecdcc6ad 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -369,7 +369,7 @@ return)))) (defn ^:private compile-module [name] - ;; (prn 'compile-module name) + (prn 'compile-module name (&&/cached? name)) (if (&&/cached? name) (do ;; (println "YOLO") (let [file-name (str "input/" name ".lux") diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 89303c48d..a9abe44fc 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -133,75 +133,77 @@ (defn load-cache [module module-hash compile-module] (|do [loader &/loader !classes &/classes - already-loaded? (&/source-seen? module) + already-loaded? (&a-module/exists? module) + _modules &/modules :let [redo-cache (|do [_ (delete-cache module) _ (compile-module module)] (return false))]] - (if already-loaded? - (return true) - (if (cached? module) - (do (prn 'load-cache module module-hash) - (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) - module* (string/replace 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 module 'imports 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* "." (replace-cache real-name)) bytecode) - (swap! !classes assoc (str module* "." real-name) bytecode) - ;; (swap! !classes assoc "__temp__" bytecode) - ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) - (write-output module real-name bytecode))) - ;; (swap! !classes dissoc "__temp__") - (let [defs (string/split (get-field "_defs" module-meta) #"\t")] - ;; (prn 'load-cache module defs) - (|do [_ (&/see-source module) - _ (&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-ident _name))) - ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _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)))) + (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-path (str "cache/jvm/" (string/replace module #"/" " ")) + module* (string/replace 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* "." (replace-cache real-name)) bytecode) + (swap! !classes assoc (str module* "." real-name) bytecode) + ;; (swap! !classes assoc "__temp__" bytecode) + ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) + (write-output module real-name bytecode))) + ;; (swap! !classes dissoc "__temp__") + (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-ident _name))) + ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _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/type.clj b/src/lux/type.clj index 77fc6a2f8..14e87e063 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -177,7 +177,6 @@ (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) (&/T "lux;seed" Int) - (&/T "lux;seen-sources" (&/V "lux;AppT" (&/T List Text))) (&/T "lux;eval?" Bool)))) $Void))) |