aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux312
-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
7 files changed, 346 insertions, 135 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 30a0c6628..b400e0da8 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -277,18 +277,6 @@
(~ body)))
(map second pairs)])))))))
-## (defmacro (do tokens)
-## (case tokens
-## (list (#Tuple bindings) body)
-## (let [output (fold (lambda [inner binding]
-## (case binding
-## [lhs rhs]
-## (' (bind (lambda [(~ lhs)] (~ body))
-## (~ rhs)))))
-## body
-## (reverse (as-pairs bindings)))]
-## (return (list output)))))
-
(defmacro (export tokens)
(return (map (lambda [t] (` (export' (~ t))))
tokens)))
@@ -432,36 +420,6 @@
(#Cons [from (range (inc from) to)])
#Nil))
-## (defmacro (case tokens)
-## (case' tokens
-## (#Cons value branches)
-## (loop [kind #Pattern
-## pieces branches
-## new-pieces (list)]
-## (case' pieces
-## #Nil
-## (return (list (' (case' (~ value) (~@ new-pieces)))))
-
-## (#Cons piece pieces')
-## (let [[kind' expanded more-pieces] (case' kind
-## #Body
-## [#Pattern (list piece) #Nil]
-
-## #Pattern
-## (do [expansion (macro-expand piece)]
-## (case' expansion
-## #Nil
-## [#Pattern #Nil #Nil]
-
-## (#Cons exp #Nil)
-## [#Body (list exp) #Nil]
-
-## (#Cons exp exps)
-## [#Body (list exp) exps]))
-## )]
-## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
-## )))
-
(def (tuple->list tuple)
(case' tuple
(#Tuple list)
@@ -593,23 +551,23 @@
(defmacro (get@ tokens)
(let [output (case' tokens
- (#Cons [(#Tag tag) (#Cons [record #Nil])])
- (` (get@' (~ (#Tag tag)) (~ record)))
+ (#Cons [tag (#Cons [record #Nil])])
+ (` (get@' (~ tag) (~ record)))
- (#Cons [(#Tag tag) #Nil])
- (` (lambda [record] (get@' (~ (#Tag tag)) record))))]
+ (#Cons [tag #Nil])
+ (` (lambda [record] (get@' (~ tag) record))))]
(return (list output))))
(defmacro (set@ tokens)
(let [output (case' tokens
- (#Cons [(#Tag tag) (#Cons [value (#Cons [record #Nil])])])
- (` (set@' (~ (#Tag tag)) (~ value) (~ record)))
+ (#Cons [tag (#Cons [value (#Cons [record #Nil])])])
+ (` (set@' (~ tag) (~ value) (~ record)))
- (#Cons [(#Tag tag) (#Cons [value #Nil])])
- (` (lambda [record] (set@' (~ (#Tag tag)) (~ value) record)))
+ (#Cons [tag (#Cons [value #Nil])])
+ (` (lambda [record] (set@' (~ tag) (~ value) record)))
- (#Cons [(#Tag tag) #Nil])
- (` (lambda [value record] (set@' (~ (#Tag tag)) value record))))]
+ (#Cons [tag #Nil])
+ (` (lambda [value record] (set@' (~ tag) value record))))]
(return (list output))))
(defmacro (update@ tokens)
@@ -627,6 +585,10 @@
(set@' (~ tag) record (func (get@' (~ tag) record))))))]
(return (list output))))
+(def (show-int int)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ int []))
+
(def gen-ident
(lambda [state]
[(update@ #gen-seed inc state)
@@ -641,96 +603,183 @@
## [first f]
## [second s])
+(def (show-syntax syntax)
+ (case' syntax
+ (#Bool value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Int value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Real value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Char value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Text value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Ident ident)
+ ident
+
+ (#Tag tag)
+ (text-++ "#" tag)
+
+ (#Tuple members)
+ ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]")
+
+ (#Form members)
+ ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")")
+ ))
+
+(defmacro (do tokens)
+ (case' tokens
+ (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
+ (let [output (fold (lambda [body binding]
+ (case' binding
+ [lhs rhs]
+ (` (bind (lambda [(~ lhs)] (~ body))
+ (~ rhs)))))
+ body
+ (reverse (as-pairs bindings)))]
+ (return (list output)))))
+
+(def (map% f xs)
+ (case' xs
+ #Nil
+ (return xs)
+
+ (#Cons [x xs'])
+ (do [y (f x)
+ ys (map% f xs')]
+ (return (#Cons [y ys])))))
+
(defmacro (type tokens)
- (case tokens
- (#Tuple elems)
- (return (list (' (#Tuple (~ (map untemplate elems))))))
-
- (#Record fields)
- (return (list (' (#Record (~ (map (lambda [kv]
- (case kv
- [(#Tag tag) val]
- [tag (untemplate val)]))
- fields))))))
-
- (#Form (list+ (#Ident "|") options))
- (do [options' (map% (lambda [opt]
- (case opt
- (#Tag tag)
- [tag (#Tuple (list))]
-
- (#Form (list (#Tag tag) value))
- [tag value]
-
- _
- (fail "")))
- options)]
- (#Variant options'))
- ))
+ (case' tokens
+ (#Tuple elems)
+ (return (list (` (#Tuple (~ (map untemplate elems))))))
+
+ (#Record fields)
+ (return (list (` (#Record (~ (map (lambda [kv]
+ (case' kv
+ [(#Tag tag) val]
+ [tag (untemplate val)]))
+ fields))))))
+
+ (#Form (#Cons [(#Ident "|") options]))
+ (do [options' (map% (lambda [opt]
+ (case' opt
+ (#Tag tag)
+ (return [tag (#Tuple (list))])
+
+ (#Form (#Cons [(#Tag tag) (#Cons [value #Nil])]))
+ (return [tag value])
+
+ _
+ (fail "")))
+ options)]
+ (return (list (#Variant options'))))))
(defmacro (All tokens)
- (let [[name args body] (case tokens
- (list (#Tuple args) body)
- ["" args body]
-
- (list (#Ident name) (#Tuple args) body)
- [name args body])]
- (return (list (' (#All (~ name) [(~@ (map (lambda [arg]
- (case arg
- (#Ident arg')
- (#Text arg')))
- args))]
- (~ body)))))))
+ (let [[name args body] (case' tokens
+ (#Cons [(#Tuple args) (#Cons [body #Nil])])
+ [(#Text "") args body]
+
+ (#Cons [(#Ident name) (#Cons [(#Tuple args) (#Cons [body #Nil])])])
+ [(#Text name) args body])]
+ (return (list (#Form (list (#Tag "All")
+ name
+ (#Tuple (map (lambda [arg]
+ (case' arg
+ (#Ident arg')
+ (#Text arg')))
+ args))
+ body))))))
(defmacro (Exists tokens)
- (case tokens
- (list (#Ident name) body)
- (return (list (' (#Exists (~ name) (~ body)))))))
+ (case' tokens
+ (#Cons [(#Ident name) (#Cons [body #Nil])])
+ (return (list (` (#Exists (~ name) (~ body)))))))
(defmacro (deftype tokens)
- (case tokens
- (list (#Ident name) definition)
- (return (list (' (def (~ (#Ident name))
- (type (~ definition))))))
-
- (list (#Form (list+ (#Ident name) args)) definition)
- (let [name' (#Ident name)]
- (return (list (' (def (~ name')
- (All (~ name') [(~@ args)]
- (type (~ definition))))))))
- ))
+ (case' tokens
+ (#Cons [(#Form (#Cons [name args])) (#Cons [definition #Nil])])
+ (return (list (` (def (~ name)
+ (All (~ name) [(~@ args)]
+ (type (~ definition)))))))
+
+ (#Cons [name (#Cons [definition #Nil])])
+ (return (list (` (def (~ name)
+ (type (~ definition))))))
+ ))
(defmacro ($keys tokens)
- (case tokens
- (list (#Tuple fields))
- (let [record (#Record (map (lambda [slot]
- (case slot
- (#Tag name)
- [(#Tag name) (#Ident name)]))
- fields))]
- (return (list record)))))
+ (case' tokens
+ (#Cons [(#Tuple fields) #Nil])
+ (return (list (#Record (map (lambda [slot]
+ (case' slot
+ (#Tag name)
+ [(#Tag name) (#Ident name)]))
+ fields))))))
(defmacro ($or tokens)
- (case tokens
- (list (#Tuple patterns) body)
- (return (flat-map (lambda [pattern] (list pattern body))
- patterns))))
+ (case' tokens
+ (#Cons [(#Tuple patterns) (#Cons [body #Nil])])
+ (return (flat-map (lambda [pattern] (list pattern body))
+ patterns))))
(defmacro (-> tokens)
- (case (reverse tokens)
- (#Cons [f-return f-args])
- (fold (lambda [f-return f-arg]
- (#Lambda [f-arg f-return]))
- f-return f-args)))
+ (case' (reverse tokens)
+ (#Cons [f-return f-args])
+ (fold (lambda [f-return f-arg]
+ (#Lambda [f-arg f-return]))
+ f-return f-args)))
+
+## (defmacro (case tokens)
+## (case' tokens
+## (#Cons value branches)
+## (loop [kind #Pattern
+## pieces branches
+## new-pieces (list)]
+## (case' pieces
+## #Nil
+## (return (list (' (case' (~ value) (~@ new-pieces)))))
-(def (defsyntax tokens)
- ...)
+## (#Cons piece pieces')
+## (let [[kind' expanded more-pieces] (case' kind
+## #Body
+## [#Pattern (list piece) #Nil]
+
+## #Pattern
+## (do [expansion (macro-expand piece)]
+## (case' expansion
+## #Nil
+## [#Pattern #Nil #Nil]
+
+## (#Cons exp #Nil)
+## [#Body (list exp) #Nil]
+
+## (#Cons exp exps)
+## [#Body (list exp) exps]))
+## )]
+## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
+## )))
+
+
+## (def (defsyntax tokens)
+## ...)
-(def (defsig tokens)
- ...)
+## (def (defsig tokens)
+## ...)
-(def (defstruct tokens)
- ...)
+## (def (defstruct tokens)
+## ...)
## (def (with tokens)
## ...)
@@ -740,7 +789,15 @@
## TODO: (Im|Ex)ports-related macros
## TODO: Macro-related macros
-#(
+## (deftype (List a)
+## (|| #Nil (#Cons [a (List a)])))
+
+## (deftype User
+## (&& (#name Text) (#age Int)))
+
+## (deftype User
+## (** Text Int))
+
## (import "lux")
## (module-alias "lux" "l")
## (def-alias "lux;map" "map")
@@ -761,4 +818,3 @@
## (deftype (List a)
## (| #Nil
## (#Cons [a (List a)])))
-)#
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-26 00:35:44 +0000