aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/generator')
-rw-r--r--new-luxc/source/luxc/generator/base.jvm.lux29
-rw-r--r--new-luxc/source/luxc/generator/common.jvm.lux130
-rw-r--r--new-luxc/source/luxc/generator/eval.jvm.lux89
-rw-r--r--new-luxc/source/luxc/generator/expr.jvm.lux55
-rw-r--r--new-luxc/source/luxc/generator/primitive.jvm.lux44
-rw-r--r--new-luxc/source/luxc/generator/runtime.jvm.lux126
-rw-r--r--new-luxc/source/luxc/generator/statement.jvm.lux25
-rw-r--r--new-luxc/source/luxc/generator/structure.jvm.lux70
8 files changed, 568 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/generator/base.jvm.lux b/new-luxc/source/luxc/generator/base.jvm.lux
new file mode 100644
index 000000000..01a97aec4
--- /dev/null
+++ b/new-luxc/source/luxc/generator/base.jvm.lux
@@ -0,0 +1,29 @@
+(;module:
+ lux
+ (lux (control monad)
+ [io #- run]
+ (concurrency ["A" atom])
+ (data [text]
+ text/format)
+ host)
+ (luxc ["&" base]))
+
+(jvm-import java.lang.Class)
+(jvm-import java.lang.ClassLoader)
+(jvm-import org.objectweb.asm.MethodVisitor)
+
+(type: Blob Byte-Array)
+
+(type: JVM-State
+ {#visitor (Maybe MethodVisitor)
+ #loader ClassLoader
+ #store (A;Atom (D;Dict Text Blob))
+ })
+
+(def: host-state
+ JVM-State
+ (let [store (A;new (D;new text;Hash<Text>))]
+ {#visitor #;None
+ #loader (memory-class-loader store)
+ #store store
+ }))
diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux
new file mode 100644
index 000000000..e5d3552c4
--- /dev/null
+++ b/new-luxc/source/luxc/generator/common.jvm.lux
@@ -0,0 +1,130 @@
+(;module:
+ lux
+ (lux [io]
+ (concurrency ["A" atom])
+ (data ["R" result]
+ (coll ["d" dict])
+ text/format)
+ [macro #+ Monad<Lux>]
+ [host #+ jvm-import do-to]))
+
+## [Host]
+(jvm-import org.objectweb.asm.Opcodes
+ (#static V1_6 int)
+ (#static CHECKCAST int)
+ (#static INVOKESTATIC int)
+ (#static INVOKEVIRTUAL int))
+
+(jvm-import org.objectweb.asm.MethodVisitor
+ (visitLdcInsn [Object] void)
+ (visitTypeInsn [int String] void)
+ (visitMethodInsn [int String String String boolean] void))
+
+(jvm-import java.lang.Object
+ (toString [] String))
+
+(jvm-import (java.lang.Class a))
+
+(jvm-import java.lang.ClassLoader
+ (loadClass [String] (Class Object)))
+
+## [Types]
+(type: #export Bytecode host;Byte-Array)
+
+(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))
+
+(type: #export Host
+ {#visitor (Maybe MethodVisitor)
+ #loader ClassLoader
+ #store Class-Store})
+
+(def: #export unit Text "\u0000")
+
+(def: (visitor::get compiler)
+ (-> Compiler (Maybe MethodVisitor))
+ (|> (get@ #;host compiler)
+ (:! Host)
+ (get@ #visitor)))
+
+(def: (visitor::put ?visitor compiler)
+ (-> (Maybe MethodVisitor) Compiler Compiler)
+ (update@ #;host
+ (function [host]
+ (|> host
+ (:! Host)
+ (set@ #visitor ?visitor)
+ (:! Void)))
+ compiler))
+
+(def: #export get-visitor
+ (Lux MethodVisitor)
+ (function [compiler]
+ (case (visitor::get compiler)
+ #;None
+ (#R;Error "No visitor has been set.")
+
+ (#;Some visitor)
+ (#R;Success [compiler visitor]))))
+
+(def: #export (with-visitor visitor body)
+ (All [a] (-> MethodVisitor (Lux a) (Lux a)))
+ (function [compiler]
+ (case (macro;run' (visitor::put (#;Some visitor) compiler) body)
+ (#R;Error error)
+ (#R;Error error)
+
+ (#R;Success [compiler' output])
+ (#R;Success [(visitor::put (visitor::get compiler) compiler')
+ output]))))
+
+(def: #export (store-class name byte-code)
+ (-> Text Bytecode (Lux Unit))
+ (function [compiler]
+ (let [store (|> (get@ #;host compiler)
+ (:! Host)
+ (get@ #store))]
+ (if (d;contains? name (|> store A;get io;run))
+ (#R;Error (format "Cannot store class that already exists: " name))
+ (#R;Success [compiler (io;run (A;update (d;put name byte-code) store))])
+ ))))
+
+(def: #export (load-class name)
+ (-> Text (Lux (Class Object)))
+ (function [compiler]
+ (let [host (:! Host (get@ #;host compiler))
+ store (|> host (get@ #store) A;get io;run)]
+ (if (d;contains? name store)
+ (#R;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
+ (#R;Error (format "Unknown class: " name))))))
+
+
+(do-template [<wrap> <unwrap> <class> <unwrap-method> <prim> <dup>]
+ [(def: #export (<wrap> writer)
+ (-> MethodVisitor MethodVisitor)
+ (do-to writer
+ (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC
+ <class> "valueOf" (format "(" <prim> ")" "L" <class> ";")
+ false])))
+ (def: #export (<unwrap> writer)
+ (-> MethodVisitor MethodVisitor)
+ (do-to writer
+ (MethodVisitor.visitTypeInsn [Opcodes.CHECKCAST <class>])
+ (MethodVisitor.visitMethodInsn [Opcodes.INVOKEVIRTUAL
+ <class> <unwrap-method> (format "()" <prim>)
+ false])))]
+
+ [wrap-boolean unwrap-boolean "java/lang/Boolean" "booleanValue" "Z" Opcodes.DUP_X1]
+ [wrap-byte unwrap-byte "java/lang/Byte" "byteValue" "B" Opcodes.DUP_X1]
+ [wrap-short unwrap-short "java/lang/Short" "shortValue" "S" Opcodes.DUP_X1]
+ [wrap-int unwrap-int "java/lang/Integer" "intValue" "I" Opcodes.DUP_X1]
+ [wrap-long unwrap-long "java/lang/Long" "longValue" "J" Opcodes.DUP_X2]
+ [wrap-float unwrap-float "java/lang/Float" "floatValue" "F" Opcodes.DUP_X1]
+ [wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes.DUP_X2]
+ [wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes.DUP_X1]
+ )
+
+(type: #export Flags Int)
+(type: #export Descriptor Text)
+
+(def: #export bytecode-version Flags Opcodes.V1_6)
+(def: #export runtime-class-name Text "LuxRT")
diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux
new file mode 100644
index 000000000..5fcf0b288
--- /dev/null
+++ b/new-luxc/source/luxc/generator/eval.jvm.lux
@@ -0,0 +1,89 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data ["R" result]
+ text/format)
+ [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+ [host #+ jvm-import do-to])
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis])
+ ["&;" analyser]
+ ["&;" synthesizer]
+ (generator ["&;" common])))
+
+(jvm-import java.lang.Object)
+(jvm-import java.lang.String)
+
+(jvm-import java.lang.reflect.Field
+ (get [Object] Object))
+
+(jvm-import (java.lang.Class a)
+ (getField [String] Field))
+
+(jvm-import org.objectweb.asm.Opcodes
+ (#static ACC_PUBLIC int)
+ (#static ACC_SUPER int)
+ (#static ACC_FINAL int)
+ (#static ACC_STATIC int)
+ (#static PUTSTATIC int)
+ (#static RETURN int)
+ (#static V1_6 int)
+ )
+
+(jvm-import org.objectweb.asm.MethodVisitor
+ (visitCode [] void)
+ (visitEnd [] void)
+ (visitLdcInsn [Object] void)
+ (visitFieldInsn [int String String String] void)
+ (visitInsn [int] void)
+ (visitMaxs [int int] void))
+
+(jvm-import org.objectweb.asm.FieldVisitor
+ (visitEnd [] void))
+
+(jvm-import org.objectweb.asm.ClassWriter
+ (#static COMPUTE_MAXS int)
+ (new [int])
+ (visit [int int String String String (Array String)] void)
+ (visitEnd [] void)
+ (visitField [int String String String Object] FieldVisitor)
+ (visitMethod [int String String String (Array String)] MethodVisitor)
+ (toByteArray [] Byte-Array))
+
+(def: (make-field flags name descriptor writer)
+ (-> &common;Flags Text &common;Descriptor ClassWriter FieldVisitor)
+ (do-to (ClassWriter.visitField [flags name descriptor (host;null) (host;null)] writer)
+ (FieldVisitor.visitEnd [])))
+
+(def: eval-field-name Text "_value")
+(def: eval-field-desc Text "Ljava/lang/Object;")
+
+(def: #export (eval generator)
+ (-> (Lux Unit) (Lux Top))
+ (do Monad<Lux>
+ [class-name (:: @ map %code (macro;gensym "eval"))
+ #let [writer (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+ (ClassWriter.visit [&common;bytecode-version
+ (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER)
+ class-name
+ (host;null)
+ "java/lang/Object"
+ (host;null)]))
+ value-field (make-field ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_STATIC Opcodes.ACC_FINAL)
+ eval-field-name eval-field-desc
+ writer)
+ visitor (do-to (ClassWriter.visitMethod [Opcodes.ACC_STATIC "<clinit>" "()V" (host;null) (host;null)] writer)
+ (MethodVisitor.visitCode []))]
+ _ (&common;with-visitor visitor generator)
+ #let [_ (do-to visitor
+ (MethodVisitor.visitFieldInsn [Opcodes.PUTSTATIC class-name eval-field-name eval-field-desc])
+ (MethodVisitor.visitInsn [Opcodes.RETURN])
+ (MethodVisitor.visitMaxs [0 0])
+ (MethodVisitor.visitEnd []))
+ bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
+ _ (&common;store-class class-name bytecode)
+ class (&common;load-class class-name)]
+ (wrap (|> class
+ (Class.getField [eval-field-name])
+ (Field.get (host;null))))))
diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux
new file mode 100644
index 000000000..4b038378a
--- /dev/null
+++ b/new-luxc/source/luxc/generator/expr.jvm.lux
@@ -0,0 +1,55 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data text/format)
+ [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+ [host #+ jvm-import])
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis])
+ ["&;" analyser]
+ ["&;" synthesizer]
+ (generator ["&;" common]
+ ["&;" primitive]
+ ["&;" structure])))
+
+(def: #export (generate synthesis)
+ (-> ls;Synthesis (Lux Unit))
+ (case synthesis
+ #ls;Unit
+ &primitive;generate-unit
+
+ (^template [<tag> <generator>]
+ (<tag> value)
+ (<generator> value))
+ ([#ls;Bool &primitive;generate-bool]
+ [#ls;Nat &primitive;generate-nat]
+ [#ls;Int &primitive;generate-int]
+ [#ls;Deg &primitive;generate-deg]
+ [#ls;Real &primitive;generate-real]
+ [#ls;Char &primitive;generate-char]
+ [#ls;Text &primitive;generate-text])
+
+ (#ls;Variant tag tail? member)
+ (&structure;generate-variant generate tag tail? member)
+
+ (#ls;Tuple members)
+ (&structure;generate-tuple generate members)
+
+ _
+ (macro;fail "Unrecognized synthesis.")))
+
+## (def: (eval type code)
+## &;Eval
+## (undefined))
+
+## (def: analyse
+## &;Analyser
+## (&analyser;analyser eval))
+
+## (def: #export (generate input)
+## (-> Code (Lux Unit))
+## (do Monad<Lux>
+## [analysis (analyse input)
+## #let [synthesis (&synthesizer;synthesize analysis)]]
+## (generate-synthesis synthesis)))
diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux
new file mode 100644
index 000000000..2c879dd48
--- /dev/null
+++ b/new-luxc/source/luxc/generator/primitive.jvm.lux
@@ -0,0 +1,44 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data text/format)
+ [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+ [host #+ jvm-import])
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis])
+ ["&;" analyser]
+ ["&;" synthesizer]
+ (generator ["&;" common])))
+
+(jvm-import #long java.lang.Object)
+
+(jvm-import org.objectweb.asm.Opcodes)
+
+(jvm-import org.objectweb.asm.MethodVisitor
+ (visitLdcInsn [Object] void))
+
+(def: #export generate-unit
+ (Lux Unit)
+ (do Monad<Lux>
+ [visitor &common;get-visitor
+ #let [_ (MethodVisitor.visitLdcInsn [(:! java.lang.Object &common;unit)] visitor)]]
+ (wrap [])))
+
+(do-template [<name> <type> <wrap>]
+ [(def: #export (<name> value)
+ (-> <type> (Lux Unit))
+ (do Monad<Lux>
+ [visitor &common;get-visitor
+ #let [_ (MethodVisitor.visitLdcInsn [(:! java.lang.Object value)] visitor)
+ _ (<wrap> visitor)]]
+ (wrap [])))]
+
+ [generate-bool Bool &common;wrap-boolean]
+ [generate-nat Nat &common;wrap-long]
+ [generate-int Int &common;wrap-long]
+ [generate-deg Deg &common;wrap-long]
+ [generate-real Real &common;wrap-double]
+ [generate-char Char &common;wrap-char]
+ [generate-text Text id]
+ )
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
new file mode 100644
index 000000000..e8831d005
--- /dev/null
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -0,0 +1,126 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data ["R" result]
+ text/format)
+ [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+ [host #+ jvm-import do-to])
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis])
+ ["&;" analyser]
+ ["&;" synthesizer]
+ (generator ["&;" common])))
+
+(jvm-import java.lang.Object)
+(jvm-import java.lang.String)
+
+(jvm-import java.lang.reflect.Field
+ (get [Object] #try Object))
+
+(jvm-import (java.lang.Class a)
+ (getField [String] Field))
+
+(type: Flags Int)
+(type: Descriptor Text)
+
+(jvm-import org.objectweb.asm.Opcodes
+ (#static ACC_PUBLIC int)
+ (#static ACC_SUPER int)
+ (#static ACC_FINAL int)
+ (#static ACC_STATIC int)
+ (#static DUP int)
+ (#static PUTSTATIC int)
+ (#static ILOAD int)
+ (#static ALOAD int)
+ (#static ANEWARRAY int)
+ (#static AASTORE int)
+ (#static RETURN int)
+ (#static ARETURN int)
+ (#static V1_6 int)
+ )
+
+(jvm-import org.objectweb.asm.MethodVisitor
+ (visitCode [] void)
+ (visitEnd [] void)
+ (visitInsn [int] void)
+ (visitLdcInsn [Object] void)
+ (visitFieldInsn [int String String String] void)
+ (visitVarInsn [int int] void)
+ (visitTypeInsn [int String] void)
+ (visitMaxs [int int] void))
+
+(jvm-import org.objectweb.asm.FieldVisitor
+ (visitEnd [] void))
+
+(jvm-import org.objectweb.asm.ClassWriter
+ (#static COMPUTE_MAXS int)
+ (new [int])
+ (visit [int int String String String (Array String)] void)
+ (visitEnd [] void)
+ (visitField [int String String String Object] FieldVisitor)
+ (visitMethod [int String String String (Array String)] MethodVisitor)
+ (toByteArray [] Byte-Array))
+
+(def: (generate-adt-methods writer)
+ (-> ClassWriter ClassWriter)
+ (let [## I commented-out some parts because a null-check was
+ ## done to ensure variants were never created with null
+ ## values (this would interfere later with
+ ## pattern-matching).
+ ## Since Lux itself does not have null values as part of
+ ## the language, the burden of ensuring non-nulls was
+ ## shifted to library code dealing with host-interop, to
+ ## ensure variant-making was as fast as possible.
+ ## The null-checking code was left as comments in case I
+ ## ever change my mind.
+ _ (let [## $is-null (new Label)
+ visitor (ClassWriter.visitMethod [(i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_STATIC)
+ "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"
+ (host;null) (host;null)]
+ writer)
+ _ (do-to visitor
+ (MethodVisitor.visitCode [])
+ ## (MethodVisitor.visitVarInsn [Opcodes.ALOAD 2])
+ ## (MethodVisitor.visitJumpInsn [Opcodes.IFNULL $is-null])
+ (MethodVisitor.visitLdcInsn [(host;l2i 3)])
+ (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"])
+ (MethodVisitor.visitInsn [Opcodes.DUP])
+ (MethodVisitor.visitLdcInsn [(host;l2i 0)])
+ (MethodVisitor.visitVarInsn [Opcodes.ILOAD 0]))
+ _ (&common;wrap-int visitor)
+ _ (do-to visitor
+ (MethodVisitor.visitInsn [Opcodes.AASTORE])
+ (MethodVisitor.visitInsn [Opcodes.DUP])
+ (MethodVisitor.visitLdcInsn [(host;l2i 1)])
+ (MethodVisitor.visitVarInsn [Opcodes.ALOAD 1])
+ (MethodVisitor.visitInsn [Opcodes.AASTORE])
+ (MethodVisitor.visitInsn [Opcodes.DUP])
+ (MethodVisitor.visitLdcInsn [(host;l2i 2)])
+ (MethodVisitor.visitVarInsn [Opcodes.ALOAD 2])
+ (MethodVisitor.visitInsn [Opcodes.AASTORE])
+ (MethodVisitor.visitInsn [Opcodes.ARETURN])
+ ## (MethodVisitor.visitLabel [$is-null])
+ ## (MethodVisitor.visitTypeInsn [Opcodes.NEW "java/lang/IllegalStateException"])
+ ## (MethodVisitor.visitInsn [Opcodes.DUP])
+ ## (MethodVisitor.visitLdcInsn ["Cannot create variant for null pointer"])
+ ## (MethodVisitor.visitMethodInsn [Opcodes.INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "(Ljava/lang/String;)V"])
+ ## (MethodVisitor.visitInsn [Opcodes.ATHROW])
+ (MethodVisitor.visitMaxs [0 0])
+ (MethodVisitor.visitEnd []))]
+ [])]
+ writer))
+
+(def: #export generate
+ (Lux &common;Bytecode)
+ (do Monad<Lux>
+ [_ (wrap [])
+ #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+ (ClassWriter.visit [&common;bytecode-version
+ ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_FINAL Opcodes.ACC_SUPER)
+ &common;runtime-class-name (host;null)
+ "java/lang/Object" (host;null)]))
+ generate-adt-methods)
+ bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
+ _ (&common;store-class &common;runtime-class-name bytecode)]
+ (wrap bytecode)))
diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux
new file mode 100644
index 000000000..96263181f
--- /dev/null
+++ b/new-luxc/source/luxc/generator/statement.jvm.lux
@@ -0,0 +1,25 @@
+(;module:
+ lux
+ (lux (control monad)
+ [io #- run]
+ (data [text "T/" Eq<Text>]
+ text/format)
+ [macro #+ Monad<Lux>])
+ (luxc ["&" base]
+ ["&;" module]
+ ["&;" env]
+ (compiler ["&;" expr])))
+
+(def: #export (compile-def def-name def-value def-meta)
+ (-> Text Code Code (Lux Unit))
+ (do Monad<Lux>
+ [=def-value (&expr;compile def-value)
+ =def-meta (&expr;compile def-meta)]
+ (undefined)))
+
+(def: #export (compile-program prog-args prog-body)
+ (-> Text Code (Lux Unit))
+ (do Monad<Lux>
+ [=prog-body (&env;with-local [prog-args (type (List Text))]
+ (&expr;compile prog-body))]
+ (undefined)))
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
new file mode 100644
index 000000000..1584cb170
--- /dev/null
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -0,0 +1,70 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data text/format
+ (coll [list]))
+ [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+ [host #+ jvm-import do-to])
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis])
+ ["&;" analyser]
+ ["&;" synthesizer]
+ (generator ["&;" common])))
+
+(jvm-import #long java.lang.Object)
+
+(jvm-import org.objectweb.asm.Opcodes
+ (#static ANEWARRAY int)
+ (#static DUP int)
+ (#static AASTORE int)
+ (#static ACONST_NULL int)
+ (#static INVOKESTATIC int))
+
+(jvm-import org.objectweb.asm.MethodVisitor
+ (visitInsn [int] void)
+ (visitLdcInsn [Object] void)
+ (visitTypeInsn [int String] void)
+ (visitMethodInsn [int String String String boolean] void))
+
+(def: #export (generate-tuple generate members)
+ (-> (-> ls;Synthesis (Lux Unit)) (List ls;Synthesis) (Lux Unit))
+ (do Monad<Lux>
+ [#let [size (list;size members)]
+ _ (&;assert "Cannot generate tuples with less than 2 elements."
+ (n.>= +2 size))
+ visitor &common;get-visitor
+ #let [_ (do-to visitor
+ (MethodVisitor.visitLdcInsn [(|> size nat-to-int host;l2i (:! java.lang.Object))])
+ (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"]))]
+ _ (mapM @ (function [[idx member]]
+ (do @
+ [#let [_ (do-to visitor
+ (MethodVisitor.visitInsn [Opcodes.DUP])
+ (MethodVisitor.visitLdcInsn [(|> idx nat-to-int host;l2i (:! java.lang.Object))]))]
+ _ (generate member)
+ #let [_ (MethodVisitor.visitInsn [Opcodes.AASTORE] visitor)]]
+ (wrap [])))
+ (list;enumerate members))]
+ (wrap [])))
+
+(def: (generate-variant-flag tail? visitor)
+ (-> Bool MethodVisitor MethodVisitor)
+ (if tail?
+ (do-to visitor (MethodVisitor.visitLdcInsn [(:! java.lang.Object "")]))
+ (do-to visitor (MethodVisitor.visitInsn [Opcodes.ACONST_NULL]))))
+
+(def: #export (generate-variant generate tag tail? member)
+ (-> (-> ls;Synthesis (Lux Unit)) Nat Bool ls;Synthesis (Lux Unit))
+ (do Monad<Lux>
+ [visitor &common;get-visitor
+ #let [_ (do-to visitor
+ (MethodVisitor.visitLdcInsn [(|> tag nat-to-int host;l2i (:! java.lang.Object))]))
+ _ (generate-variant-flag tail? visitor)]
+ _ (generate member)
+ #let [_ (do-to visitor
+ (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC
+ &common;runtime-class-name
+ "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"
+ false]))]]
+ (wrap [])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 19:15:20 +0000