aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj62
-rw-r--r--src/lux/analyser/env.clj1
-rw-r--r--src/lux/analyser/host.clj21
-rw-r--r--src/lux/analyser/lux.clj33
-rw-r--r--src/lux/analyser/module.clj6
-rw-r--r--src/lux/compiler.clj27
-rw-r--r--src/lux/compiler/base.clj2
-rw-r--r--src/lux/compiler/cache.clj22
-rw-r--r--src/lux/compiler/case.clj4
-rw-r--r--src/lux/compiler/lux.clj78
-rw-r--r--src/lux/compiler/type.clj2
-rw-r--r--src/lux/host.clj3
-rw-r--r--src/lux/optimizer.clj4
-rw-r--r--src/lux/type.clj4
14 files changed, 161 insertions, 108 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index f10f6b913..774188d82 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -34,7 +34,7 @@
["lux;Nil" _]]]]]]]]]
(&/T catch+ (&/V "lux;Some" ?finally-body))))
-(defn ^:private aba7 [analyse eval! compile-module exo-type token]
+(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
;; Arrays
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]]
@@ -64,25 +64,25 @@
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?methods]]]
["lux;Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods)
+ (&&host/analyse-jvm-class analyse compile-token ?name ?super-class ?interfaces ?fields ?methods)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]]
?methods]]]]]]]]
- (&&host/analyse-jvm-interface analyse ?name ?supers ?methods)
+ (&&host/analyse-jvm-interface analyse compile-token ?name ?supers ?methods)
;; Programs
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-program analyse ?args ?body)
+ (&&host/analyse-jvm-program analyse compile-token ?args ?body)
[_]
(fail "")))
-(defn ^:private aba6 [analyse eval! compile-module exo-type token]
+(defn ^:private aba6 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
;; Primitive conversions
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
@@ -156,9 +156,9 @@
(&&host/analyse-jvm-lushr analyse exo-type ?x ?y)
[_]
- (aba7 analyse eval! compile-module exo-type token)))
+ (aba7 analyse eval! compile-module compile-token exo-type token)))
-(defn ^:private aba5 [analyse eval! compile-module exo-type token]
+(defn ^:private aba5 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
;; Objects
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]]
@@ -265,9 +265,9 @@
(&&host/analyse-jvm-monitorexit analyse exo-type ?monitor)
[_]
- (aba6 analyse eval! compile-module exo-type token)))
+ (aba6 analyse eval! compile-module compile-token exo-type token)))
-(defn ^:private aba4 [analyse eval! compile-module exo-type token]
+(defn ^:private aba4 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
;; Float arithmetic
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
@@ -320,9 +320,9 @@
(&&host/analyse-jvm-dgt analyse exo-type ?x ?y)
[_]
- (aba5 analyse eval! compile-module exo-type token)))
+ (aba5 analyse eval! compile-module compile-token exo-type token)))
-(defn ^:private aba3 [analyse eval! compile-module exo-type token]
+(defn ^:private aba3 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
;; Host special forms
;; Characters
@@ -386,9 +386,9 @@
(&&host/analyse-jvm-lgt analyse exo-type ?x ?y)
[_]
- (aba4 analyse eval! compile-module exo-type token)))
+ (aba4 analyse eval! compile-module compile-token exo-type token)))
-(defn ^:private aba2 [analyse eval! compile-module exo-type token]
+(defn ^:private aba2 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
[["lux;SymbolS" ?ident]]
(&&lux/analyse-symbol analyse exo-type ?ident)
@@ -408,17 +408,17 @@
["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]]
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]
- (&&lux/analyse-def analyse ?name ?value)
+ (&&lux/analyse-def analyse compile-token ?name ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]]
["lux;Nil" _]]]]]]]
- (&&lux/analyse-declare-macro analyse ?name)
+ (&&lux/analyse-declare-macro analyse compile-token ?name)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]]
["lux;Nil" _]]]]]]]
- (&&lux/analyse-import analyse compile-module ?path)
+ (&&lux/analyse-import analyse compile-module compile-token ?path)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]]
["lux;Cons" [?type
@@ -435,18 +435,18 @@
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]]
["lux;Nil" _]]]]]]]
- (&&lux/analyse-export analyse ?ident)
+ (&&lux/analyse-export analyse compile-token ?ident)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_alias"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?alias]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?module]]]
["lux;Nil" _]]]]]]]]]
- (&&lux/analyse-alias analyse ?alias ?module)
+ (&&lux/analyse-alias analyse compile-token ?alias ?module)
[_]
- (aba3 analyse eval! compile-module exo-type token)))
+ (aba3 analyse eval! compile-module compile-token exo-type token)))
-(defn ^:private aba1 [analyse eval! compile-module exo-type token]
+(defn ^:private aba1 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
;; Standard special forms
[["lux;BoolS" ?value]]
@@ -482,7 +482,7 @@
(&&host/analyse-jvm-null analyse exo-type)
[_]
- (aba2 analyse eval! compile-module exo-type token)
+ (aba2 analyse eval! compile-module compile-token exo-type token)
))
(defn ^:private add-loc [meta ^String msg]
@@ -491,12 +491,12 @@
(|let [[file line col] meta]
(str "@ " file "," line "," col "\n" msg))))
-(defn ^:private analyse-basic-ast [analyse eval! compile-module exo-type token]
+(defn ^:private analyse-basic-ast [analyse eval! compile-module compile-token exo-type token]
;; (prn 'analyse-basic-ast (&/show-ast token))
(matchv ::M/objects [token]
[["lux;Meta" [meta ?token]]]
(fn [state]
- (matchv ::M/objects [((aba1 analyse eval! compile-module exo-type ?token) state)]
+ (matchv ::M/objects [((aba1 analyse eval! compile-module compile-token exo-type ?token) state)]
[["lux;Right" [state* output]]]
(return* state* output)
@@ -526,28 +526,28 @@
(return (&/T ?output-term ?output-type)))
))))
-(defn ^:private analyse-ast [eval! compile-module exo-type token]
+(defn ^:private analyse-ast [eval! compile-module compile-token exo-type token]
(&/with-expected-type exo-type
(matchv ::M/objects [token]
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]]
- (&&lux/analyse-variant (partial analyse-ast eval! compile-module) exo-type ?ident ?values)
+ (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]]
(fn [state]
- (matchv ::M/objects [((just-analyse (partial analyse-ast eval! compile-module) ?fn) state)
+ (matchv ::M/objects [((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state)
;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)
]
[["lux;Right" [state* =fn]]]
(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 meta =fn ?args) state*))
+ ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-token) exo-type meta =fn ?args) state*))
[_]
- ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
+ ((analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token) state)))
[_]
- (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token))))
+ (analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token))))
;; [Resources]
-(defn analyse [eval! compile-module]
+(defn analyse [eval! compile-module compile-token]
(|do [asts &parser/parse]
- (&/flat-map% (partial analyse-ast eval! compile-module &type/$Void) asts)))
+ (&/flat-map% (partial analyse-ast eval! compile-module compile-token &type/$Void) asts)))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index cac0f8cd4..391d78411 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -20,6 +20,7 @@
(defn with-local [name type body]
;; (prn 'with-local name)
(fn [state]
+ ;; (prn 'with-local name)
(let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS))
=return (body (&/update$ &/$ENVS
(fn [stack]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 5033f4f2c..663c650e7 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -273,7 +273,7 @@
tname
))
-(defn analyse-jvm-class [analyse ?name ?super-class ?interfaces ?fields ?methods]
+(defn analyse-jvm-class [analyse compile-token ?name ?super-class ?interfaces ?fields ?methods]
(|do [=interfaces (&/map% extract-text ?interfaces)
=fields (&/map% (fn [?field]
(matchv ::M/objects [?field]
@@ -328,10 +328,11 @@
[_]
(fail "[Analyser Error] Wrong syntax for method.")))
- (&/enumerate ?methods))]
- (return (&/|list (&/V "jvm-class" (&/T ?name ?super-class =interfaces =fields =methods))))))
+ (&/enumerate ?methods))
+ _ (compile-token (&/V "jvm-class" (&/T ?name ?super-class =interfaces =fields =methods)))]
+ (return (&/|list))))
-(defn analyse-jvm-interface [analyse ?name ?supers ?methods]
+(defn analyse-jvm-interface [analyse compile-token ?name ?supers ?methods]
(|do [=supers (&/map% extract-text ?supers)
=methods (&/map% (fn [method]
(matchv ::M/objects [method]
@@ -349,8 +350,9 @@
[_]
(fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
- ?methods)]
- (return (&/|list (&/V "jvm-interface" (&/T ?name =supers =methods))))))
+ ?methods)
+ _ (compile-token (&/V "jvm-interface" (&/T ?name =supers =methods)))]
+ (return (&/|list))))
(defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally]
(|do [:let [[?catches ?finally] ?catches+?finally]
@@ -431,9 +433,10 @@
analyse-jvm-lushr "jvm-lushr" "java.lang.Long" "java.lang.Integer"
)
-(defn analyse-jvm-program [analyse ?args ?body]
+(defn analyse-jvm-program [analyse compile-token ?args ?body]
(|let [[_module _name] ?args]
(|do [=body (&/with-scope ""
(&&env/with-local (str _module ";" _name) (&/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))))))
+ (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))
+ _ (compile-token (&/V "jvm-program" =body))]
+ (return (&/|list)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 4fb9d1533..c86df3027 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -163,7 +163,7 @@
?name)
;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" ?type]]
+ [["lux;ValueD" [?type _]]]
(return ?type)
[["lux;MacroD" _]]
@@ -188,7 +188,7 @@
((|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]]
+ [["lux;ValueD" [?type _]]]
(return ?type)
[["lux;MacroD" _]]
@@ -282,7 +282,7 @@
macro-expansion #(-> macro (.apply ?args) (.apply %))
;; :let [_ (prn 'MACRO-EXPAND|POST (str r-module ";" r-name))]
:let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
- ;; :let [_ (when (or (= "loop" r-name)
+ ;; :let [_ (when (or (= "<>" r-name)
;; ;; (= "struct" r-name)
;; )
;; (->> (&/|map &/show-ast macro-expansion*)
@@ -377,7 +377,7 @@
(|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)]
(return (&/|list output))))
-(defn analyse-def [analyse ?name ?value]
+(defn analyse-def [analyse compile-token ?name ?value]
;; (prn 'analyse-def/BEGIN ?name)
;; (when (= "PList/Dict" ?name)
;; (prn 'DEF ?name (&/show-ast ?value)))
@@ -397,24 +397,17 @@
(return (&/|list)))
[_]
- (|do [=value-type (&&/expr-type =value)
- :let [;; _ (prn 'analyse-def/END ?name)
- _ (println 'DEF (str module-name ";" ?name))
- ;; _ (println)
- def-data (cond (&type/type= &type/Type =value-type)
- (&/V "lux;TypeD" nil)
-
- :else
- (&/V "lux;ValueD" =value-type))]
- _ (&&module/define module-name ?name def-data =value-type)]
- (return (&/|list (&/V "def" (&/T ?name =value def-data))))))
+ (do (println 'DEF (str module-name ";" ?name))
+ (|do [_ (compile-token (&/V "def" (&/T ?name =value)))]
+ (return (&/|list)))))
))))
-(defn analyse-declare-macro [analyse ?name]
+(defn analyse-declare-macro [analyse compile-token ?name]
(|do [module-name &/get-module-name]
- (return (&/|list (&/V "declare-macro" (&/T module-name ?name))))))
+ (|do [_ (compile-token (&/V "declare-macro" (&/T module-name ?name)))]
+ (return (&/|list)))))
-(defn analyse-import [analyse compile-module ?path]
+(defn analyse-import [analyse compile-module compile-token ?path]
(|do [module-name &/get-module-name
_ (if (= module-name ?path)
(fail (str "[Analyser Error] Module can't import itself: " ?path))
@@ -426,12 +419,12 @@
_ (&/when% (not already-compiled?) (compile-module ?path))]
(return (&/|list))))))
-(defn analyse-export [analyse name]
+(defn analyse-export [analyse compile-token name]
(|do [module-name &/get-module-name
_ (&&module/export module-name name)]
(return (&/|list))))
-(defn analyse-alias [analyse ex-alias ex-module]
+(defn analyse-alias [analyse compile-token ex-alias ex-module]
(|do [module-name &/get-module-name
_ (&&module/alias module-name ex-alias ex-module)]
(return (&/|list))))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 68cdc4747..327dad27f 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -72,7 +72,7 @@
[[_ ["lux;MacroD" _]]]
(return* state &type/Macro)
- [[_ ["lux;ValueD" _type]]]
+ [[_ ["lux;ValueD" [_type _]]]]
(return* state _type)
[[_ ["lux;AliasD" [?r-module ?r-name]]]]
@@ -159,7 +159,7 @@
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
(if-let [$def (&/|get name $module)]
(matchv ::M/objects [$def]
- [[exported? ["lux;ValueD" ?type]]]
+ [[exported? ["lux;ValueD" [?type _]]]]
((|do [_ (&type/check &type/Macro ?type)
^ClassLoader loader &/loader
:let [macro (-> (.loadClass loader (str (&host/->module-class module) "." (&/normalize-name name)))
@@ -181,7 +181,7 @@
[[_ ["lux;MacroD" _]]]
(fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name)))
- [[_ ["lux;TypeD" _]]]
+ [[_ _]]
(fail* (str "[Analyser Error] Definition does not have macro type: " (str module &/+name-separator+ name))))
(fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name))))
(fail* (str "[Analyser Error] Module does not exist: " module)))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index b88bb9c0a..4c12f9519 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -326,8 +326,8 @@
(defn ^:private compile-statement [syntax]
(matchv ::M/objects [syntax]
- [["def" [?name ?body ?def-data]]]
- (&&lux/compile-def compile-expression ?name ?body ?def-data)
+ [["def" [?name ?body]]]
+ (&&lux/compile-def compile-expression ?name ?body)
[["declare-macro" [?module ?name]]]
(&&lux/compile-declare-macro compile-expression ?module ?name)
@@ -341,6 +341,26 @@
[["jvm-class" [?name ?super-class ?interfaces ?fields ?methods]]]
(&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)))
+(defn ^:private compile-token [syntax]
+ (matchv ::M/objects [syntax]
+ [["def" [?name ?body]]]
+ (&&lux/compile-def compile-expression ?name ?body)
+
+ [["declare-macro" [?module ?name]]]
+ (&&lux/compile-declare-macro compile-expression ?module ?name)
+
+ [["jvm-program" ?body]]
+ (&&host/compile-jvm-program compile-expression ?body)
+
+ [["jvm-interface" [?name ?supers ?methods]]]
+ (&&host/compile-jvm-interface compile-expression ?name ?supers ?methods)
+
+ [["jvm-class" [?name ?super-class ?interfaces ?fields ?methods]]]
+ (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)
+
+ [_]
+ (compile-expression syntax)))
+
(defn ^:private eval! [expr]
(&/with-eval
(|do [module &/get-module-name
@@ -378,8 +398,7 @@
:let [file-hash (hash file-content)]]
(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+))]
+ (let [compiler-step (&optimizer/optimize eval! compile-module compile-token)]
(|do [module-exists? (&a-module/exists? name)]
(if module-exists?
(fail "[Compiler Error] Can't redefine a module!")
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 28339c162..74e5625b3 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -27,7 +27,7 @@
(java.lang.reflect Field)))
;; [Constants]
-(def ^String version "0.2")
+(def ^String version "0.3")
(def ^String input-dir "source")
(def ^String output-dir "target/jvm")
(def ^String output-package (str output-dir "/program.jar"))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index 45513d0a5..565eae898 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -26,6 +26,7 @@
;; [Utils]
(defn ^:private read-file [^File file]
+ "(-> File (Array Byte))"
(with-open [reader (io/input-stream file)]
(let [length (.length file)
buffer (byte-array length)]
@@ -33,6 +34,7 @@
buffer)))
(defn ^:private clean-file [^File file]
+ "(-> File (,))"
(if (.isDirectory file)
(do (doseq [f (seq (.listFiles file))]
(clean-file f))
@@ -40,6 +42,7 @@
(.delete file)))
(defn ^:private get-field [^String field-name ^Class class]
+ "(-> Text Class Object)"
(-> class ^Field (.getField field-name) (.get nil)))
;; [Resources]
@@ -66,6 +69,7 @@
nil))
(defn load [module module-hash compile-module]
+ "(-> Text Int (-> Text (Lux (,))) (Lux Bool))"
(|do [loader &/loader
!classes &/classes
already-loaded? (&a-module/exists? module)
@@ -112,15 +116,19 @@
;; _ (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))
+ "T" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name)))
+ def-value (get-field "_datum" def-class)]
+ (&a-module/define module _name (&/V "lux;TypeD" def-value) &type/Type))
+ "M" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name)))
+ def-value (get-field "_datum" def-class)]
+ (|do [_ (&a-module/define module _name (&/V "lux;ValueD" (&/T &type/Macro def-value)) &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)))
+ def-meta (get-field "_meta" def-class)]
+ (matchv ::M/objects [def-meta]
+ [["lux;ValueD" [def-type _]]]
+ (&a-module/define module _name def-meta def-type)))
;; else
(let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)]
(|do [__type (&a-module/def-type __module __name)]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index fc0cce31f..906cc1ca8 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -47,7 +47,7 @@
(.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long")
(.visitInsn Opcodes/DUP)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Long" "longValue" "()J")
- (.visitLdcInsn ?value)
+ (.visitLdcInsn (long ?value))
(.visitInsn Opcodes/LCMP)
(.visitJumpInsn Opcodes/IFNE $else)
(.visitInsn Opcodes/POP)
@@ -58,7 +58,7 @@
(.visitTypeInsn Opcodes/CHECKCAST "java/lang/Double")
(.visitInsn Opcodes/DUP)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Double" "doubleValue" "()D")
- (.visitLdcInsn ?value)
+ (.visitLdcInsn (double ?value))
(.visitInsn Opcodes/DCMPL)
(.visitJumpInsn Opcodes/IFNE $else)
(.visitInsn Opcodes/POP)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index b1023689e..def5220f7 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -136,33 +136,38 @@
?args)]
(return nil)))
-(defn ^:private compile-def-type [compile ?body ?def-data]
+(defn ^:private compile-def-type [compile current-class ?body def-type]
(|do [^MethodVisitor **writer** &/get-writer]
- (matchv ::M/objects [?def-data]
- [["lux;TypeD" _]]
- (let [_ (doto **writer**
- ;; Tail: Begin
- (.visitLdcInsn (int 2)) ;; S
- (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V
- (.visitInsn Opcodes/DUP) ;; VV
- (.visitLdcInsn (int 0)) ;; VVI
- (.visitLdcInsn "lux;TypeD") ;; VVIT
- (.visitInsn Opcodes/AASTORE) ;; V
- (.visitInsn Opcodes/DUP) ;; VV
- (.visitLdcInsn (int 1)) ;; VVI
- (.visitInsn Opcodes/ACONST_NULL) ;; VVIN
- (.visitInsn Opcodes/AASTORE) ;; V
- )]
+ (matchv ::M/objects [def-type]
+ ["type"]
+ (|do [:let [;; ?type* (&&type/->analysis ?type)
+ _ (doto **writer**
+ ;; Tail: Begin
+ (.visitLdcInsn (int 2)) ;; S
+ (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V
+ (.visitInsn Opcodes/DUP) ;; VV
+ (.visitLdcInsn (int 0)) ;; VVI
+ (.visitLdcInsn "lux;TypeD") ;; VVIT
+ (.visitInsn Opcodes/AASTORE) ;; V
+ (.visitInsn Opcodes/DUP) ;; VV
+ (.visitLdcInsn (int 1)) ;; VVI
+ (.visitFieldInsn Opcodes/GETSTATIC current-class "_datum" "Ljava/lang/Object;")
+ ;; (.visitInsn Opcodes/ACONST_NULL) ;; VVIN
+ (.visitInsn Opcodes/AASTORE) ;; V
+ )]
+ ;; _ (compile ?type*)
+ ;; :let [_ (.visitInsn **writer** Opcodes/AASTORE)]
+ ]
(return nil))
- [["lux;ValueD" _]]
+ ["value"]
(|let [;; _ (prn '?body (aget ?body 0) (aget ?body 1 0))
- [?def-value ?def-type] (matchv ::M/objects [?body]
- [[["ann" [?def-value ?type-expr]] ?def-type]]
- (&/T ?def-value ?type-expr)
+ ?def-type (matchv ::M/objects [?body]
+ [[["ann" [?def-value ?type-expr]] ?def-type]]
+ ?type-expr
- [[?def-value ?def-type]]
- (&/T ?body (&&type/->analysis ?def-type)))]
+ [[?def-value ?def-type]]
+ (&&type/->analysis ?def-type))]
(|do [:let [_ (doto **writer**
(.visitLdcInsn (int 2)) ;; S
(.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V
@@ -173,13 +178,31 @@
(.visitInsn Opcodes/DUP) ;; VV
(.visitLdcInsn (int 1)) ;; VVI
)]
+ :let [_ (doto **writer**
+ (.visitLdcInsn (int 2)) ;; S
+ (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V
+ (.visitInsn Opcodes/DUP) ;; VV
+ (.visitLdcInsn (int 0)) ;; VVI
+ )]
_ (compile ?def-type)
+ :let [_ (.visitInsn **writer** Opcodes/AASTORE)]
+ :let [_ (doto **writer**
+ (.visitInsn Opcodes/DUP) ;; VV
+ (.visitLdcInsn (int 1)) ;; VVI
+ (.visitFieldInsn Opcodes/GETSTATIC current-class "_datum" "Ljava/lang/Object;")
+ (.visitInsn Opcodes/AASTORE))]
:let [_ (.visitInsn **writer** Opcodes/AASTORE)]]
(return nil)))
)))
-(defn compile-def [compile ?name ?body ?def-data]
- (|do [^ClassWriter *writer* &/get-writer
+(defn compile-def [compile ?name ?body]
+ (|do [=value-type (&a/expr-type ?body)
+ :let [def-type (cond (&type/type= &type/Type =value-type)
+ "type"
+
+ :else
+ "value")]
+ ^ClassWriter *writer* &/get-writer
module-name &/get-module-name
:let [datum-sig "Ljava/lang/Object;"
def-name (&/normalize-name ?name)
@@ -198,7 +221,7 @@
:let [_ (.visitCode **writer**)]
_ (compile ?body)
:let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class "_datum" datum-sig)]
- _ (compile-def-type compile ?body ?def-data)
+ _ (compile-def-type compile current-class ?body def-type)
:let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class "_meta" datum-sig)]
:let [_ (doto **writer**
(.visitInsn Opcodes/RETURN)
@@ -206,7 +229,10 @@
(.visitEnd))]]
(return nil)))
:let [_ (.visitEnd *writer*)]
- _ (&&/save-class! def-name (.toByteArray =class))]
+ _ (&&/save-class! def-name (.toByteArray =class))
+ class-loader &/loader
+ :let [def-class (&&/load-class! class-loader (&host/->class-name current-class))]
+ _ (&a-module/define module-name ?name (-> def-class (.getField "_meta") (.get nil)) =value-type)]
(return nil)))
(defn compile-ann [compile *type* ?value-ex ?type-ex]
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index a92911444..01141f8e4 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -75,7 +75,7 @@
(variant$ "lux;AllT"
(tuple$ (&/|list (matchv ::M/objects [?env]
[["lux;None" _]]
- (variant$ "lux;Some" (tuple$ (&/|list)))
+ (variant$ "lux;None" (tuple$ (&/|list)))
[["lux;Some" ??env]]
(variant$ "lux;Some"
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 906e3c714..91582c526 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -40,6 +40,9 @@
(defn ^String ->class [class]
(string/replace class #"\." "/"))
+(defn ^String ->class-name [module]
+ (string/replace module #"/" "."))
+
(defn ^String ->module-class [module-name]
(string/replace module-name #"/" module-separator))
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 5056a09e0..65dc4eb0d 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -22,5 +22,5 @@
;; Local var aliasing.
;; [Exports]
-(defn optimize [eval! compile-module]
- (&analyser/analyse eval! compile-module))
+(defn optimize [eval! compile-module compile-token]
+ (&analyser/analyse eval! compile-module compile-token))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e3255ac5c..f40996d7e 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -142,8 +142,8 @@
(def DefData*
(fAll "lux;DefData'" ""
- (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit)
- (&/T "lux;ValueD" Type)
+ (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Type)
+ (&/T "lux;ValueD" (&/V "lux;TupleT" (&/|list Type Unit)))
(&/T "lux;MacroD" (&/V "lux;BoundT" ""))
(&/T "lux;AliasD" Ident)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 06:54:55 +0000