aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj10
-rw-r--r--src/lux/analyser/host.clj2
-rw-r--r--src/lux/analyser/lux.clj128
-rw-r--r--src/lux/analyser/module.clj82
-rw-r--r--src/lux/base.clj37
-rw-r--r--src/lux/compiler.clj165
-rw-r--r--src/lux/compiler/base.clj184
-rw-r--r--src/lux/compiler/host.clj76
-rw-r--r--src/lux/compiler/lambda.clj5
-rw-r--r--src/lux/compiler/lux.clj12
-rw-r--r--src/lux/reader.clj2
-rw-r--r--src/lux/type.clj3
12 files changed, 466 insertions, 240 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 4cb1a4900..039db810a 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -108,7 +108,7 @@
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]
- (&&lux/analyse-coerce analyse eval! ?type ?value)
+ (&&lux/analyse-coerce analyse eval! exo-type ?type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]]
@@ -459,7 +459,7 @@
(if (.startsWith msg "@")
msg
(|let [[file line col] meta]
- (str "@ " file " : " line " , " col "\n" msg))))
+ (str "@ " file "," line "," col "\n" msg))))
(defn ^:private analyse-basic-ast [analyse eval! compile-module exo-type token]
;; (prn 'analyse-basic-ast (&/show-ast token))
@@ -519,7 +519,8 @@
(fail* (add-loc meta msg)))
[["lux;Left" msg]]
- (fail* (add-loc meta msg))))))
+ (fail* (add-loc meta msg))
+ ))))
(defn ^:private analyse-ast [eval! compile-module exo-type token]
(matchv ::M/objects [token]
@@ -531,7 +532,8 @@
(fn [state]
(matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)]
[["lux;Right" [state* =fn]]]
- ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*)
+ (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0))
+ ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*))
[_]
((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 1aa683ea6..b9361b8c3 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -353,6 +353,6 @@
(defn analyse-jvm-program [analyse ?args ?body]
(|do [=body (&/with-scope ""
- (&&env/with-local "" (&/V "lux;AppT" (&/T &type/List &type/Text))
+ (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text))
(&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))]
(return (&/|list (&/V "jvm-program" =body)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 242539b65..90811c77e 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -103,6 +103,7 @@
(|do [module-name &/get-module-name]
(fn [state]
(|let [[?module ?name] ident
+ ;; _ (prn 'analyse-symbol/_0 ?module ?name)
local-ident (str ?module ";" ?name)
stack (&/get$ &/$ENVS state)
no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)
@@ -110,67 +111,77 @@
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
- ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
- ?name)
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" ?type]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
- (clojure.lang.Util/identical &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state)
+ (do ;; (prn 'analyse-symbol/_1
+ ;; [?module ?name]
+ ;; [(if (.equals "" ?module) module-name ?module)
+ ;; ?name])
+ ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
+ ?name)
+ ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type))))
+ state))
[["lux;Cons" [?genv ["lux;Nil" _]]]]
- (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
- (matchv ::M/objects [global]
- [[["lux;Global" [?module* ?name*]] _]]
- ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" ?type]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
- (clojure.lang.Util/identical &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state)
-
- [_]
- (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))
- (fail* "_{_ analyse-symbol _}_"))
-
+ (do ;; (prn 'analyse-symbol/_2 ?module ?name local-ident (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
+ (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
+ (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0))
+ (matchv ::M/objects [global]
+ [[["lux;Global" [?module* ?name*]] _]]
+ ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
+ ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type))))
+ state)
+
+ [_]
+ (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident)
+ (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
+ (fail* "_{_ analyse-symbol _}_")))
+
[["lux;Cons" [top-outer _]]]
- (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
- (&/|map #(&/get$ &/$NAME %) outer)
- (&/|reverse inner)))
- [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
- (|let [[register new-inner] register+new-inner
- [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)]
- (&/T register* (&/|cons frame* new-inner))))
- (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))
- (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
- (&/|list))
- (&/|reverse inner) scopes)]
- ((|do [btype (&&/expr-type =local)
- _ (&type/check exo-type btype)]
- (return (&/|list =local)))
- (&/set$ &/$ENVS (&/|++ inner* outer) state)))
+ (do ;; (prn 'analyse-symbol/_3 ?module ?name)
+ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
+ (&/|map #(&/get$ &/$NAME %) outer)
+ (&/|reverse inner)))
+ [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
+ (|let [[register new-inner] register+new-inner
+ [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)]
+ (&/T register* (&/|cons frame* new-inner))))
+ (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))
+ (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
+ (&/|list))
+ (&/|reverse inner) scopes)]
+ ((|do [btype (&&/expr-type =local)
+ _ (&type/check exo-type btype)]
+ (return (&/|list =local)))
+ (&/set$ &/$ENVS (&/|++ inner* outer) state))))
)))
))
@@ -345,6 +356,7 @@
(defn analyse-coerce [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
+ _ (&type/check exo-type ==type)
=value (&&/analyse-1 analyse ==type ?value)]
(return (&/|list (&/T (&/V "ann" (&/T =value =type))
==type)))))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 1fd96ce0a..f0e5b82b4 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -56,9 +56,31 @@
nil)
[_]
- (fail* "[Analyser Error] Can't create a new global definition outside of a global environment."))))
+ (fail* (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name)))))
+
+(defn def-type [module name]
+ "(-> Text Text (Lux Type))"
+ (fn [state]
+ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
+ (matchv ::M/objects [$def]
+ [["lux;TypeD" _]]
+ (return* state &type/Type)
+
+ [["lux;MacroD" _]]
+ (return* state &type/Macro)
+
+ [["lux;ValueD" _type]]
+ (return* state _type)
+
+ [["lux;AliasD" [?r-module ?r-name]]]
+ (&/run-state (def-type ?r-module ?r-name)
+ state))
+ (fail* (str "[Analyser Error] Unknown definition: " (str module ";" name))))
+ (fail* (str "[Analyser Error] Unknown module: " module)))))
(defn def-alias [a-module a-name r-module r-name type]
+ ;; (prn 'def-alias [a-module a-name] [r-module r-name] (&type/show-type type))
(fn [state]
(matchv ::M/objects [(&/get$ &/$ENVS state)]
[["lux;Cons" [?env ["lux;Nil" _]]]]
@@ -75,6 +97,7 @@
(&/update$ &/$MAPPINGS (fn [mappings]
(&/|put (str "" &/+name-separator+ a-name)
(&/T (&/V "lux;Global" (&/T r-module r-name)) type)
+ ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1)
mappings))
locals))
?env))))
@@ -112,20 +135,24 @@
(defn find-def [module name]
(|do [current-module &/get-module-name]
(fn [state]
+ ;; (prn 'find-def/_0 module name 'current-module current-module)
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
- (if-let [$def (&/|get name $module)]
- (matchv ::M/objects [$def]
- [[exported? $$def]]
- (if (or exported? (.equals ^Object current-module module))
- (matchv ::M/objects [$$def]
- [["lux;AliasD" [?r-module ?r-name]]]
- ((find-def ?r-module ?r-name)
- state)
-
- [_]
- (return* state (&/T (&/T module name) $$def)))
- (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))))
- (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
+ (do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module)))
+ (if-let [$def (&/|get name $module)]
+ (matchv ::M/objects [$def]
+ [[exported? $$def]]
+ (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module))
+ (if (or exported? (.equals ^Object current-module module))
+ (matchv ::M/objects [$$def]
+ [["lux;AliasD" [?r-module ?r-name]]]
+ (do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name])
+ ((find-def ?r-module ?r-name)
+ state))
+
+ [_]
+ (return* state (&/T (&/T module name) $$def)))
+ (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))))
+ (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))))
(do (prn [module name]
(str "[Analyser Error] Module doesn't exist: " module)
(->> state (&/get$ &/$MODULES) &/|keys &/->seq))
@@ -144,7 +171,7 @@
[[exported? ["lux;ValueD" ?type]]]
((|do [_ (&type/check &type/Macro ?type)
^ClassLoader loader &/loader
- :let [macro (-> (.loadClass loader (&host/location (&/|list module name)))
+ :let [macro (-> (.loadClass loader (str module ".$" (&/normalize-ident name)))
(.getField "_datum")
(.get nil))]]
(fn [state*]
@@ -199,18 +226,19 @@
(|let [[k v] kv]
(matchv ::M/objects [v]
[[?exported? ?def]]
- (matchv ::M/objects [?def]
- [["lux;AliasD" [?r-module ?r-name]]]
- (&/T ?exported? k (str "A" ?r-module ";" ?r-name))
-
- [["lux;MacroD" _]]
- (&/T ?exported? k "M")
-
- [["lux;TypeD" _]]
- (&/T ?exported? k "T")
-
- [_]
- (&/T ?exported? k "V")))))
+ (do ;; (prn 'defs k ?exported?)
+ (matchv ::M/objects [?def]
+ [["lux;AliasD" [?r-module ?r-name]]]
+ (&/T ?exported? k (str "A" ?r-module ";" ?r-name))
+
+ [["lux;MacroD" _]]
+ (&/T ?exported? k "M")
+
+ [["lux;TypeD" _]]
+ (&/T ?exported? k "T")
+
+ [_]
+ (&/T ?exported? k "V"))))))
(->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS)))))))
(def imports
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 657ebd51e..aecb3fd13 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -21,12 +21,13 @@
;; CompilerState
(def $ENVS 0)
-(def $HOST 1)
-(def $MODULES 2)
-(def $SEED 3)
-(def $SEEN-SOURCES 4)
-(def $SOURCE 5)
-(def $TYPES 6)
+(def $EVAL? 1)
+(def $HOST 2)
+(def $MODULES 3)
+(def $SEED 4)
+(def $SEEN-SOURCES 5)
+(def $SOURCE 6)
+(def $TYPES 7)
;; [Exports]
(def +name-separator+ ";")
@@ -413,6 +414,7 @@
\< "_LT_"
\> "_GT_"
\~ "_TILDE_"
+ \| "_PIPE_"
;; default
char))
@@ -456,7 +458,8 @@
;; (prn 'findClass class-name)
(if-let [^bytes bytecode (get @store class-name)]
(.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
- (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
+ (do (prn 'memory-class-loader/store (keys @store))
+ (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))))
(defn host [_]
(let [store (atom {})]
@@ -471,6 +474,8 @@
(defn init-state [_]
(R ;; "lux;envs"
(|list)
+ ;; "lux;eval?"
+ false
;; "lux;host"
(host nil)
;; "lux;modules"
@@ -485,6 +490,19 @@
+init-bindings+
))
+(defn with-eval [body]
+ (fn [state]
+ (matchv ::M/objects [(body (set$ $EVAL? true state))]
+ [["lux;Right" [state* output]]]
+ (return* (set$ $EVAL? (get$ $EVAL? state) state*) output)
+
+ [["lux;Left" msg]]
+ (fail* msg))))
+
+(def get-eval
+ (fn [state]
+ (return* state (get$ $EVAL? state))))
+
(def get-writer
(fn [state]
(let [writer* (->> state (get$ $HOST) (get$ $WRITER))]
@@ -557,9 +575,8 @@
state))))))
(def get-scope-name
- (|do [module-name get-module-name]
- (fn [state]
- (return* state (->> state (get$ $ENVS) (|map #(get$ $NAME %)) |reverse (|cons module-name))))))
+ (fn [state]
+ (return* state (->> state (get$ $ENVS) (|map #(get$ $NAME %)) |reverse))))
(defn with-writer [writer body]
(fn [state]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 90a382ed5..d88c33437 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -25,9 +25,6 @@
ClassWriter
MethodVisitor)))
-;; [Constants]
-(def ^:private version "0.2")
-
;; [Utils/Compilers]
(defn ^:private compile-expression [syntax]
(matchv ::M/objects [syntax]
@@ -321,80 +318,104 @@
(&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)))
(defn ^:private eval! [expr]
- (|do [id &/gen-id
- :let [class-name (str id)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- class-name nil "java/lang/Object" nil)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil)
- (doto (.visitEnd))))]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
- (|do [^MethodVisitor *writer* &/get-writer
- :let [_ (.visitCode *writer*)]
- _ (compile-expression expr)
- :let [_ (doto *writer*
- (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;")
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
- :let [bytecode (.toByteArray (doto =class
- .visitEnd))]
- _ (&&/save-class! class-name bytecode)
- loader &/loader]
- (-> (.loadClass ^ClassLoader loader class-name)
- (.getField "_eval")
- (.get nil)
- return)))
+ (&/with-eval
+ (|do [module &/get-module-name
+ id &/gen-id
+ :let [class-name (str module "/" id)
+ ;; _ (prn 'eval! id class-name)
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ class-name nil "java/lang/Object" nil)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil)
+ (doto (.visitEnd))))]
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+ (|do [^MethodVisitor *writer* &/get-writer
+ :let [_ (.visitCode *writer*)]
+ _ (compile-expression expr)
+ :let [_ (doto *writer*
+ (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;")
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))
+ :let [bytecode (.toByteArray (doto =class
+ .visitEnd))]
+ _ (&&/save-class! (str id) bytecode)
+ loader &/loader]
+ (-> (.loadClass ^ClassLoader loader (str module "." id))
+ (.getField "_eval")
+ (.get nil)
+ return))))
(defn ^:private compile-module [name]
- (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)]
- (&/map% compile-statement analysis+))]
- (fn [state]
- (if (->> state (&/get$ &/$MODULES) (&/|contains? name))
- (if (.equals ^Object name "lux")
- (return* state nil)
- (fail* "[Compiler Error] Can't redefine a module!"))
- (let [file-name (str "source/" name ".lux")
- file-content (slurp file-name)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- (&host/->class name) nil "java/lang/Object" nil)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil version)
- .visitEnd))]
- (matchv ::M/objects [((&/exhaust% compiler-step)
- (->> state
- (&/set$ &/$SOURCE (&reader/from file-name file-content))
- (&/set$ &/$ENVS (&/|list (&/env name)))
- (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
- (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))]
- [["lux;Right" [?state _]]]
- (&/run-state (|do [defs &a-module/defs
- imports &a-module/imports
- :let [_ (doto =class
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil
- (->> defs
- (&/|map (fn [_def]
- (|let [[?exported ?name ?ann] _def]
- (str (if ?exported "1" "0") " " ?name " " ?ann))))
- (&/|interpose "\t")
- (&/fold str "")))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
- (->> imports (&/|interpose ";") (&/fold str "")))
- .visitEnd)
- (.visitEnd))]]
- (&&/save-class! name (.toByteArray =class)))
- ?state)
-
- [["lux;Left" ?message]]
- (fail* ?message)))))))
+ ;; (prn 'compile-module name)
+ (if (&&/cached? name)
+ (do ;; (println "YOLO")
+ (let [file-name (str "input/" name ".lux")
+ file-content (slurp file-name)]
+ (&&/load-cache name (hash file-content) compile-module)))
+ (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)]
+ (&/map% compile-statement analysis+))]
+ (fn [state]
+ (if (->> state (&/get$ &/$MODULES) (&/|contains? name))
+ (if (.equals ^Object name "lux")
+ (return* state nil)
+ (fail* "[Compiler Error] Can't redefine a module!"))
+ (let [file-name (str "input/" name ".lux")
+ file-content (slurp file-name)
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (str name "/_") nil "java/lang/Object" nil)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content))
+ .visitEnd)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
+ .visitEnd))]
+ (matchv ::M/objects [((&/exhaust% compiler-step)
+ (->> state
+ (&/set$ &/$SOURCE (&reader/from file-name file-content))
+ (&/set$ &/$ENVS (&/|list (&/env name)))
+ (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
+ (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))]
+ [["lux;Right" [?state _]]]
+ (&/run-state (|do [defs &a-module/defs
+ imports &a-module/imports
+ :let [_ (doto =class
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil
+ (->> defs
+ (&/|map (fn [_def]
+ (|let [[?exported ?name ?ann] _def]
+ (str (if ?exported "1" "0") " " ?name " " ?ann))))
+ (&/|interpose "\t")
+ (&/fold str "")))
+ .visitEnd)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
+ (->> imports (&/|interpose "\t") (&/fold str "")))
+ .visitEnd)
+ (.visitEnd))]]
+ (&&/save-class! "_" (.toByteArray =class)))
+ ?state)
+
+ [["lux;Left" ?message]]
+ (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)))
;; [Resources]
(defn compile-all [modules]
- (.mkdir (java.io.File. "output"))
+ (setup-dirs!)
(matchv ::M/objects [((&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))]
[["lux;Right" [?state _]]]
(println (str "Compilation complete! " (str "[" (->> modules
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 24f342469..7ac48e67e 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -1,40 +1,182 @@
(ns lux.compiler.base
(: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*]])
- [lux.analyser.base :as &a])
+ (lux [base :as & :refer [|do return* return fail fail*]]
+ [type :as &type])
+ (lux.analyser [base :as &a]
+ [module :as &a-module]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
MethodVisitor)))
+;; [Utils]
+(defn ^:private write-file [^String file ^bytes data]
+ (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
+ (.write stream data)))
+
+(defn ^:private write-output [module name data]
+ (let [module* module]
+ (.mkdirs (java.io.File. (str "output/jvm/" module*)))
+ (write-file (str "output/jvm/" module* "/" name ".class") data)))
+
+(defn ^:private write-cache [module name data]
+ (let [module* (string/replace module #"/" " ")]
+ (.mkdirs (java.io.File. (str "cache/jvm/" module*)))
+ (write-file (str "cache/jvm/" module* "/" name ".class") data)))
+
+(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 read-file [file]
+ (with-open [reader (io/input-stream file)]
+ (let [length (.length file)
+ buffer (byte-array length)]
+ (.read reader buffer 0 length)
+ buffer)))
+
;; [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 write-file [^String file ^bytes data]
-;; (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
-;; (.write stream data)))
-
-;; (defn write-class [name data]
-;; (write-file (str "output/" name ".class") data))
-
(defn load-class! [^ClassLoader loader name]
(.loadClass loader name))
-;; (defn save-class! [name bytecode]
-;; (|do [loader &/loader
-;; :let [_ (write-class name bytecode)
-;; _ (load-class! loader (string/replace name #"/" "."))]]
-;; (return nil)))
-
(defn save-class! [name bytecode]
- (let [real-name (string/replace name #"/" ".")]
- (|do [loader &/loader
- !classes &/classes
- :let [_ (swap! !classes assoc real-name bytecode)
- _ (load-class! loader real-name)]]
- (return nil))))
+ (|do [eval? &/get-eval
+ module &/get-module-name
+ loader &/loader
+ !classes &/classes
+ :let [real-name (str (string/replace module #"/" ".") "." name)
+ _ (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)))]]
+ (return nil)))
+
+(defn cached? [module]
+ (.exists (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class"))))
+
+(defn delete-cache [module]
+ (fn [state]
+ (do (clean-file (java.io.File. (str "cache/jvm/" (string/replace 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 replace-cache [cache-name]
+ (if (.startsWith cache-name "$")
+ (replace-several cache-name
+ #"_ASTER_" "*"
+ #"_PLUS_" "+"
+ #"_DASH_" "-"
+ #"_SLASH_" "/"
+ #"_BSLASH_" "\\"
+ #"_UNDERS_" "_"
+ #"_PERCENT_" "%"
+ #"_DOLLAR_" "$"
+ #"_QUOTE_" "'"
+ #"_BQUOTE_" "`"
+ #"_AT_" "@"
+ #"_CARET_" "^"
+ #"_AMPERS_" "&"
+ #"_EQ_" "="
+ #"_BANG_" "!"
+ #"_QM_" "?"
+ #"_COLON_" ":"
+ #"_PERIOD_" "."
+ #"_COMMA_" ","
+ #"_LT_" "<"
+ #"_GT_" ">"
+ #"_TILDE_" "~"
+ #"_PIPE_" "|")
+ cache-name))
+
+(defn load-cache [module module-hash compile-module]
+ (|do [loader &/loader
+ !classes &/classes]
+ (let [module-path (str "cache/jvm/" (string/replace module #"/" " "))
+ module* (string/replace module #"/" ".")
+ class-name (str module* "._")
+ module-meta (do (swap! !classes assoc class-name (read-file (java.io.File. (str module-path "/_.class"))))
+ (load-class! loader class-name))]
+ (if (and (= module-hash (-> module-meta (.getField "_hash") (.get nil)))
+ (= version (-> module-meta (.getField "_compiler") (.get nil))))
+ (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 (seq (.listFiles (java.io.File. module-path)))
+ :when (not= "_.class" (.getName file))]
+ (let [real-name (second (re-find #"^(.*)\.class$" (.getName file)))
+ 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 (-> module-meta (.getField "_defs") (.get nil)) #"\t")]
+ (|do [_ (fn [state]
+ (&/run-state (&/map% (fn [_def]
+ (let [[_exported? _name _ann] (string/split _def #" ")
+ ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann])
+ def-class (load-class! loader (str module* ".$" (&/normalize-ident _name)))
+ def-name (-> def-class (.getField "_name") (.get nil))]
+ (|do [_ (case _ann
+ "T" (&a-module/define module def-name (&/V "lux;TypeD" nil) &type/Type)
+ "M" (|do [_ (&a-module/define module def-name (&/V "lux;ValueD" &type/Macro) &type/Macro)]
+ (&a-module/declare-macro module def-name))
+ "V" (let [def-type (-> def-class (.getField "_meta") (.get nil))]
+ (matchv ::M/objects [def-type]
+ [["lux;ValueD" _def-type]]
+ (&a-module/define module def-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 def-name __module __name __type)))))]
+ (if (= "1" _exported?)
+ (&a-module/export module def-name)
+ (return nil)))
+ ))
+ (if (= [""] defs)
+ (&/|list)
+ (&/->list defs)))
+ (->> state
+ (&/set$ &/$ENVS (&/|list (&/env module)))
+ (&/update$ &/$MODULES #(&/|put module &a-module/init-module %)))))]
+ (return true))))
+ (|do [_ (delete-cache module)
+ _ (compile-module module)]
+ (return false)))))
+
+ (|do [_ (delete-cache module)
+ _ (compile-module module)]
+ (return false)))
+ )))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index e825ca0ad..bc1ab23f1 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -319,46 +319,46 @@
0)))
(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods]
- (let [name* (&host/->class ?name)
- super-class* (&host/->class ?super-class)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- name* nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))))
- _ (&/|map (fn [field]
- (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
- (&host/->type-signature (:type field)) nil nil)
- (.visitEnd)))
- ?fields)]
- (|do [_ (&/map% (fn [method]
- (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
- (&host/->type-signature (:output method)))]
- (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method))
- (:name method)
- signature nil nil)
- (|do [^MethodVisitor =method &/get-writer
- :let [_ (.visitCode =method)]
- _ (compile (:body method))
- :let [_ (doto =method
- (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN))
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))))
- ?methods)]
- (&&/save-class! name* (.toByteArray (doto =class .visitEnd))))))
-
-(defn compile-jvm-interface [compile ?name ?supers ?methods]
- (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str))
- (let [name* (&host/->class ?name)
- =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE)
- name* nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String))))
- _ (do (&/|map (fn [method]
+ (|do [module &/get-module-name]
+ (let [super-class* (&host/->class ?super-class)
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (str module "/" ?name) nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))))
+ _ (&/|map (fn [field]
+ (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
+ (&host/->type-signature (:type field)) nil nil)
+ (.visitEnd)))
+ ?fields)]
+ (|do [_ (&/map% (fn [method]
(|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
(&host/->type-signature (:output method)))]
- (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil)))
- ?methods)
- (.visitEnd =interface))]
- (&&/save-class! name* (.toByteArray =interface))))
+ (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method))
+ (:name method)
+ signature nil nil)
+ (|do [^MethodVisitor =method &/get-writer
+ :let [_ (.visitCode =method)]
+ _ (compile (:body method))
+ :let [_ (doto =method
+ (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN))
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))))
+ ?methods)]
+ (&&/save-class! ?name (.toByteArray (doto =class .visitEnd)))))))
+
+(defn compile-jvm-interface [compile ?name ?supers ?methods]
+ ;; (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str))
+ (|do [module &/get-module-name]
+ (let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE)
+ (str module "/" ?name) nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String))))
+ _ (do (&/|map (fn [method]
+ (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
+ (&host/->type-signature (:output method)))]
+ (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil)))
+ ?methods)
+ (.visitEnd =interface))]
+ (&&/save-class! ?name (.toByteArray =interface)))))
(defn compile-jvm-try [compile *type* ?body ?catches ?finally]
(|do [^MethodVisitor *writer* &/get-writer
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 42ed5459e..7b08532fe 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -84,7 +84,8 @@
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?body]
- (|do [:let [lambda-class (&host/location ?scope)
+ ;; (prn 'compile-lambda (->> ?scope &/->seq))
+ (|do [:let [lambda-class (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope)))
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
lambda-class nil "java/lang/Object" (into-array ["lux/Function"]))
@@ -99,5 +100,5 @@
)]
_ (add-lambda-impl =class compile lambda-impl-signature ?body)
:let [_ (.visitEnd =class)]
- _ (&&/save-class! lambda-class (.toByteArray =class))]
+ _ (&&/save-class! (str "$" (&host/location (&/|tail ?scope))) (.toByteArray =class))]
(instance-closure compile lambda-class ?env (lambda-<init>-signature ?env))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index b47267d25..c8197da66 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -107,14 +107,14 @@
:let [_ (doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD
- (&host/location ?scope)
+ (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope)))
(str &&/closure-prefix ?captured-id)
"Ljava/lang/Object;"))]]
(return nil)))
(defn compile-global [compile *type* ?owner-class ?name]
(|do [^MethodVisitor *writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str ?owner-class "/$" (&/normalize-ident ?name)) "_datum" "Ljava/lang/Object;")]]
(return nil)))
(defn compile-apply [compile *type* ?fn ?arg]
@@ -270,11 +270,13 @@
module-name &/get-module-name
:let [outer-class (&host/->class module-name)
datum-sig "Ljava/lang/Object;"
- current-class (&host/location (&/|list outer-class ?name))
- _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
+ current-class (str outer-class "/" (str "$" (&/normalize-ident ?name)))
+ ;; _ (prn 'compile-def 'outer-class outer-class '?name ?name 'current-class current-class)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
current-class nil "java/lang/Object" (into-array ["lux/Function"]))
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_name" "Ljava/lang/String;" nil ?name)
+ (doto (.visitEnd)))
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
(doto (.visitEnd)))
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_meta" datum-sig nil nil)
@@ -292,7 +294,7 @@
(.visitEnd))]]
(return nil)))
:let [_ (.visitEnd *writer*)]
- _ (&&/save-class! current-class (.toByteArray =class))]
+ _ (&&/save-class! (str "$" (&/normalize-ident ?name)) (.toByteArray =class))]
(return nil)))
(defn compile-ann [compile *type* ?value-ex ?type-ex]
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 0e8c1b710..bef093247 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -124,7 +124,7 @@
(&/T (&/T file-name line-num column-num*) line)))))
(&/V "No" (str "[Reader Error] Text failed: " text))))))
-(def ^:private ^String +source-dir+ "source/")
+(def ^:private ^String +source-dir+ "input/")
(defn from [^String file-name ^String file-content]
(let [lines (&/->list (string/split-lines file-content))
file-name (.substring file-name (.length +source-dir+))]
diff --git a/src/lux/type.clj b/src/lux/type.clj
index d82eae8fd..e0315f8e7 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -169,7 +169,8 @@
(&/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;seen-sources" (&/V "lux;AppT" (&/T List Text)))
+ (&/T "lux;eval?" Bool))))
$Void)))
(def Macro
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 19:46:54 +0000