Split new-luxc into lux-jvm and lux-r.

3 files changed, 893 insertions, 0 deletions

diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux
new file mode 100644
index 000000000..d957bdb1d
--- /dev/null
+++ b/lux-jvm/source/luxc/lang/host/jvm.lux
@@ -0,0 +1,131 @@
+(.module:
+  [lux (#- Definition Type)
+   [host (#+ import:)]
+   [abstract
+    monad]
+   [control
+    ["p" parser
+     ["s" code]]]
+   [data
+    [binary (#+ Binary)]
+    [collection
+     ["." list ("#/." functor)]]]
+   [macro
+    ["." code]
+    [syntax (#+ syntax:)]]
+   [target
+    [jvm
+     ["." type (#+ Type)
+      [category (#+ Class)]]]]
+   [tool
+    [compiler
+     [reference (#+ Register)]
+     [language
+      [lux
+       ["." generation]]]
+     [meta
+      [archive (#+ Archive)]]]]])
+
+(import: org/objectweb/asm/MethodVisitor)
+
+(import: org/objectweb/asm/ClassWriter)
+
+(import: #long org/objectweb/asm/Label
+  (new []))
+
+(type: #export Def
+  (-> ClassWriter ClassWriter))
+
+(type: #export Inst
+  (-> MethodVisitor MethodVisitor))
+
+(type: #export Label
+  org/objectweb/asm/Label)
+
+(type: #export Visibility
+  #Public
+  #Protected
+  #Private
+  #Default)
+
+(type: #export Version
+  #V1_1
+  #V1_2
+  #V1_3
+  #V1_4
+  #V1_5
+  #V1_6
+  #V1_7
+  #V1_8)
+
+(type: #export ByteCode Binary)
+
+(type: #export Definition [Text ByteCode])
+
+(type: #export Anchor [Label Register])
+
+(type: #export Host
+  (generation.Host Inst Definition))
+
+(template [<name> <base>]
+  [(type: #export <name>
+     (<base> ..Anchor Inst Definition))]
+
+  [State     generation.State]
+  [Operation generation.Operation]
+  [Phase     generation.Phase]
+  [Handler   generation.Handler]
+  [Bundle    generation.Bundle]
+  [Extender  generation.Extender]
+  )
+
+(type: #export (Generator i)
+  (-> Phase Archive i (Operation Inst)))
+
+(syntax: (config: {type s.local-identifier}
+           {none s.local-identifier}
+           {++ s.local-identifier}
+           {options (s.tuple (p.many s.local-identifier))})
+  (let [g!type (code.local-identifier type)
+        g!none (code.local-identifier none)
+        g!tags+ (list/map code.local-tag options)
+        g!_left (code.local-identifier "_left")
+        g!_right (code.local-identifier "_right")
+        g!options+ (list/map (function (_ option)
+                               (` (def: (~' #export) (~ (code.local-identifier option))
+                                    (~ g!type)
+                                    (|> (~ g!none)
+                                        (set@ (~ (code.local-tag option)) #1)))))
+                             options)]
+    (wrap (list& (` (type: (~' #export) (~ g!type)
+                      (~ (code.record (list/map (function (_ tag)
+                                                  [tag (` .Bit)])
+                                                g!tags+)))))
+
+                 (` (def: (~' #export) (~ g!none)
+                      (~ g!type)
+                      (~ (code.record (list/map (function (_ tag)
+                                                  [tag (` #0)])
+                                                g!tags+)))))
+
+                 (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right))
+                      (-> (~ g!type) (~ g!type) (~ g!type))
+                      (~ (code.record (list/map (function (_ tag)
+                                                  [tag (` (or (get@ (~ tag) (~ g!_left))
+                                                              (get@ (~ tag) (~ g!_right))))])
+                                                g!tags+)))))
+
+                 g!options+))))
+
+(config: Class-Config  noneC ++C [finalC])
+(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
+(config: Field-Config  noneF ++F [finalF staticF transientF volatileF])
+
+(def: #export new-label
+  (-> Any Label)
+  (function (_ _)
+    (org/objectweb/asm/Label::new)))
+
+(def: #export (simple-class name)
+  (-> Text (Type Class))
+  (type.class name (list)))
diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux
new file mode 100644
index 000000000..f274da61f
--- /dev/null
+++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux
@@ -0,0 +1,298 @@
+(.module:
+  [lux (#- Type)
+   ["." host (#+ import: do-to)]
+   [control
+    ["." function]]
+   [data
+    ["." product]
+    [number
+     ["i" int]]
+    ["." text
+     ["%" format (#+ format)]]
+    [collection
+     ["." array (#+ Array)]
+     ["." list ("#@." functor)]]]
+   [target
+    [jvm
+     [encoding
+      ["." name]]
+     ["." type (#+ Type Constraint)
+      [category (#+ Class Value Method)]
+      ["." signature]
+      ["." descriptor]]]]]
+  ["." //])
+
+(def: signature (|>> type.signature signature.signature))
+(def: descriptor (|>> type.descriptor descriptor.descriptor))
+(def: class-name (|>> type.descriptor descriptor.class-name name.read))
+
+(import: #long java/lang/Object)
+(import: #long java/lang/String)
+
+(import: org/objectweb/asm/Opcodes
+  (#static ACC_PUBLIC int)
+  (#static ACC_PROTECTED int)
+  (#static ACC_PRIVATE int)
+
+  (#static ACC_TRANSIENT int)
+  (#static ACC_VOLATILE int)
+
+  (#static ACC_ABSTRACT int)
+  (#static ACC_FINAL int)
+  (#static ACC_STATIC int)
+  (#static ACC_SYNCHRONIZED int)
+  (#static ACC_STRICT int)
+
+  (#static ACC_SUPER int)
+  (#static ACC_INTERFACE int)
+
+  (#static V1_1 int)
+  (#static V1_2 int)
+  (#static V1_3 int)
+  (#static V1_4 int)
+  (#static V1_5 int)
+  (#static V1_6 int)
+  (#static V1_7 int)
+  (#static V1_8 int)
+  )
+
+(import: org/objectweb/asm/FieldVisitor
+  (visitEnd [] void))
+
+(import: org/objectweb/asm/MethodVisitor
+  (visitCode [] void)
+  (visitMaxs [int int] void)
+  (visitEnd [] void))
+
+(import: org/objectweb/asm/ClassWriter
+  (#static COMPUTE_MAXS int)
+  (#static COMPUTE_FRAMES int)
+  (new [int])
+  (visit [int int String String String [String]] void)
+  (visitEnd [] void)
+  (visitField [int String String String Object] FieldVisitor)
+  (visitMethod [int String String String [String]] MethodVisitor)
+  (toByteArray [] [byte]))
+
+(def: (string-array values)
+  (-> (List Text) (Array Text))
+  (let [output (host.array String (list.size values))]
+    (exec (list@map (function (_ [idx value])
+                      (host.array-write idx value output))
+                    (list.enumerate values))
+      output)))
+
+(def: (version-flag version)
+  (-> //.Version Int)
+  (case version
+    #//.V1_1 (Opcodes::V1_1)
+    #//.V1_2 (Opcodes::V1_2)
+    #//.V1_3 (Opcodes::V1_3)
+    #//.V1_4 (Opcodes::V1_4)
+    #//.V1_5 (Opcodes::V1_5)
+    #//.V1_6 (Opcodes::V1_6)
+    #//.V1_7 (Opcodes::V1_7)
+    #//.V1_8 (Opcodes::V1_8)))
+
+(def: (visibility-flag visibility)
+  (-> //.Visibility Int)
+  (case visibility
+    #//.Public    (Opcodes::ACC_PUBLIC)
+    #//.Protected (Opcodes::ACC_PROTECTED)
+    #//.Private   (Opcodes::ACC_PRIVATE)
+    #//.Default   +0))
+
+(def: (class-flags config)
+  (-> //.Class-Config Int)
+  ($_ i.+
+      (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0)))
+
+(def: (method-flags config)
+  (-> //.Method-Config Int)
+  ($_ i.+
+      (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0)
+      (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0)
+      (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0)
+      (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0)))
+
+(def: (field-flags config)
+  (-> //.Field-Config Int)
+  ($_ i.+
+      (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0)
+      (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0)
+      (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0)
+      (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
+
+(def: param-signature
+  (-> (Type Class) Text)
+  (|>> ..signature (format ":")))
+
+(def: (formal-param [name super interfaces])
+  (-> Constraint Text)
+  (format name
+          (param-signature super)
+          (|> interfaces
+              (list@map param-signature)
+              (text.join-with ""))))
+
+(def: (constraints-signature constraints super interfaces)
+  (-> (List Constraint) (Type Class) (List (Type Class))
+      Text)
+  (let [formal-params (if (list.empty? constraints)
+                        ""
+                        (format "<"
+                                (|> constraints
+                                    (list@map formal-param)
+                                    (text.join-with ""))
+                                ">"))]
+    (format formal-params
+            (..signature super)
+            (|> interfaces
+                (list@map ..signature)
+                (text.join-with "")))))
+
+(def: class-computes
+  Int
+  ($_ i.+
+      (ClassWriter::COMPUTE_MAXS)
+      ## (ClassWriter::COMPUTE_FRAMES)
+      ))
+
+(def: binary-name (|>> name.internal name.read))
+
+(template [<name> <flag>]
+  [(def: #export (<name> version visibility config name constraints super interfaces
+                         definitions)
+     (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def
+         (host.type [byte]))
+     (let [writer (|> (do-to (ClassWriter::new class-computes)
+                        (ClassWriter::visit (version-flag version)
+                                            ($_ i.+
+                                                (Opcodes::ACC_SUPER)
+                                                <flag>
+                                                (visibility-flag visibility)
+                                                (class-flags config))
+                                            (..binary-name name)
+                                            (constraints-signature constraints super interfaces)
+                                            (..class-name super)
+                                            (|> interfaces
+                                                (list@map ..class-name)
+                                                string-array)))
+                      definitions)
+           _ (ClassWriter::visitEnd writer)]
+       (ClassWriter::toByteArray writer)))]
+
+  [class    +0]
+  [abstract (Opcodes::ACC_ABSTRACT)]
+  )
+
+(def: $Object
+  (Type Class)
+  (type.class "java.lang.Object" (list)))
+
+(def: #export (interface version visibility config name constraints interfaces
+                         definitions)
+  (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def
+      (host.type [byte]))
+  (let [writer (|> (do-to (ClassWriter::new class-computes)
+                     (ClassWriter::visit (version-flag version)
+                                         ($_ i.+
+                                             (Opcodes::ACC_SUPER)
+                                             (Opcodes::ACC_INTERFACE)
+                                             (visibility-flag visibility)
+                                             (class-flags config))
+                                         (..binary-name name)
+                                         (constraints-signature constraints $Object interfaces)
+                                         (..class-name $Object)
+                                         (|> interfaces
+                                             (list@map ..class-name)
+                                             string-array)))
+                   definitions)
+        _ (ClassWriter::visitEnd writer)]
+    (ClassWriter::toByteArray writer)))
+
+(def: #export (method visibility config name type then)
+  (-> //.Visibility //.Method-Config Text (Type Method) //.Inst
+      //.Def)
+  (function (_ writer)
+    (let [=method (ClassWriter::visitMethod ($_ i.+
+                                                (visibility-flag visibility)
+                                                (method-flags config))
+                                            (..binary-name name)
+                                            (..descriptor type)
+                                            (..signature type)
+                                            (string-array (list))
+                                            writer)
+          _ (MethodVisitor::visitCode =method)
+          _ (then =method)
+          _ (MethodVisitor::visitMaxs +0 +0 =method)
+          _ (MethodVisitor::visitEnd =method)]
+      writer)))
+
+(def: #export (abstract-method visibility config name type)
+  (-> //.Visibility //.Method-Config Text (Type Method)
+      //.Def)
+  (function (_ writer)
+    (let [=method (ClassWriter::visitMethod ($_ i.+
+                                                (visibility-flag visibility)
+                                                (method-flags config)
+                                                (Opcodes::ACC_ABSTRACT))
+                                            (..binary-name name)
+                                            (..descriptor type)
+                                            (..signature type)
+                                            (string-array (list))
+                                            writer)
+          _ (MethodVisitor::visitEnd =method)]
+      writer)))
+
+(def: #export (field visibility config name type)
+  (-> //.Visibility //.Field-Config Text (Type Value) //.Def)
+  (function (_ writer)
+    (let [=field (do-to (ClassWriter::visitField ($_ i.+
+                                                     (visibility-flag visibility)
+                                                     (field-flags config))
+                                                 (..binary-name name)
+                                                 (..descriptor type)
+                                                 (..signature type)
+                                                 (host.null)
+                                                 writer)
+                   (FieldVisitor::visitEnd))]
+      writer)))
+
+(template [<name> <lux-type> <jvm-type> <prepare>]
+  [(def: #export (<name> visibility config name value)
+     (-> //.Visibility //.Field-Config Text <lux-type> //.Def)
+     (function (_ writer)
+       (let [=field (do-to (ClassWriter::visitField ($_ i.+
+                                                        (visibility-flag visibility)
+                                                        (field-flags config))
+                                                    (..binary-name name)
+                                                    (..descriptor <jvm-type>)
+                                                    (..signature <jvm-type>)
+                                                    (<prepare> value)
+                                                    writer)
+                      (FieldVisitor::visitEnd))]
+         writer)))]
+
+  [boolean-field Bit  type.boolean                           function.identity]
+  [byte-field    Int  type.byte                              host.long-to-byte]
+  [short-field   Int  type.short                             host.long-to-short]
+  [int-field     Int  type.int                               host.long-to-int]
+  [long-field    Int  type.long                              function.identity]
+  [float-field   Frac type.float                             host.double-to-float]
+  [double-field  Frac type.double                            function.identity]
+  [char-field    Nat  type.char                              (|>> .int host.long-to-int host.int-to-char)]
+  [string-field  Text (type.class "java.lang.String" (list)) function.identity]
+  )
+
+(def: #export (fuse defs)
+  (-> (List //.Def) //.Def)
+  (case defs
+    #.Nil
+    function.identity
+
+    (#.Cons singleton #.Nil)
+    singleton
+
+    (#.Cons head tail)
+    (function.compose (fuse tail) head)))
diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux
new file mode 100644
index 000000000..b673c7d7e
--- /dev/null
+++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux
@@ -0,0 +1,464 @@
+(.module:
+  [lux (#- Type int char)
+   ["." host (#+ import: do-to)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." function]
+    ["." try]
+    ["p" parser
+     ["s" code]]]
+   [data
+    ["." product]
+    ["." maybe]
+    [number
+     ["n" nat]
+     ["i" int]]
+    [collection
+     ["." list ("#@." functor)]]]
+   [macro
+    ["." code]
+    ["." template]
+    [syntax (#+ syntax:)]]
+   [target
+    [jvm
+     [encoding
+      ["." name (#+ External)]]
+     ["." type (#+ Type) ("#@." equivalence)
+      [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
+      ["." box]
+      ["." descriptor]
+      ["." reflection]]]]
+   [tool
+    [compiler
+     [phase (#+ Operation)]]]]
+  ["." // (#+ Inst)])
+
+(def: class-name (|>> type.descriptor descriptor.class-name name.read))
+(def: descriptor (|>> type.descriptor descriptor.descriptor))
+(def: reflection (|>> type.reflection reflection.reflection))
+
+## [Host]
+(import: #long java/lang/Object)
+(import: #long java/lang/String)
+
+(syntax: (declare {codes (p.many s.local-identifier)})
+  (|> codes
+      (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int)))))
+      wrap))
+
+(`` (import: #long org/objectweb/asm/Opcodes
+      (#static NOP int)
+
+      ## Conversion
+      (~~ (declare D2F D2I D2L
+                   F2D F2I F2L
+                   I2B I2C I2D I2F I2L I2S
+                   L2D L2F L2I))
+
+      ## Primitive
+      (~~ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
+                   T_BYTE T_SHORT T_INT T_LONG))
+
+      ## Class
+      (~~ (declare CHECKCAST NEW INSTANCEOF))
+      
+      ## Stack
+      (~~ (declare DUP DUP_X1 DUP_X2
+                   DUP2 DUP2_X1 DUP2_X2
+                   POP POP2
+                   SWAP))
+      
+      ## Jump
+      (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT
+                   IF_ICMPNE IF_ICMPGE IF_ICMPLE
+                   IF_ACMPEQ IF_ACMPNE IFNULL IFNONNULL
+                   IFEQ IFNE IFLT IFLE IFGT IFGE
+                   GOTO))
+
+      (~~ (declare BIPUSH SIPUSH))
+      (~~ (declare ICONST_M1 ICONST_0 ICONST_1 ICONST_2 ICONST_3 ICONST_4 ICONST_5
+                   LCONST_0 LCONST_1
+                   FCONST_0 FCONST_1 FCONST_2
+                   DCONST_0 DCONST_1))
+      (#static ACONST_NULL int)
+      
+      ## Var
+      (~~ (declare IINC
+                   ILOAD LLOAD FLOAD DLOAD ALOAD
+                   ISTORE LSTORE FSTORE DSTORE ASTORE))
+      
+      ## Arithmetic
+      (~~ (declare IADD ISUB IMUL IDIV IREM INEG
+                   LADD LSUB LMUL LDIV LREM LNEG LCMP
+                   FADD FSUB FMUL FDIV FREM FNEG FCMPG FCMPL
+                   DADD DSUB DMUL DDIV DREM DNEG DCMPG DCMPL))
+      
+      ## Bit-wise
+      (~~ (declare IAND IOR IXOR ISHL ISHR IUSHR
+                   LAND LOR LXOR LSHL LSHR LUSHR))
+
+      ## Array
+      (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY
+                   AALOAD AASTORE
+                   BALOAD BASTORE
+                   SALOAD SASTORE
+                   IALOAD IASTORE
+                   LALOAD LASTORE
+                   FALOAD FASTORE
+                   DALOAD DASTORE
+                   CALOAD CASTORE))
+      
+      ## Member
+      (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD
+                   INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE))
+
+      (#static ATHROW int)
+
+      ## Concurrency
+      (~~ (declare MONITORENTER MONITOREXIT))
+      
+      ## Return
+      (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN))
+      ))
+
+(import: #long org/objectweb/asm/Label
+  (new []))
+
+(import: #long org/objectweb/asm/MethodVisitor
+  (visitCode [] void)
+  (visitMaxs [int int] void)
+  (visitEnd [] void)
+  (visitInsn [int] void)
+  (visitLdcInsn [java/lang/Object] void)
+  (visitFieldInsn [int java/lang/String java/lang/String java/lang/String] void)
+  (visitTypeInsn [int java/lang/String] void)
+  (visitVarInsn [int int] void)
+  (visitIntInsn [int int] void)
+  (visitMethodInsn [int java/lang/String java/lang/String java/lang/String boolean] void)
+  (visitLabel [org/objectweb/asm/Label] void)
+  (visitJumpInsn [int org/objectweb/asm/Label] void)
+  (visitTryCatchBlock [org/objectweb/asm/Label org/objectweb/asm/Label org/objectweb/asm/Label java/lang/String] void)
+  (visitLookupSwitchInsn [org/objectweb/asm/Label [int] [org/objectweb/asm/Label]] void)
+  (visitTableSwitchInsn [int int org/objectweb/asm/Label [org/objectweb/asm/Label]] void)
+  )
+
+## [Insts]
+(def: #export make-label
+  (All [s] (Operation s org/objectweb/asm/Label))
+  (function (_ state)
+    (#try.Success [state (org/objectweb/asm/Label::new)])))
+
+(def: #export (with-label action)
+  (All [a] (-> (-> org/objectweb/asm/Label a) a))
+  (action (org/objectweb/asm/Label::new)))
+
+(template [<name> <type> <prepare>]
+  [(def: #export (<name> value)
+     (-> <type> Inst)
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))]
+
+  [boolean Bit  function.identity]
+  [int     Int  host.long-to-int]
+  [long    Int  function.identity]
+  [double  Frac function.identity]
+  [char    Nat  (|>> .int host.long-to-int host.int-to-char)]
+  [string  Text function.identity]
+  )
+
+(template: (!prefix short)
+  (`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short])))))
+
+(template [<constant>]
+  [(def: #export <constant>
+     Inst
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))]
+
+  [ICONST_M1] [ICONST_0] [ICONST_1] [ICONST_2] [ICONST_3] [ICONST_4] [ICONST_5]
+  [LCONST_0] [LCONST_1]
+  [FCONST_0] [FCONST_1] [FCONST_2]
+  [DCONST_0] [DCONST_1]
+  )
+
+(def: #export NULL
+  Inst
+  (function (_ visitor)
+    (do-to visitor
+      (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL)))))
+
+(template [<constant>]
+  [(def: #export (<constant> constant)
+     (-> Int Inst)
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))]
+
+  [BIPUSH]
+  [SIPUSH]
+  )
+
+(template [<name>]
+  [(def: #export <name>
+     Inst
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))]
+
+  [NOP]
+  
+  ## Stack
+  [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2]
+  [POP] [POP2]
+  [SWAP]
+
+  ## Conversions
+  [D2F] [D2I] [D2L]
+  [F2D] [F2I] [F2L]
+  [I2B] [I2C] [I2D] [I2F] [I2L] [I2S]
+  [L2D] [L2F] [L2I]
+
+  ## Integer arithmetic
+  [IADD] [ISUB] [IMUL] [IDIV] [IREM] [INEG]
+
+  ## Integer bitwise
+  [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR]
+  
+  ## Long arithmetic
+  [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LNEG]
+  [LCMP]
+
+  ## Long bitwise
+  [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
+
+  ## Float arithmetic
+  [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FNEG] [FCMPG] [FCMPL]
+
+  ## Double arithmetic
+  [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DNEG]
+  [DCMPG] [DCMPL]
+
+  ## Array
+  [ARRAYLENGTH]
+  [AALOAD] [AASTORE]
+  [BALOAD] [BASTORE]
+  [SALOAD] [SASTORE]
+  [IALOAD] [IASTORE]
+  [LALOAD] [LASTORE]
+  [FALOAD] [FASTORE]
+  [DALOAD] [DASTORE]
+  [CALOAD] [CASTORE]
+
+  ## Exceptions
+  [ATHROW]
+
+  ## Concurrency
+  [MONITORENTER] [MONITOREXIT]
+
+  ## Return
+  [RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN]
+  )
+
+(type: #export Register Nat)
+
+(template [<name>]
+  [(def: #export (<name> register)
+     (-> Register Inst)
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))]
+
+  [IINC]
+  [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD]
+  [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE]
+  )
+
+(template [<name> <inst>]
+  [(def: #export (<name> class field type)
+     (-> (Type Class) Text (Type Value) Inst)
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class-name class) field (..descriptor type)))))]
+
+  [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
+  [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
+  
+  [PUTFIELD  org/objectweb/asm/Opcodes::PUTFIELD]
+  [GETFIELD  org/objectweb/asm/Opcodes::GETFIELD]
+  )
+
+(template [<category> <instructions>+]
+  [(`` (template [<name> <inst>]
+         [(def: #export (<name> class)
+            (-> (Type <category>) Inst)
+            (function (_ visitor)
+              (do-to visitor
+                (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class-name class)))))]
+
+         (~~ (template.splice <instructions>+))))]
+
+  [Object
+   [[CHECKCAST  org/objectweb/asm/Opcodes::CHECKCAST]
+    [ANEWARRAY  org/objectweb/asm/Opcodes::ANEWARRAY]]]
+
+  [Class
+   [[NEW        org/objectweb/asm/Opcodes::NEW]
+    [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]]
+  )
+
+(def: #export (NEWARRAY type)
+  (-> (Type Primitive) Inst)
+  (function (_ visitor)
+    (do-to visitor
+      (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
+                                                     (`` (cond (~~ (template [<descriptor> <opcode>]
+                                                                     [(type@= <descriptor> type) (<opcode>)]
+                                                                     
+                                                                     [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
+                                                                     [type.byte    org/objectweb/asm/Opcodes::T_BYTE]
+                                                                     [type.short   org/objectweb/asm/Opcodes::T_SHORT]
+                                                                     [type.int     org/objectweb/asm/Opcodes::T_INT]
+                                                                     [type.long    org/objectweb/asm/Opcodes::T_LONG]
+                                                                     [type.float   org/objectweb/asm/Opcodes::T_FLOAT]
+                                                                     [type.double  org/objectweb/asm/Opcodes::T_DOUBLE]
+                                                                     [type.char    org/objectweb/asm/Opcodes::T_CHAR]))
+                                                               ## else
+                                                               (undefined)))))))
+
+(template [<name> <inst> <interface?>]
+  [(def: #export (<name> class method-name method)
+     (-> (Type Class) Text (Type Method) Inst)
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>)
+                                                           (..class-name class)
+                                                           method-name
+                                                           (|> method type.descriptor descriptor.descriptor)
+                                                           <interface?>))))]
+
+  [INVOKESTATIC    org/objectweb/asm/Opcodes::INVOKESTATIC false]
+  [INVOKEVIRTUAL   org/objectweb/asm/Opcodes::INVOKEVIRTUAL false]
+  [INVOKESPECIAL   org/objectweb/asm/Opcodes::INVOKESPECIAL false]
+  [INVOKEINTERFACE org/objectweb/asm/Opcodes::INVOKEINTERFACE true]
+  )
+
+(template [<name>]
+  [(def: #export (<name> @where)
+     (-> //.Label Inst)
+     (function (_ visitor)
+       (do-to visitor
+         (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))]
+
+  [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT]
+  [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE]
+  [IF_ACMPEQ] [IF_ACMPNE] [IFNULL] [IFNONNULL]
+  [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
+  [GOTO]
+  )
+
+(def: #export (LOOKUPSWITCH default keys+labels)
+  (-> //.Label (List [Int //.Label]) Inst)
+  (function (_ visitor)
+    (let [keys+labels (list.sort (function (_ left right)
+                                   (i.< (product.left left) (product.left right)))
+                                 keys+labels)
+          array-size (list.size keys+labels)
+          keys-array (host.array int array-size)
+          labels-array (host.array org/objectweb/asm/Label array-size)
+          _ (loop [idx 0]
+              (if (n.< array-size idx)
+                (let [[key label] (maybe.assume (list.nth idx keys+labels))]
+                  (exec
+                    (host.array-write idx (host.long-to-int key) keys-array)
+                    (host.array-write idx label labels-array)
+                    (recur (inc idx))))
+                []))]
+      (do-to visitor
+        (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys-array labels-array)))))
+
+(def: #export (TABLESWITCH min max default labels)
+  (-> Int Int //.Label (List //.Label) Inst)
+  (function (_ visitor)
+    (let [num-labels (list.size labels)
+          labels-array (host.array org/objectweb/asm/Label num-labels)
+          _ (loop [idx 0]
+              (if (n.< num-labels idx)
+                (exec (host.array-write idx
+                                        (maybe.assume (list.nth idx labels))
+                                        labels-array)
+                  (recur (inc idx)))
+                []))]
+      (do-to visitor
+        (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
+
+(def: #export (try @from @to @handler exception)
+  (-> //.Label //.Label //.Label (Type Class) Inst)
+  (function (_ visitor)
+    (do-to visitor
+      (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception)))))
+
+(def: #export (label @label)
+  (-> //.Label Inst)
+  (function (_ visitor)
+    (do-to visitor
+      (org/objectweb/asm/MethodVisitor::visitLabel @label))))
+
+(def: #export (array elementT)
+  (-> (Type Value) Inst)
+  (case (type.primitive? elementT)
+    (#.Left elementT)
+    (ANEWARRAY elementT)
+
+    (#.Right elementT)
+    (NEWARRAY elementT)))
+
+(template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>]
+  [(def: (<name> type)
+     (-> (Type Primitive) Text)
+     (`` (cond (~~ (template [<descriptor> <output>]
+                     [(type@= <descriptor> type) <output>]
+                     
+                     [type.boolean <boolean>]
+                     [type.byte    <byte>]
+                     [type.short   <short>]
+                     [type.int     <int>]
+                     [type.long    <long>]
+                     [type.float   <float>]
+                     [type.double  <double>]
+                     [type.char    <char>]))
+               ## else
+               (undefined))))]
+
+  [primitive-wrapper
+   box.boolean box.byte box.short box.int
+   box.long box.float box.double box.char]
+  [primitive-unwrap
+   "booleanValue" "byteValue" "shortValue" "intValue"
+   "longValue" "floatValue" "doubleValue" "charValue"]
+  )
+
+(def: #export (wrap type)
+  (-> (Type Primitive) Inst)
+  (let [wrapper (type.class (primitive-wrapper type) (list))]
+    (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)]))))
+
+(def: #export (unwrap type)
+  (-> (Type Primitive) Inst)
+  (let [wrapper (type.class (primitive-wrapper type) (list))]
+    (|>> (CHECKCAST wrapper)
+         (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)])))))
+
+(def: #export (fuse insts)
+  (-> (List Inst) Inst)
+  (case insts
+    #.Nil
+    function.identity
+
+    (#.Cons singleton #.Nil)
+    singleton
+
+    (#.Cons head tail)
+    (function.compose (fuse tail) head)))