aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj9
-rw-r--r--src/lux/analyser/base.clj2
-rw-r--r--src/lux/analyser/lux.clj22
-rw-r--r--src/lux/compiler.clj9
-rw-r--r--src/lux/compiler/host.clj12
-rw-r--r--src/lux/compiler/lux.clj115
6 files changed, 162 insertions, 7 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 8f05232a2..a26ee44b2 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -35,6 +35,9 @@
[::&parser/Tuple ?elems]
(&&lux/analyse-tuple analyse-ast ?elems)
+ [::&parser/Record ?elems]
+ (&&lux/analyse-record analyse-ast ?elems)
+
[::&parser/Tag ?tag]
(let [tuple-type [::&type/Tuple (list)]]
(return (list [::&&/Expression [::&&/variant ?tag [::&&/Expression [::&&/tuple (list)] tuple-type]]
@@ -49,6 +52,12 @@
[::&parser/Form ([[::&parser/Ident "lambda'"] [::&parser/Ident ?self] [::&parser/Ident ?arg] ?body] :seq)]
(&&lux/analyse-lambda analyse-ast ?self ?arg ?body)
+ [::&parser/Form ([[::&parser/Ident "get@'"] [::&parser/Tag ?slot] ?record] :seq)]
+ (&&lux/analyse-get analyse-ast ?slot ?record)
+
+ [::&parser/Form ([[::&parser/Ident "set@'"] [::&parser/Tag ?slot] ?value ?record] :seq)]
+ (&&lux/analyse-set analyse-ast ?slot ?value ?record)
+
[::&parser/Form ([[::&parser/Ident "def'"] [::&parser/Ident ?name] ?value] :seq)]
(&&lux/analyse-def analyse-ast ?name ?value)
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index f9028673d..66451e97b 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -12,7 +12,7 @@
(return type)
_
- (fail "[Analyser Error] Can't retrieve the type of a non-expression.")))
+ (fail (str "[Analyser Error] Can't retrieve the type of a non-expression: " (pr-str syntax+)))))
(defn analyse-1 [analyse elem]
(exec [output (analyse elem)]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 75b6f375a..82f6eb4da 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -22,6 +22,19 @@
]
(return (list [::&&/Expression [::&&/tuple =elems] [::&type/Tuple =elems-types]]))))
+(defn analyse-record [analyse ?elems]
+ (exec [=elems (mapcat-m (fn [[k v]]
+ (exec [=v (&&/analyse-1 analyse v)]
+ (return [k =v])))
+ ?elems)
+ =elems-types (map-m (fn [[k v]]
+ (exec [=v (&&/expr-type v)]
+ (return [k =v])))
+ =elems)
+ ;; :let [_ (prn 'analyse-tuple =elems)]
+ ]
+ (return (list [::&&/Expression [::&&/record =elems] [::&type/Record =elems-types]]))))
+
(defn analyse-ident [analyse ident]
(exec [module-name &/get-module-name]
(fn [state]
@@ -108,6 +121,15 @@
(&type/clean =lambda-type))]
(return (list [::&&/Expression [::&&/lambda =scope =captured ?arg =body] =lambda-type]))))
+(defn analyse-get [analyse ?slot ?record]
+ (exec [=record (&&/analyse-1 analyse ?record)]
+ (return (list [::&&/Expression [::&&/get ?slot =record] &type/+dont-care-type+]))))
+
+(defn analyse-set [analyse ?slot ?value ?record]
+ (exec [=value (&&/analyse-1 analyse ?value)
+ =record (&&/analyse-1 analyse ?record)]
+ (return (list [::&&/Expression [::&&/set ?slot =value =record] &type/+dont-care-type+]))))
+
(defn analyse-def [analyse ?name ?value]
;; (prn 'analyse-def ?name ?value)
(exec [module-name &/get-module-name]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 79682754c..cef1cb710 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -51,6 +51,9 @@
[::&a/tuple ?elems]
(&&lux/compile-tuple compile-expression ?type ?elems)
+ [::&a/record ?elems]
+ (&&lux/compile-record compile-expression ?type ?elems)
+
[::&a/local ?idx]
(&&lux/compile-local compile-expression ?type ?idx)
@@ -72,6 +75,12 @@
[::&a/lambda ?scope ?env ?args ?body]
(&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
+ [::&a/get ?slot ?record]
+ (&&lux/compile-get compile-expression ?type ?slot ?record)
+
+ [::&a/set ?slot ?value ?record]
+ (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
+
;; Integer arithmetic
[::&a/jvm-iadd ?x ?y]
(&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index f1a6492b9..f50ab719f 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -161,13 +161,13 @@
compile-jvm-llt Opcodes/LCMP Opcodes/IFLT "java.lang.Long" "longValue" "()J"
compile-jvm-lgt Opcodes/LCMP Opcodes/IFGT "java.lang.Long" "longValue" "()J"
- compile-jvm-feq Opcodes/FCMPL Opcodes/IFEQ "java.lang.Float" "floatValue" "()F"
- compile-jvm-flt Opcodes/FCMPL Opcodes/IFLT "java.lang.Float" "floatValue" "()F"
- compile-jvm-fgt Opcodes/FCMPL Opcodes/IFGT "java.lang.Float" "floatValue" "()F"
+ compile-jvm-feq Opcodes/FCMPG Opcodes/IFEQ "java.lang.Float" "floatValue" "()F"
+ compile-jvm-flt Opcodes/FCMPG Opcodes/IFLT "java.lang.Float" "floatValue" "()F"
+ compile-jvm-fgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Float" "floatValue" "()F"
- compile-jvm-deq Opcodes/DCMPL Opcodes/IFEQ "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dlt Opcodes/DCMPL Opcodes/IFLT "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dgt Opcodes/FCMPL Opcodes/IFGT "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-deq Opcodes/DCMPG Opcodes/IFEQ "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-dlt Opcodes/DCMPG Opcodes/IFLT "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-dgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Double" "doubleValue" "()I"
)
(defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 2b6c7909e..0aff48750 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -66,6 +66,28 @@
(map vector (range num-elems) ?elems))]
(return nil)))
+(defn compile-record [compile *type* ?elems]
+ (exec [*writer* &/get-writer
+ :let [num-elems (count ?elems)
+ _ (doto *writer*
+ (.visitLdcInsn (int (* 2 num-elems)))
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
+ _ (map-m (fn [[idx [k v]]]
+ (exec [:let [idx* (* 2 idx)
+ _ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx*))
+ (.visitLdcInsn k)
+ (.visitInsn Opcodes/AASTORE))]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int (inc idx*))))]
+ ret (compile v)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret)))
+ (map vector (range num-elems) ?elems))]
+ (return nil)))
+
(defn compile-variant [compile *type* ?tag ?value]
(exec [*writer* &/get-writer
:let [_ (doto *writer*
@@ -112,6 +134,99 @@
?args)]
(return nil)))
+(defn compile-get [compile *type* ?slot ?record]
+ (exec [*writer* &/get-writer
+ _ (compile ?record)
+ :let [$then (new Label)
+ $test-else (new Label)
+ $end (new Label)
+ $start (new Label)
+ _ (doto *writer* ;; record
+ (.visitInsn Opcodes/DUP) ;; record, record
+ (.visitInsn Opcodes/ARRAYLENGTH) ;; record, length
+ (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+ (.visitInsn Opcodes/ISUB) ;; record, length--
+
+ (.visitLabel $start)
+ (.visitInsn Opcodes/DUP) ;; record, length, length
+ (.visitLdcInsn (int -2)) ;; record, length, length, -2
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; record, length
+ ;;;
+ (.visitInsn Opcodes/DUP2) ;; record, length, record, length
+ (.visitInsn Opcodes/AALOAD) ;; record, length, aslot
+ (.visitLdcInsn ?slot) ;; record, length, aslot, eslot
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Object") "equals" (str "(" (&host/->type-signature "java.lang.Object") ")Z")) ;; record, length, Z
+ (.visitJumpInsn Opcodes/IFEQ $test-else) ;; record, length
+ (.visitInsn Opcodes/ICONST_1) ;; record, length, 1
+ (.visitInsn Opcodes/IADD) ;; record, length+
+ (.visitInsn Opcodes/AALOAD) ;; value
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $test-else)
+ (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+ (.visitInsn Opcodes/ISUB) ;; record, length--
+ (.visitJumpInsn Opcodes/GOTO $start)
+ ;;;
+ (.visitLabel $then)
+ (.visitInsn Opcodes/POP) ;; record
+ (.visitInsn Opcodes/POP) ;;
+ (.visitInsn Opcodes/ACONST_NULL) ;; null
+ (.visitLabel $end))]]
+ (return nil)))
+
+(let [o-sig (&host/->type-signature "java.lang.Object")]
+ (defn compile-set [compile *type* ?slot ?value ?record]
+ (exec [*writer* &/get-writer
+ _ (compile ?record)
+ :let [$then (new Label)
+ $test-else (new Label)
+ $end (new Label)
+ $start (new Label)
+ _ (doto *writer* ;; record1
+ ;;;
+ (.visitInsn Opcodes/DUP) ;; record1, record1
+ (.visitInsn Opcodes/ARRAYLENGTH) ;; record1, length1
+ (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) ;; record1, record2
+ (.visitInsn Opcodes/DUP_X1) ;; record2, record1, record2
+ (.visitInsn Opcodes/ICONST_0) ;; record2, record1, record2, 0
+ (.visitInsn Opcodes/SWAP) ;; record2, record1, 0, record2
+ (.visitInsn Opcodes/DUP) ;; record2, record1, 0, record2, record2
+ (.visitInsn Opcodes/ARRAYLENGTH) ;; record2, record1, 0, record2, length2
+ (.visitInsn Opcodes/ICONST_0) ;; record2, record1, 0, record2, length2, 0
+ (.visitInsn Opcodes/SWAP) ;; record2, record1, 0, record2, 0, length2
+ (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class "java.lang.System") "arraycopy" (str "(" o-sig "I" o-sig "I" "I" ")V")) ;; record2
+ ;;;
+ (.visitInsn Opcodes/DUP) ;; record, record
+ (.visitInsn Opcodes/ARRAYLENGTH) ;; record, length
+ (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+ (.visitInsn Opcodes/ISUB) ;; record, length--
+
+ (.visitLabel $start)
+ (.visitInsn Opcodes/DUP) ;; record, length, length
+ (.visitLdcInsn (int -2)) ;; record, length, length, -2
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; record, length
+ ;;;
+ (.visitInsn Opcodes/DUP2) ;; record, length, record, length
+ (.visitInsn Opcodes/AALOAD) ;; record, length, aslot
+ (.visitLdcInsn ?slot) ;; record, length, aslot, eslot
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Object") "equals" (str "(" (&host/->type-signature "java.lang.Object") ")Z")) ;; record, length, Z
+ (.visitJumpInsn Opcodes/IFEQ $test-else) ;; record, length
+ (.visitInsn Opcodes/DUP2) ;; record, length, record, length
+ (.visitInsn Opcodes/ICONST_1) ;; record, length, record, length, 1
+ (.visitInsn Opcodes/IADD) ;; record, length, record, length+
+ (do (compile ?value)) ;; record, length, record, length+, value
+ (.visitInsn Opcodes/AASTORE) ;; record, length
+ (.visitInsn Opcodes/POP) ;; record
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $test-else)
+ (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+ (.visitInsn Opcodes/ISUB) ;; record, length--
+ (.visitJumpInsn Opcodes/GOTO $start)
+ ;;;
+ (.visitLabel $then)
+ (.visitInsn Opcodes/POP) ;; record
+ (.visitLabel $end))]]
+ (return nil))))
+
(defn compile-def [compile ?name ?body]
(exec [*writer* &/get-writer
module-name &/get-module-name
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 13:46:35 +0000