Modified compiler's machinery to use the new abstractions for descriptors and signatures.

3 files changed, 126 insertions, 105 deletions

diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index 7216a1708..d3ead1095 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux (#- Definition)
+  [lux (#- Definition Type)
    [host (#+ import:)]
    [abstract
     monad]
@@ -15,7 +15,8 @@
     [syntax (#+ syntax:)]]
    [target
     [jvm
-     [type (#+ Class)]]]
+     ["." type (#+ Type)
+      [category (#+ Class)]]]]
    [tool
     [compiler
      [reference (#+ Register)]
@@ -119,5 +120,5 @@
     (org/objectweb/asm/Label::new)))
 
 (def: #export (simple-class name)
-  (-> Text Class)
-  [name (list)])
+  (-> Text (Type Class))
+  (type.class name (list)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index b663b9b31..08fccc640 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -11,16 +11,21 @@
      ["%" format (#+ format)]]
     [collection
      ["." array (#+ Array)]
-     ["." list ("#/." functor)]]]
+     ["." list ("#@." functor)]]]
    [target
     [jvm
      [encoding
       ["." name]]
-     ["$t" type (#+ Method Class Type Parameter)
-      ["." reflection]
+     ["." type (#+ Type Constraint)
+      [category (#+ Class Value Method)]
+      ["." signature (#+ Signature)]
       ["." descriptor (#+ 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)
 
@@ -72,7 +77,7 @@
 (def: (string-array values)
   (-> (List Text) (Array Text))
   (let [output (host.array String (list.size values))]
-    (exec (list/map (function (_ [idx value])
+    (exec (list@map (function (_ [idx value])
                       (host.array-write idx value output))
                     (list.enumerate values))
       output)))
@@ -118,36 +123,32 @@
       (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0)
       (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
 
-(def: class-to-type
-  (-> Class Type)
-  (|>> #$t.Class #$t.Generic))
-
 (def: param-signature
-  (-> Class Text)
-  (|>> class-to-type $t.signature (format ":")))
+  (-> (Type Class) Text)
+  (|>> ..signature (format ":")))
 
 (def: (formal-param [name super interfaces])
-  (-> Parameter Text)
+  (-> Constraint Text)
   (format name
           (param-signature super)
           (|> interfaces
-              (list/map param-signature)
+              (list@map param-signature)
               (text.join-with ""))))
 
-(def: (parameters-signature parameters super interfaces)
-  (-> (List Parameter) Class (List Class)
+(def: (constraints-signature constraints super interfaces)
+  (-> (List Constraint) (Type Class) (List (Type Class))
       Text)
-  (let [formal-params (if (list.empty? parameters)
+  (let [formal-params (if (list.empty? constraints)
                         ""
                         (format "<"
-                                (|> parameters
-                                    (list/map formal-param)
+                                (|> constraints
+                                    (list@map formal-param)
                                     (text.join-with ""))
                                 ">"))]
     (format formal-params
-            (|> super class-to-type $t.signature)
+            (..signature super)
             (|> interfaces
-                (list/map (|>> class-to-type $t.signature))
+                (list@map ..signature)
                 (text.join-with "")))))
 
 (def: class-computes
@@ -160,9 +161,9 @@
 (def: binary-name (|>> name.internal name.read))
 
 (template [<name> <flag>]
-  [(def: #export (<name> version visibility config name parameters super interfaces
+  [(def: #export (<name> version visibility config name constraints super interfaces
                          definitions)
-     (-> //.Version //.Visibility //.Class-Config Text (List Parameter) Class (List Class) //.Def
+     (-> //.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)
@@ -172,10 +173,10 @@
                                                 (visibility-flag visibility)
                                                 (class-flags config))
                                             (..binary-name name)
-                                            (parameters-signature parameters super interfaces)
-                                            (|> super product.left ..binary-name)
+                                            (constraints-signature constraints super interfaces)
+                                            (..class-name super)
                                             (|> interfaces
-                                                (list/map (|>> product.left ..binary-name))
+                                                (list@map ..class-name)
                                                 string-array)))
                       definitions)
            _ (ClassWriter::visitEnd writer)]
@@ -185,11 +186,13 @@
   [abstract (Opcodes::ACC_ABSTRACT)]
   )
 
-(def: $Object Class ["java.lang.Object" (list)])
+(def: $Object
+  (Type Class)
+  (type.class "java.lang.Object" (list)))
 
-(def: #export (interface version visibility config name parameters interfaces
+(def: #export (interface version visibility config name constraints interfaces
                          definitions)
-  (-> //.Version //.Visibility //.Class-Config Text (List Parameter) (List Class) //.Def
+  (-> //.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)
@@ -199,25 +202,25 @@
                                              (visibility-flag visibility)
                                              (class-flags config))
                                          (..binary-name name)
-                                         (parameters-signature parameters $Object interfaces)
-                                         (|> $Object product.left ..binary-name)
+                                         (constraints-signature constraints $Object interfaces)
+                                         (..class-name $Object)
                                          (|> interfaces
-                                             (list/map (|>> product.left ..binary-name))
+                                             (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 (Descriptor descriptor.Method) //.Inst
+(def: #export (method visibility config name [signature descriptor] then)
+  (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)] //.Inst
       //.Def)
   (function (_ writer)
     (let [=method (ClassWriter::visitMethod ($_ i.+
                                                 (visibility-flag visibility)
                                                 (method-flags config))
                                             (..binary-name name)
-                                            (descriptor.descriptor type)
-                                            (host.null)
+                                            (descriptor.descriptor descriptor)
+                                            (signature.signature signature)
                                             (string-array (list))
                                             writer)
           _ (MethodVisitor::visitCode =method)
@@ -226,8 +229,8 @@
           _ (MethodVisitor::visitEnd =method)]
       writer)))
 
-(def: #export (abstract-method visibility config name type)
-  (-> //.Visibility //.Method-Config Text (Descriptor descriptor.Method)
+(def: #export (abstract-method visibility config name [signature descriptor])
+  (-> //.Visibility //.Method-Config Text [(Signature Method) (Descriptor Method)]
       //.Def)
   (function (_ writer)
     (let [=method (ClassWriter::visitMethod ($_ i.+
@@ -235,22 +238,22 @@
                                                 (method-flags config)
                                                 (Opcodes::ACC_ABSTRACT))
                                             (..binary-name name)
-                                            (descriptor.descriptor type)
-                                            (host.null)
+                                            (descriptor.descriptor descriptor)
+                                            (signature.signature signature)
                                             (string-array (list))
                                             writer)
           _ (MethodVisitor::visitEnd =method)]
       writer)))
 
 (def: #export (field visibility config name type)
-  (-> //.Visibility //.Field-Config Text (Descriptor descriptor.Field) //.Def)
+  (-> //.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.descriptor type)
-                                                 (host.null)
+                                                 (..descriptor type)
+                                                 (..signature type)
                                                  (host.null)
                                                  writer)
                    (FieldVisitor::visitEnd))]
@@ -264,22 +267,22 @@
                                                         (visibility-flag visibility)
                                                         (field-flags config))
                                                     (..binary-name name)
-                                                    (descriptor.descriptor <jvm-type>)
-                                                    (host.null)
+                                                    (..descriptor <jvm-type>)
+                                                    (..signature <jvm-type>)
                                                     (<prepare> value)
                                                     writer)
                       (FieldVisitor::visitEnd))]
          writer)))]
 
-  [boolean-field Bit  descriptor.boolean                    function.identity]
-  [byte-field    Int  descriptor.byte                       host.long-to-byte]
-  [short-field   Int  descriptor.short                      host.long-to-short]
-  [int-field     Int  descriptor.int                        host.long-to-int]
-  [long-field    Int  descriptor.long                       function.identity]
-  [float-field   Frac descriptor.float                      host.double-to-float]
-  [double-field  Frac descriptor.double                     function.identity]
-  [char-field    Nat  descriptor.char                       (|>> .int host.long-to-int host.int-to-char)]
-  [string-field  Text (descriptor.class "java.lang.String") function.identity]
+  [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)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 8d5bd3b6e..72d7e58ca 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux (#- int char)
+  [lux (#- Type int char)
    ["." host (#+ import: do-to)]
    [abstract
     [monad (#+ do)]]
@@ -23,15 +23,22 @@
    [target
     [jvm
      [encoding
-      ["." name]]
-     [type
+      ["." name (#+ External)]]
+     ["." type (#+ Type) ("#@." equivalence)
+      [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
       ["." box]
-      ["." descriptor (#+ Descriptor Primitive) ("#@." equivalence)]]]]
+      ["." signature (#+ Signature)]
+      ["." descriptor (#+ 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)
@@ -239,10 +246,10 @@
 
 (template [<name> <inst>]
   [(def: #export (<name> class field type)
-     (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Field) Inst)
+     (-> (Type Class) Text (Type Value) Inst)
      (function (_ visitor)
        (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (descriptor.class-name class) field (descriptor.descriptor type)))))]
+         (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class-name class) field (..descriptor type)))))]
 
   [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
   [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
@@ -251,44 +258,54 @@
   [GETFIELD  org/objectweb/asm/Opcodes::GETFIELD]
   )
 
-(template [<name> <inst>]
-  [(def: #export (<name> class)
-     (-> (Descriptor descriptor.Object) Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (descriptor.class-name class)))))]
+(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]]]
 
-  [CHECKCAST  org/objectweb/asm/Opcodes::CHECKCAST]
-  [NEW        org/objectweb/asm/Opcodes::NEW]
-  [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]
-  [ANEWARRAY  org/objectweb/asm/Opcodes::ANEWARRAY]
+  [Class
+   [[NEW        org/objectweb/asm/Opcodes::NEW]
+    [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]]
   )
 
 (def: #export (NEWARRAY type)
-  (-> (Descriptor Primitive) Inst)
+  (-> (Type Primitive) Inst)
   (function (_ visitor)
     (do-to visitor
       (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
                                                      (`` (cond (~~ (template [<descriptor> <opcode>]
-                                                                     [(descriptor@= <descriptor> type) (<opcode>)]
+                                                                     [(type@= <descriptor> type) (<opcode>)]
                                                                      
-                                                                     [descriptor.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
-                                                                     [descriptor.byte    org/objectweb/asm/Opcodes::T_BYTE]
-                                                                     [descriptor.short   org/objectweb/asm/Opcodes::T_SHORT]
-                                                                     [descriptor.int     org/objectweb/asm/Opcodes::T_INT]
-                                                                     [descriptor.long    org/objectweb/asm/Opcodes::T_LONG]
-                                                                     [descriptor.float   org/objectweb/asm/Opcodes::T_FLOAT]
-                                                                     [descriptor.double  org/objectweb/asm/Opcodes::T_DOUBLE]
-                                                                     [descriptor.char    org/objectweb/asm/Opcodes::T_CHAR]))
+                                                                     [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>]
-  [(def: #export (<name> class method-name type interface?)
-     (-> (Descriptor descriptor.Class) Text (Descriptor descriptor.Method) Bit Inst)
+  [(def: #export (<name> class method-name [method-signature method-descriptor] interface?)
+     (-> (Type Class) Text [(Signature Method) (Descriptor Method)] Bit Inst)
      (function (_ visitor)
        (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) (descriptor.class-name class) method-name (descriptor.descriptor type) interface?))))]
+         (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>)
+                                                           (..class-name class)
+                                                           method-name
+                                                           (descriptor.descriptor method-descriptor)
+                                                           interface?))))]
 
   [INVOKESTATIC    org/objectweb/asm/Opcodes::INVOKESTATIC]
   [INVOKEVIRTUAL   org/objectweb/asm/Opcodes::INVOKEVIRTUAL]
@@ -346,10 +363,10 @@
         (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
 
 (def: #export (try @from @to @handler exception)
-  (-> //.Label //.Label //.Label (Descriptor descriptor.Class) Inst)
+  (-> //.Label //.Label //.Label (Type Class) Inst)
   (function (_ visitor)
     (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (descriptor.class-name exception)))))
+      (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception)))))
 
 (def: #export (label @label)
   (-> //.Label Inst)
@@ -358,8 +375,8 @@
       (org/objectweb/asm/MethodVisitor::visitLabel @label))))
 
 (def: #export (array type)
-  (-> (Descriptor descriptor.Value) Inst)
-  (case (descriptor.primitive? type)
+  (-> (Type Value) Inst)
+  (case (type.primitive? type)
     (#.Left object)
     (ANEWARRAY object)
 
@@ -368,18 +385,18 @@
 
 (template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>]
   [(def: (<name> type)
-     (-> (Descriptor Primitive) Text)
+     (-> (Type Primitive) Text)
      (`` (cond (~~ (template [<descriptor> <output>]
-                     [(descriptor@= <descriptor> type) <output>]
+                     [(type@= <descriptor> type) <output>]
                      
-                     [descriptor.boolean <boolean>]
-                     [descriptor.byte    <byte>]
-                     [descriptor.short   <short>]
-                     [descriptor.int     <int>]
-                     [descriptor.long    <long>]
-                     [descriptor.float   <float>]
-                     [descriptor.double  <double>]
-                     [descriptor.char    <char>]))
+                     [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))))]
 
@@ -392,15 +409,15 @@
   )
 
 (def: #export (wrap type)
-  (-> (Descriptor Primitive) Inst)
-  (let [wrapper (descriptor.class (primitive-wrapper type))]
-    (INVOKESTATIC wrapper "valueOf" (descriptor.method [(list type) wrapper]) #0)))
+  (-> (Type Primitive) Inst)
+  (let [wrapper (type.class (primitive-wrapper type) (list))]
+    (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)]) #0)))
 
 (def: #export (unwrap type)
-  (-> (Descriptor Primitive) Inst)
-  (let [wrapper (descriptor.class (primitive-wrapper type))]
+  (-> (Type Primitive) Inst)
+  (let [wrapper (type.class (primitive-wrapper type) (list))]
     (|>> (CHECKCAST wrapper)
-         (INVOKEVIRTUAL wrapper (primitive-unwrap type) (descriptor.method [(list) type]) #0))))
+         (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]) #0))))
 
 (def: #export (fuse insts)
   (-> (List Inst) Inst)