aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-07-24 23:09:26 -0400
committerEduardo Julian2015-07-24 23:09:26 -0400
commit23b51269d8d0e1d756d019a6bf28ec24b6a507e1 (patch)
tree9a754fef14c5da13a486f37f17e6ec395bed846e
parent1fd2fc0ff67f76177d4addc13faae5d0e95773d3 (diff)
- Removed the "seen-sources" field from the compiler state.
- Fixed the caching mechanism.
Diffstat (limited to '')
-rw-r--r--input/lux.lux36
-rw-r--r--input/lux/meta/lux.lux6
-rw-r--r--src/lux/analyser/lux.clj8
-rw-r--r--src/lux/base.clj18
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/compiler/base.clj140
-rw-r--r--src/lux/type.clj1
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)))