aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux49
-rw-r--r--src/lux/analyser.clj4
-rw-r--r--src/lux/analyser/case.clj2
-rw-r--r--src/lux/analyser/host.clj16
-rw-r--r--src/lux/analyser/lux.clj20
-rw-r--r--src/lux/compiler/base.clj1
-rw-r--r--src/lux/compiler/case.clj41
-rw-r--r--src/lux/compiler/host.clj2
-rw-r--r--src/lux/compiler/lambda.clj2
-rw-r--r--src/lux/compiler/lux.clj36
-rw-r--r--src/lux/host.clj4
-rw-r--r--src/lux/macro.clj60
12 files changed, 100 insertions, 137 deletions
diff --git a/source/lux.lux b/source/lux.lux
index db827760d..641be09ca 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -2,40 +2,6 @@
(jvm;interface Function
(: apply (-> [java.lang.Object] java.lang.Object)))
-(jvm;class Tuple0 java.lang.Object
- [])
-(jvm;class Tuple1 java.lang.Object
- [[java.lang.Object _0]])
-(jvm;class Tuple2 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]])
-(jvm;class Tuple3 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]
- [java.lang.Object _2]])
-(jvm;class Tuple4 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]
- [java.lang.Object _2] [java.lang.Object _3]])
-(jvm;class Tuple5 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]
- [java.lang.Object _2] [java.lang.Object _3]
- [java.lang.Object _4]])
-(jvm;class Tuple6 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]
- [java.lang.Object _2] [java.lang.Object _3]
- [java.lang.Object _4] [java.lang.Object _5]])
-(jvm;class Tuple7 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]
- [java.lang.Object _2] [java.lang.Object _3]
- [java.lang.Object _4] [java.lang.Object _5]
- [java.lang.Object _6]])
-(jvm;class Tuple8 java.lang.Object
- [[java.lang.Object _0] [java.lang.Object _1]
- [java.lang.Object _2] [java.lang.Object _3]
- [java.lang.Object _4] [java.lang.Object _5]
- [java.lang.Object _6] [java.lang.Object _7]])
-
-(jvm;class Variant java.lang.Object
- [[java.lang.String tag] [java.lang.Object value]])
-
## Base functions & macros
(def' let'
(lambda' _ tokens
@@ -86,6 +52,21 @@
[(#Cons [output #Nil]) state])))
(declare-macro def)
+## (def (defmacro tokens state)
+## (let' fn-def (case' tokens
+## (#Cons [(#Form (#Cons [(#Ident ?name) (#Cons [(#Ident ?tokens) (#Cons [(#Ident ?state) #Nil])])]))
+## (#Cons [body #Nil])])
+## (#Form (#Cons [(#Form (#Cons [(#Ident "lux;def")
+## (#Cons [(#Ident ?name)
+## (#Cons [(#Ident ?tokens)
+## (#Cons [(#Ident ?state)
+## #Nil])])])]))
+## (#Cons [body
+## #Nil])])))
+## (let' declaration []
+## [(#Cons [fn-def (#Cons [declaration #Nil])]) state])))
+## (declare-macro defmacro)
+
(def (comment tokens state)
[#Nil state])
(declare-macro comment)
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index faa41913f..4ddd8ecd1 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -166,9 +166,9 @@
;; (prn 'analyse-ast token)
(match token
[::&parser/Form ([[::&parser/Tag ?tag] & ?values] :seq)]
- (exec [:let [_ (prn 'PRE-ASSERT)]
+ (exec [;; :let [_ (prn 'PRE-ASSERT)]
:let [_ (assert (= 1 (count ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))]
- :let [_ (prn 'POST-ASSERT)]
+ ;; :let [_ (prn 'POST-ASSERT)]
:let [?value (first ?values)]
=value (&&/analyse-1 analyse-ast ?value)
=value-type (&&/expr-type =value)]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 4aec4af10..639395f33 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -24,7 +24,7 @@
(list)))
(defn analyse-branch [analyse max-registers [bindings body]]
- (prn 'analyse-branch max-registers bindings body)
+ ;; (prn 'analyse-branch max-registers bindings body)
(reduce (fn [body* name]
(&env/with-local name :local &type/+dont-care-type+ body*))
(reduce (fn [body* _]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index ddc91d2b9..aa7812421 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -57,9 +57,10 @@
(defn analyse-jvm-getstatic [analyse ?class ?field]
(exec [=class (&host/full-class-name ?class)
- :let [_ (prn 'analyse-jvm-getstatic/=class =class)]
+ ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)]
=type (&host/lookup-static-field =class ?field)
- :let [_ (prn 'analyse-jvm-getstatic/=type =type)]]
+ ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)]
+ ]
(return (list [::&&/Expression [::&&/jvm-getstatic =class ?field] =type]))))
(defn analyse-jvm-getfield [analyse ?class ?field ?object]
@@ -77,15 +78,16 @@
(defn analyse-jvm-invokevirtual [analyse ?class ?method ?classes ?object ?args]
(exec [=class (&host/full-class-name ?class)
- :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
=classes (map-m &host/extract-jvm-param ?classes)
- :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
[=method-args =return] (&host/lookup-virtual-method =class ?method =classes)
- :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
=object (&&/analyse-1 analyse ?object)
- :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
=args (mapcat-m analyse ?args)
- :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]]
+ ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]
+ ]
(return (list [::&&/Expression [::&&/jvm-invokevirtual =class ?method =classes =object =args] =return]))))
(defn analyse-jvm-new [analyse ?class ?classes ?args]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index b80321820..5e81cae0e 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -57,9 +57,10 @@
(if macro?
(let [macro-class (&host/location (list ?module ?name))
[macro-expansion state*] (&macro/expand loader macro-class ?args)
- _ (prn 'macro-expansion)
- _ (doseq [ast macro-expansion]
- (prn '=> ast))]
+ ;; _ (prn 'macro-expansion)
+ ;; _ (doseq [ast macro-expansion]
+ ;; (prn '=> ast))
+ ]
(mapcat-m analyse macro-expansion))
(exec [=args (mapcat-m analyse ?args)]
(return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+])))))
@@ -73,23 +74,23 @@
))
(defn analyse-case [analyse ?variant ?branches]
- (prn 'analyse-case ?variant ?branches)
+ ;; (prn 'analyse-case ?variant ?branches)
(exec [:let [num-branches (count ?branches)]
_ (assert! (and (> num-branches 0) (even? num-branches))
"[Analyser Error] Unbalanced branches in \"case'\" expression.")
:let [branches (partition 2 ?branches)
locals-per-branch (map (comp &&case/locals first) branches)
max-locals (reduce max 0 (map count locals-per-branch))]
- :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
+ ;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
base-register &&env/next-local-idx
- :let [_ (prn 'base-register base-register)]
+ ;; :let [_ (prn 'base-register base-register)]
=variant (reduce (fn [body* _] (&&env/with-local "#" :local &type/+dont-care-type+ body*))
(&&/analyse-1 analyse ?variant)
(range max-locals))
- :let [_ (prn '=variant =variant)]
+ ;; :let [_ (prn '=variant =variant)]
=bodies (map-m (partial &&case/analyse-branch analyse max-locals)
(map vector locals-per-branch (map second branches)))
- :let [_ (prn '=bodies =bodies)]
+ ;; :let [_ (prn '=bodies =bodies)]
;; :let [_ (prn 'analyse-case/=bodies =bodies)]
=body-types (map-m &&/expr-type =bodies)
=case-type (return [::&type/Any]) ;; (reduce-m &type/merge [::&type/Nothing] =body-types)
@@ -110,7 +111,8 @@
_
[::&&/lambda =scope =captured (list ?arg) =body])
- _ (prn '=lambda-form =lambda-form)]]
+ ;; _ (prn '=lambda-form =lambda-form)
+ ]]
(return (list [::&&/Expression =lambda-form =lambda-type]))))
(defn analyse-def [analyse ?name ?value]
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 39c67f5d0..28c793e10 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -13,7 +13,6 @@
(def local-prefix "l")
(def partial-prefix "p")
(def closure-prefix "c")
-(def tuple-field-prefix "_")
(def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;")
(defn add-nulls [writer amount]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index b0a8a8ea6..48c52123f 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -63,9 +63,6 @@
[mappings (reverse pms)]))
(let [+tag-sig+ (&host/->type-signature "java.lang.String")
- +variant-class+ (&host/->class &host/variant-class)
- tuple-class* (&host/->class &host/tuple-class)
- +variant-value-sig+ (&host/->type-signature "java.lang.Object")
+oclass+ (&host/->class "java.lang.Object")
+equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z")]
(defn ^:private compile-match [writer ?match $target $else]
@@ -123,32 +120,34 @@
(.visitJumpInsn Opcodes/GOTO $target))
[::TupleMatch ?members]
- (let [tuple-class** (str tuple-class* (count ?members))]
- (doto writer
- (.visitTypeInsn Opcodes/CHECKCAST tuple-class**)
- (-> (doto (.visitInsn Opcodes/DUP)
- (.visitFieldInsn Opcodes/GETFIELD tuple-class** (str &&/tuple-field-prefix idx) +variant-value-sig+)
- (compile-match member $next $sub-else)
- (.visitLabel $sub-else)
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $else)
- (.visitLabel $next))
- (->> (doseq [[idx [_ _ member]] (map vector (range (count ?members)) ?members)
- :let [$next (new Label)
- $sub-else (new Label)]])))
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $target)))
+ (doto writer
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (-> (doto (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx))
+ (.visitInsn Opcodes/AALOAD)
+ (compile-match member $next $sub-else)
+ (.visitLabel $sub-else)
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $else)
+ (.visitLabel $next))
+ (->> (doseq [[idx [_ _ member]] (map vector (range (count ?members)) ?members)
+ :let [$next (new Label)
+ $sub-else (new Label)]])))
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $target))
[::VariantMatch ?tag [::Pattern _ ?value]]
(doto writer
- (.visitTypeInsn Opcodes/CHECKCAST +variant-class+)
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
(.visitInsn Opcodes/DUP)
- (.visitFieldInsn Opcodes/GETFIELD +variant-class+ "tag" +tag-sig+)
+ (.visitLdcInsn (int 0))
+ (.visitInsn Opcodes/AALOAD)
(.visitLdcInsn ?tag)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +oclass+ "equals" +equals-sig+)
(.visitJumpInsn Opcodes/IFEQ $else)
(.visitInsn Opcodes/DUP)
- (.visitFieldInsn Opcodes/GETFIELD +variant-class+ "value" +variant-value-sig+)
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/AALOAD)
(-> (doto (compile-match ?value $value-then $value-else)
(.visitLabel $value-then)
(.visitInsn Opcodes/POP)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index a141cecc3..879bc52f3 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -113,7 +113,7 @@
(return nil)))
(defn compile-jvm-invokevirtual [compile *type* ?class ?method ?classes ?object ?args]
- (prn 'compile-jvm-invokevirtual ?classes *type*)
+ ;; (prn 'compile-jvm-invokevirtual ?classes *type*)
(exec [*writer* &/get-writer
:let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
_ (compile ?object)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index b24ab9fc6..9afb2a289 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -162,7 +162,7 @@
;; [Resources]
(defn compile-lambda [compile *type* ?scope ?closure ?args ?body with-datum? instance?]
- (prn 'compile-lambda ?scope ?closure ?args ?body)
+ ;; (prn 'compile-lambda ?scope ?closure ?args ?body)
(exec [:let [lambda-class (&host/location ?scope)
impl-signature (lambda-impl-signature ?args)
<init>-sig (lambda-<init>-signature ?closure ?args)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index bd09b603f..60a5dbdc0 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -80,32 +80,32 @@
(defn compile-tuple [compile *type* ?elems]
(exec [*writer* &/get-writer
:let [num-elems (count ?elems)
- tuple-class (&host/->class (str &host/tuple-class num-elems))
_ (doto *writer*
- (.visitTypeInsn Opcodes/NEW tuple-class)
- (.visitInsn Opcodes/DUP)
- (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "<init>" "()V"))]
- _ (map-m (fn [idx]
- (exec [:let [_ (.visitInsn *writer* Opcodes/DUP)]
- ret (compile (nth ?elems idx))
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str &&/tuple-field-prefix idx) "Ljava/lang/Object;")]]
+ (.visitLdcInsn (int num-elems))
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
+ _ (map-m (fn [[idx elem]]
+ (exec [:let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx)))]
+ ret (compile elem)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return ret)))
- (range num-elems))]
+ (map vector (range num-elems) ?elems))]
(return nil)))
(defn compile-variant [compile *type* ?tag ?value]
(exec [*writer* &/get-writer
- :let [variant-class* (&host/->class &host/variant-class)
- _ (doto *writer*
- (.visitTypeInsn Opcodes/NEW variant-class*)
- (.visitInsn Opcodes/DUP)
- (.visitMethodInsn Opcodes/INVOKESPECIAL variant-class* "<init>" "()V")
+ :let [_ (doto *writer*
+ (.visitLdcInsn (int 2))
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object"))
(.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int 0))
(.visitLdcInsn ?tag)
- (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" (&host/->type-signature "java.lang.String"))
- (.visitInsn Opcodes/DUP))]
+ (.visitInsn Opcodes/AASTORE)
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int 1)))]
_ (compile ?value)
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD variant-class* "value" (&host/->type-signature "java.lang.Object"))]]
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
(defn compile-local [compile *type* ?idx]
@@ -184,7 +184,7 @@
(fail "Can only define expressions."))))
(defn compile-self-call [compile ?scope ?assumed-args]
- (prn 'compile-self-call ?scope ?assumed-args)
+ ;; (prn 'compile-self-call ?scope ?assumed-args)
(exec [*writer* &/get-writer
:let [lambda-class (&host/location ?scope)]
:let [_ (doto *writer*
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 05a2b53ba..7490bf152 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -10,8 +10,6 @@
;; [Constants]
(def prefix "lux.")
-(def variant-class (str prefix "Variant"))
-(def tuple-class (str prefix "Tuple"))
(def function-class (str prefix "Function"))
;; [Utils]
@@ -129,7 +127,7 @@
(defn <name> [target method-name args]
(let [target (Class/forName target)]
(if-let [method (first (for [=method (.getMethods target)
- :let [_ (prn '<name> '=method =method (mapv #(.getName %) (.getParameterTypes =method)))]
+ ;; :let [_ (prn '<name> '=method =method (mapv #(.getName %) (.getParameterTypes =method)))]
:when (and (= target (.getDeclaringClass =method))
(= method-name (.getName =method))
(= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index 447387649..e7c54d8ac 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -5,25 +5,15 @@
;; [Utils]
(defn ^:private ->lux+ [->lux loader xs]
(reduce (fn [tail x]
- (doto (.newInstance (.loadClass loader "lux.Variant"))
- (-> .-tag (set! "Cons"))
- (-> .-value (set! (doto (.newInstance (.loadClass loader "lux.Tuple2"))
- (-> .-_0 (set! (->lux loader x)))
- (-> .-_1 (set! tail)))))))
- (doto (.newInstance (.loadClass loader "lux.Variant"))
- (-> .-tag (set! "Nil"))
- (-> .-value (set! (.newInstance (.loadClass loader "lux.Tuple0")))))
+ (to-array ["Cons" (to-array [(->lux loader x) tail])]))
+ (to-array ["Nil" (to-array [])])
(reverse xs)))
(defn ^:private ->lux-one [loader tag value]
- (doto (.newInstance (.loadClass loader "lux.Variant"))
- (-> .-tag (set! tag))
- (-> .-value (set! value))))
+ (to-array [tag value]))
(defn ^:private ->lux-many [->lux loader tag values]
- (doto (.newInstance (.loadClass loader "lux.Variant"))
- (-> .-tag (set! tag))
- (-> .-value (set! (->lux+ ->lux loader values)))))
+ (to-array [tag (->lux+ ->lux loader values)]))
(defn ^:private ->lux [loader x]
(match x
@@ -48,24 +38,24 @@
))
(defn ^:private ->clojure+ [->clojure xs]
- (case (.-tag xs)
+ (case (aget xs 0)
"Nil" (list)
- "Cons" (let [tuple2 (.-value xs)]
- (cons (->clojure (.-_0 tuple2))
- (->clojure+ ->clojure (.-_1 tuple2))))
+ "Cons" (let [tuple2 (aget xs 1)]
+ (cons (->clojure (aget tuple2 0))
+ (->clojure+ ->clojure (aget tuple2 1))))
))
(defn ^:private ->clojure [x]
- (case (.-tag x)
- "Bool" [::&parser/Bool (.-value x)]
- "Int" [::&parser/Int (.-value x)]
- "Real" [::&parser/Real (.-value x)]
- "Char" [::&parser/Char (.-value x)]
- "Text" [::&parser/Text (.-value x)]
- "Tag" [::&parser/Tag (.-value x)]
- "Ident" [::&parser/Ident (.-value x)]
- "Tuple" [::&parser/Tuple (->clojure+ ->clojure (.-value x))]
- "Form" [::&parser/Form (->clojure+ ->clojure (.-value x))]))
+ (case (aget x 0)
+ "Bool" [::&parser/Bool (aget x 1)]
+ "Int" [::&parser/Int (aget x 1)]
+ "Real" [::&parser/Real (aget x 1)]
+ "Char" [::&parser/Char (aget x 1)]
+ "Text" [::&parser/Text (aget x 1)]
+ "Tag" [::&parser/Tag (aget x 1)]
+ "Ident" [::&parser/Ident (aget x 1)]
+ "Tuple" [::&parser/Tuple (->clojure+ ->clojure (aget x 1))]
+ "Form" [::&parser/Form (->clojure+ ->clojure (aget x 1))]))
;; [Resources]
(defn expand [loader macro-class tokens]
@@ -73,15 +63,7 @@
.getDeclaredConstructors
first
(.newInstance (to-array [(int 0) nil]))
- ((fn [macro] (prn 'macro macro "#1") macro))
(.apply (->lux+ ->lux loader tokens))
- ;; (.impl (->lux+ ->lux loader tokens) nil)
- ((fn [macro] (prn 'macro macro "#2") macro))
- (.apply nil)
- ((fn [macro] (prn 'macro macro "#3") macro))
- ;; (.apply nil)
- ;; ((fn [macro] (prn 'macro macro "#4?") macro))
- )
- _ (prn 'expand/output macro-class output (->> output .-_0 (->clojure+ ->clojure)))]
- [(->> output .-_0 (->clojure+ ->clojure))
- (.-_1 output)]))
+ (.apply nil))]
+ [(->clojure+ ->clojure (aget output 0))
+ (aget output 1)]))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 10:43:29 +0000