- Heavy refactoring.

3 files changed, 809 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
new file mode 100644
index 000000000..60009fb5c
--- /dev/null
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -0,0 +1,288 @@
+(;module:
+  lux
+  (lux (data [text]
+             text/format
+             [product]
+             (coll ["a" array]
+                   [list "list/" Functor<List>]))
+       [host #+ do-to])
+  ["$" ..]
+  (.. ["$t" type]))
+
+## [Host]
+(host;import #long java.lang.Object)
+(host;import #long java.lang.String)
+
+(host;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)
+  )
+
+(host;import org.objectweb.asm.FieldVisitor
+  (visitEnd [] void))
+
+(host;import org.objectweb.asm.MethodVisitor
+  (visitCode [] void)
+  (visitMaxs [int int] void)
+  (visitEnd [] void))
+
+(host;import org.objectweb.asm.ClassWriter
+  (#static COMPUTE_MAXS int)
+  (#static COMPUTE_FRAMES 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 [] (Array byte)))
+
+## [Defs]
+(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: exceptions-array
+  (-> $;Method (Array Text))
+  (|>. (get@ #$;exceptions)
+       (list/map (|>. #$;Generic $t;descriptor))
+       string-array))
+
+(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: class-to-type
+  (-> $;Class $;Type)
+  (|>. #$;Class #$;Generic))
+
+(def: param-signature
+  (-> $;Class Text)
+  (|>. class-to-type $t;signature (format ":")))
+
+(def: (formal-param [name super interfaces])
+  (-> $;Parameter Text)
+  (format name
+          (param-signature super)
+          (|> interfaces
+              (list/map param-signature)
+              (text;join-with ""))))
+
+(def: (parameters-signature parameters super interfaces)
+  (-> (List $;Parameter) $;Class (List $;Class)
+      Text)
+  (let [formal-params (if (list;empty? parameters)
+                        ""
+                        (format "<"
+                                (|> parameters
+                                    (list/map formal-param)
+                                    (text;join-with ""))
+                                ">"))]
+    (format formal-params
+            (|> super class-to-type $t;signature)
+            (|> interfaces
+                (list/map (|>. class-to-type $t;signature))
+                (text;join-with "")))))
+
+(def: class-computes
+  Int
+  ($_ i.+
+      ClassWriter.COMPUTE_MAXS
+      ## ClassWriter.COMPUTE_FRAMES
+      ))
+
+(do-template [<name> <flag>]
+  [(def: #export (<name> version visibility config name parameters super interfaces
+                         definitions)
+     (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def
+         (host;type (Array 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))
+                                            ($t;binary-name name)
+                                            (parameters-signature parameters super interfaces)
+                                            (|> super product;left $t;binary-name)
+                                            (|> interfaces
+                                                (list/map (|>. product;left $t;binary-name))
+                                                string-array)]))
+                      definitions)
+           _ (ClassWriter.visitEnd [] writer)]
+       (ClassWriter.toByteArray [] writer)))]
+
+  [class     0]
+  [abstract  Opcodes.ACC_ABSTRACT]
+  )
+
+(def: $Object $;Class ["java.lang.Object" (list)])
+
+(def: #export (interface version visibility config name parameters interfaces
+                         definitions)
+  (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def
+      (host;type (Array 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))
+                                         ($t;binary-name name)
+                                         (parameters-signature parameters $Object interfaces)
+                                         (|> $Object product;left $t;binary-name)
+                                         (|> interfaces
+                                             (list/map (|>. product;left $t;binary-name))
+                                             string-array)]))
+                   definitions)
+        _ (ClassWriter.visitEnd [] writer)]
+    (ClassWriter.toByteArray [] writer)))
+
+(def: #export (method visibility config name type then)
+  (-> $;Visibility $;Method-Config Text $;Method $;Inst
+      $;Def)
+  (function [writer]
+    (let [=method (ClassWriter.visitMethod [($_ i.+
+                                                (visibility-flag visibility)
+                                                (method-flags config))
+                                            ($t;binary-name name)
+                                            ($t;method-descriptor type)
+                                            ($t;method-signature type)
+                                            (exceptions-array type)]
+                                           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 $;Method
+      $;Def)
+  (function [writer]
+    (let [=method (ClassWriter.visitMethod [($_ i.+
+                                                (visibility-flag visibility)
+                                                (method-flags config)
+                                                Opcodes.ACC_ABSTRACT)
+                                            ($t;binary-name name)
+                                            ($t;method-descriptor type)
+                                            ($t;method-signature type)
+                                            (exceptions-array type)]
+                                           writer)
+          _ (MethodVisitor.visitEnd [] =method)]
+      writer)))
+
+(def: #export (field visibility config name type)
+  (-> $;Visibility $;Field-Config Text $;Type $;Def)
+  (function [writer]
+    (let [=field (do-to (ClassWriter.visitField [($_ i.+
+                                                     (visibility-flag visibility)
+                                                     (field-flags config))
+                                                 ($t;binary-name name)
+                                                 ($t;descriptor type)
+                                                 ($t;signature type)
+                                                 (host;null)] writer)
+                   (FieldVisitor.visitEnd []))]
+      writer)))
+
+(do-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))
+                                                    ($t;binary-name name)
+                                                    ($t;descriptor <jvm-type>)
+                                                    ($t;signature <jvm-type>)
+                                                    (<prepare> value)]
+                                                   writer)
+                      (FieldVisitor.visitEnd []))]
+         writer)))]
+
+  [boolean-field Bool $t;boolean id]
+  [byte-field    Int  $t;byte    host;l2b]
+  [short-field   Int  $t;short   host;l2s]
+  [int-field     Int  $t;int     host;l2i]
+  [long-field    Int  $t;long    id]
+  [float-field   Frac $t;float   host;d2f]
+  [double-field  Frac $t;double  id]
+  [char-field    Nat  $t;char    (|>. nat-to-int host;l2i host;i2c)]
+  [string-field  Text ($t;class "java.lang.String" (list)) id]
+  )
+
+(def: #export (fuse defs)
+  (-> (List $;Def) $;Def)
+  (case defs
+    #;Nil
+    id
+
+    (#;Cons singleton #;Nil)
+    singleton
+
+    (#;Cons head tail)
+    (. (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
new file mode 100644
index 000000000..37ab75020
--- /dev/null
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -0,0 +1,383 @@
+(;module:
+  [lux #- char]
+  (lux (control monad
+                ["p" parser])
+       (data [maybe]
+             ["e" error]
+             text/format
+             (coll [list "L/" Functor<List>]))
+       [host #+ do-to]
+       [meta]
+       (meta [code]
+             ["s" syntax #+ syntax:]))
+  ["$" ..]
+  (.. ["$t" type]))
+
+## [Host]
+(host;import #long java.lang.Object)
+(host;import #long java.lang.String)
+
+(syntax: (declare [codes (p;many s;local-symbol)])
+  (|> codes
+      (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
+      wrap))
+
+(`` (host;import 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_ACMPEQ IFNULL
+                   IFEQ IFNE IFLT IFLE IFGT IFGE
+                   GOTO))
+
+      (#static ACONST_NULL int)
+      
+      ## Var
+      (~~ (declare ILOAD LLOAD DLOAD ALOAD
+                   ISTORE LSTORE ASTORE))
+      
+      ## Arithmetic
+      (~~ (declare IADD ISUB IMUL IDIV IREM
+                   LADD LSUB LMUL LDIV LREM LCMP
+                   FADD FSUB FMUL FDIV FREM FCMPG FCMPL
+                   DADD DSUB DMUL DDIV DREM 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 DRETURN ARETURN))
+      ))
+
+(host;import org.objectweb.asm.FieldVisitor
+  (visitEnd [] void))
+
+(host;import org.objectweb.asm.Label
+  (new []))
+
+(host;import org.objectweb.asm.MethodVisitor
+  (visitCode [] void)
+  (visitMaxs [int int] void)
+  (visitEnd [] void)
+  (visitInsn [int] void)
+  (visitLdcInsn [Object] void)
+  (visitFieldInsn [int String String String] void)
+  (visitTypeInsn [int String] void)
+  (visitVarInsn [int int] void)
+  (visitIntInsn [int int] void)
+  (visitMethodInsn [int String String String boolean] void)
+  (visitLabel [Label] void)
+  (visitJumpInsn [int Label] void)
+  (visitTryCatchBlock [Label Label Label String] void)
+  (visitTableSwitchInsn [int int Label (Array  Label)] void)
+  )
+
+## [Insts]
+(def: #export make-label
+  (Meta Label)
+  (function [compiler]
+    (#e;Success [compiler (Label.new [])])))
+
+(def: #export (with-label action)
+  (-> (-> Label $;Inst) $;Inst)
+  (action (Label.new [])))
+
+(do-template [<name> <type> <prepare>]
+  [(def: #export (<name> value)
+     (-> <type> $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitLdcInsn [(<prepare> value)]))))]
+
+  [boolean Bool id]
+  [int     Int  host;l2i]
+  [long    Int  id]
+  [double  Frac id]
+  [char    Nat  (|>. nat-to-int host;l2i host;i2c)]
+  [string  Text id]
+  )
+
+(syntax: (prefix [base s;local-symbol])
+  (wrap (list (code;local-symbol (format "Opcodes." base)))))
+
+(def: #export NULL
+  $;Inst
+  (function [visitor]
+    (do-to visitor
+      (MethodVisitor.visitInsn [(prefix ACONST_NULL)]))))
+
+(do-template [<name>]
+  [(def: #export <name>
+     $;Inst
+     (function [visitor]
+       (do-to visitor
+         (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]
+
+  ## Integer bitwise
+  [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR]
+  
+  ## Long arithmetic
+  [LADD] [LSUB] [LMUL] [LDIV] [LREM]
+  [LCMP]
+
+  ## Long bitwise
+  [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
+
+  ## Float arithmetic
+  [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FCMPG] [FCMPL]
+
+  ## Double arithmetic
+  [DADD] [DSUB] [DMUL] [DDIV] [DREM]
+  [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] [DRETURN] [ARETURN]
+  )
+
+(do-template [<name>]
+  [(def: #export (<name> register)
+     (-> Nat $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
+
+  [ILOAD] [LLOAD] [DLOAD] [ALOAD]
+  [ISTORE] [LSTORE] [ASTORE]
+  )
+
+(do-template [<name> <inst>]
+  [(def: #export (<name> class field type)
+     (-> Text Text $;Type $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitFieldInsn [<inst> ($t;binary-name class) field ($t;descriptor type)]))))]
+
+  [GETSTATIC Opcodes.GETSTATIC]
+  [PUTSTATIC Opcodes.PUTSTATIC]
+  
+  [PUTFIELD  Opcodes.PUTFIELD]
+  [GETFIELD  Opcodes.GETFIELD]
+  )
+
+(do-template [<name> <inst>]
+  [(def: #export (<name> class)
+     (-> Text $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))]
+
+  [CHECKCAST  Opcodes.CHECKCAST]
+  [NEW        Opcodes.NEW]
+  [INSTANCEOF Opcodes.INSTANCEOF]
+  [ANEWARRAY  Opcodes.ANEWARRAY]
+  )
+
+(def: #export (NEWARRAY type)
+  (-> $;Primitive $;Inst)
+  (function [visitor]
+    (do-to visitor
+      (MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type
+                                                      #$;Boolean Opcodes.T_BOOLEAN
+                                                      #$;Byte    Opcodes.T_BYTE
+                                                      #$;Short   Opcodes.T_SHORT
+                                                      #$;Int     Opcodes.T_INT
+                                                      #$;Long    Opcodes.T_LONG
+                                                      #$;Float   Opcodes.T_FLOAT
+                                                      #$;Double  Opcodes.T_DOUBLE
+                                                      #$;Char    Opcodes.T_CHAR)]))))
+
+(do-template [<name> <inst>]
+  [(def: #export (<name> class method-name method-signature interface?)
+     (-> Text Text $;Method Bool $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitMethodInsn [<inst> ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))]
+
+  [INVOKESTATIC    Opcodes.INVOKESTATIC]
+  [INVOKEVIRTUAL   Opcodes.INVOKEVIRTUAL]
+  [INVOKESPECIAL   Opcodes.INVOKESPECIAL]
+  [INVOKEINTERFACE Opcodes.INVOKEINTERFACE]
+  )
+
+(do-template [<name>]
+  [(def: #export (<name> @where)
+     (-> $;Label $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
+
+  [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
+  [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
+  [GOTO]
+  )
+
+(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 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 (n.inc idx)))
+                []))]
+      (do-to visitor
+        (MethodVisitor.visitTableSwitchInsn [min max default labels-array])))))
+
+(def: #export (try @from @to @handler exception)
+  (-> $;Label $;Label $;Label Text $;Inst)
+  (function [visitor]
+    (do-to visitor
+      (MethodVisitor.visitTryCatchBlock [@from @to @handler ($t;binary-name exception)]))))
+
+(def: #export (label @label)
+  (-> $;Label $;Inst)
+  (function [visitor]
+    (do-to visitor
+      (MethodVisitor.visitLabel [@label]))))
+
+(def: #export (array type)
+  (-> $;Type $;Inst)
+  (case type
+    (#$;Primitive prim)
+    (NEWARRAY prim)
+
+    (#$;Generic generic)
+    (let [elem-class (case generic
+                       (#$;Class class params)
+                       ($t;binary-name class)
+
+                       _
+                       ($t;binary-name "java.lang.Object"))]
+      (ANEWARRAY elem-class))
+
+    _
+    (ANEWARRAY ($t;descriptor type))))
+
+(def: (primitive-wrapper type)
+  (-> $;Primitive Text)
+  (case type
+    #$;Boolean "java.lang.Boolean"
+    #$;Byte    "java.lang.Byte"
+    #$;Short   "java.lang.Short"
+    #$;Int     "java.lang.Integer"
+    #$;Long    "java.lang.Long"
+    #$;Float   "java.lang.Float"
+    #$;Double  "java.lang.Double"
+    #$;Char    "java.lang.Character"))
+
+(def: (primitive-unwrap type)
+  (-> $;Primitive Text)
+  (case type
+    #$;Boolean "booleanValue"
+    #$;Byte    "byteValue"
+    #$;Short   "shortValue"
+    #$;Int     "intValue"
+    #$;Long    "longValue"
+    #$;Float   "floatValue"
+    #$;Double  "doubleValue"
+    #$;Char    "charValue"))
+
+(def: #export (wrap type)
+  (-> $;Primitive $;Inst)
+  (let [class (primitive-wrapper type)]
+    (|>. (INVOKESTATIC class "valueOf"
+                       ($t;method (list (#$;Primitive type))
+                                  (#;Some ($t;class class (list)))
+                                  (list))
+                       false))))
+
+(def: #export (unwrap type)
+  (-> $;Primitive $;Inst)
+  (let [class (primitive-wrapper type)]
+    (|>. (CHECKCAST class)
+         (INVOKEVIRTUAL class (primitive-unwrap type)
+                        ($t;method (list) (#;Some (#$;Primitive type)) (list))
+                        false))))
+
+(def: #export (fuse insts)
+  (-> (List $;Inst) $;Inst)
+  (case insts
+    #;Nil
+    id
+
+    (#;Cons singleton #;Nil)
+    singleton
+
+    (#;Cons head tail)
+    (. (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
new file mode 100644
index 000000000..3825d443b
--- /dev/null
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -0,0 +1,138 @@
+(;module:
+  [lux #- char]
+  (lux (data [text]
+             text/format
+             (coll [list "L/" Functor<List>])))
+  ["$" ..])
+
+## Types
+(do-template [<name> <primitive>]
+  [(def: #export <name> $;Type (#$;Primitive <primitive>))]
+
+  [boolean #$;Boolean]
+  [byte    #$;Byte]
+  [short   #$;Short]
+  [int     #$;Int]
+  [long    #$;Long]
+  [float   #$;Float]
+  [double  #$;Double]
+  [char    #$;Char]
+  )
+
+(def: #export (class name params)
+  (-> Text (List $;Generic) $;Type)
+  (#$;Generic (#$;Class name params)))
+
+(def: #export (var name)
+  (-> Text $;Type)
+  (#$;Generic (#$;Var name)))
+
+(def: #export (wildcard bound)
+  (-> (Maybe [$;Bound $;Generic]) $;Type)
+  (#$;Generic (#$;Wildcard bound)))
+
+(def: #export (array depth elemT)
+  (-> Nat $;Type $;Type)
+  (case depth
+    +0 elemT
+    _ (#$;Array (array (n.dec depth) elemT))))
+
+(def: #export (binary-name class)
+  (-> Text Text)
+  (text;replace-all "." "/" class))
+
+(def: #export (descriptor type)
+  (-> $;Type Text)
+  (case type
+    (#$;Primitive prim)
+    (case prim
+      #$;Boolean "Z"
+      #$;Byte    "B"
+      #$;Short   "S"
+      #$;Int     "I"
+      #$;Long    "J"
+      #$;Float   "F"
+      #$;Double  "D"
+      #$;Char    "C")
+
+    (#$;Array sub)
+    (format "[" (descriptor sub))
+
+    (#$;Generic generic)
+    (case generic
+      (#$;Class class params)
+      (format "L" (binary-name class) ";")
+
+      (^or (#$;Var name) (#$;Wildcard ?bound))
+      (descriptor (#$;Generic (#$;Class "java.lang.Object" (list)))))
+    ))
+
+(def: #export (signature type)
+  (-> $;Type Text)
+  (case type
+    (#$;Primitive prim)
+    (case prim
+      #$;Boolean "Z"
+      #$;Byte    "B"
+      #$;Short   "S"
+      #$;Int     "I"
+      #$;Long    "J"
+      #$;Float   "F"
+      #$;Double  "D"
+      #$;Char    "C")
+
+    (#$;Array sub)
+    (format "[" (signature sub))
+
+    (#$;Generic generic)
+    (case generic
+      (#$;Class class params)
+      (let [=params (if (list;empty? params)
+                      ""
+                      (format "<"
+                              (|> params
+                                  (L/map (|>. #$;Generic signature))
+                                  (text;join-with ""))
+                              ">"))]
+        (format "L" (binary-name class) =params ";"))
+
+      (#$;Var name)
+      (format "T" name ";")
+
+      (#$;Wildcard #;None)
+      "*"
+
+      (^template [<tag> <prefix>]
+        (#$;Wildcard (#;Some [<tag> bound]))
+        (format <prefix> (signature (#$;Generic bound))))
+      ([#$;Upper "+"]
+       [#$;Lower "-"]))
+    ))
+
+## Methods
+(def: #export (method args return exceptions)
+  (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method)
+  {#$;args args #$;return return #$;exceptions exceptions})
+
+(def: #export (method-descriptor method)
+  (-> $;Method Text)
+  (format "(" (text;join-with "" (L/map descriptor (get@ #$;args method))) ")"
+          (case (get@ #$;return method)
+            #;None
+            "V"
+
+            (#;Some return)
+            (descriptor return))))
+
+(def: #export (method-signature method)
+  (-> $;Method Text)
+  (format "(" (|> (get@ #$;args method) (L/map signature) (text;join-with "")) ")"
+          (case (get@ #$;return method)
+            #;None
+            "V"
+
+            (#;Some return)
+            (signature return))
+          (|> (get@ #$;exceptions method)
+              (L/map (|>. #$;Generic signature (format "^")))
+              (text;join-with ""))))