aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux.clj4
-rw-r--r--src/lux/analyser/host.clj6
-rw-r--r--src/lux/analyser/lux.clj2
-rw-r--r--src/lux/compiler.clj34
-rw-r--r--src/lux/compiler/base.clj144
-rw-r--r--src/lux/compiler/cache.clj135
6 files changed, 165 insertions, 160 deletions
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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 20:26:56 +0000