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

1 files changed, 53 insertions, 49 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
index 0f3a89faf..594964be0 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Type)
    [abstract
     [monad (#+ do)]]
    [data
@@ -8,8 +8,10 @@
    ["." math]
    [target
     [jvm
-     [type
-      ["." descriptor (#+ Descriptor)]]]]
+     ["." type (#+ Type)
+      ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+      ["." descriptor (#+ Descriptor)]
+      ["." signature (#+ Signature)]]]]
    [tool
     [compiler
      [arity (#+ Arity)]
@@ -24,36 +26,36 @@
       ["_" inst]]]]]
   ["." // (#+ ByteCode)])
 
-(def: $Text (descriptor.class "java.lang.String"))
-(def: #export $Tag descriptor.int)
-(def: #export $Flag (descriptor.class "java.lang.Object"))
-(def: #export $Value (descriptor.class "java.lang.Object"))
-(def: #export $Index descriptor.int)
-(def: #export $Stack (descriptor.array $Value))
-(def: $Throwable (descriptor.class "java.lang.Throwable"))
-(def: #export $Runtime (descriptor.class "java.lang.Runtime"))
+(def: $Text (type.class "java.lang.String" (list)))
+(def: #export $Tag type.int)
+(def: #export $Flag (type.class "java.lang.Object" (list)))
+(def: #export $Value (type.class "java.lang.Object" (list)))
+(def: #export $Index type.int)
+(def: #export $Stack (type.array $Value))
+(def: $Throwable (type.class "java.lang.Throwable" (list)))
+(def: #export $Runtime (type.class "java.lang.Runtime" (list)))
 
 (def: nullary-init-methodT
-  (descriptor.method [(list) descriptor.void]))
+  (type.method [(list) type.void (list)]))
 
 (def: throw-methodT
-  (descriptor.method [(list) descriptor.void]))
+  (type.method [(list) type.void (list)]))
 
 (def: #export logI
   Inst
-  (let [PrintStream (descriptor.class "java.io.PrintStream")
-        outI (_.GETSTATIC (descriptor.class "java.lang.System") "out" PrintStream)
+  (let [PrintStream (type.class "java.io.PrintStream" (list))
+        outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream)
         printI (function (_ method)
-                 (_.INVOKEVIRTUAL PrintStream method (descriptor.method [(list $Value) descriptor.void]) #0))]
+                 (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)]) #0))]
     (|>> outI (_.string "LOG: ") (printI "print")
          outI _.SWAP (printI "println"))))
 
 (def: variant-method
-  (descriptor.method [(list $Tag $Flag $Value) //.$Variant]))
+  (type.method [(list $Tag $Flag $Value) //.$Variant (list)]))
 
 (def: #export variantI
   Inst
-  (_.INVOKESTATIC (descriptor.class //.runtime-class) "variant_make" variant-method #0))
+  (_.INVOKESTATIC (type.class //.runtime-class (list)) "variant_make" variant-method #0))
 
 (def: #export leftI
   Inst
@@ -85,7 +87,7 @@
   (<| _.with-label (function (_ @from))
       _.with-label (function (_ @to))
       _.with-label (function (_ @handler))
-      (|>> (_.try @from @to @handler (descriptor.class "java.lang.Exception"))
+      (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list)))
            (_.label @from)
            unsafeI
            someI
@@ -97,23 +99,23 @@
 
 (def: #export string-concatI
   Inst
-  (_.INVOKEVIRTUAL $Text "concat" (descriptor.method [(list $Text) $Text]) #0))
+  (_.INVOKEVIRTUAL $Text "concat" (type.method [(list $Text) $Text (list)]) #0))
 
 (def: #export partials-field Text "partials")
 (def: #export apply-method Text "apply")
 (def: #export num-apply-variants Nat 8)
 
 (def: #export (apply-signature arity)
-  (-> Arity (Descriptor descriptor.Method))
-  (descriptor.method [(list.repeat arity $Value) $Value]))
+  (-> Arity [(Signature Method) (Descriptor Method)])
+  (type.method [(list.repeat arity $Value) $Value (list)]))
 
 (def: adt-methods
   Def
-  (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap descriptor.int) _.AASTORE)
+  (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
         store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
         store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
     (|>> ($d.method #$.Public $.staticM "variant_make"
-                    (descriptor.method [(list $Tag $Flag $Value) //.$Variant])
+                    (type.method [(list $Tag $Flag $Value) //.$Variant (list)])
                     (|>> (_.int +3)
                          (_.array //.$Variant)
                          store-tagI
@@ -125,11 +127,11 @@
 
 (def: frac-methods
   Def
-  (|>> ($d.method #$.Public $.staticM "decode_frac" (descriptor.method [(list $Text) //.$Variant])
+  (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)])
                   (try-methodI
                    (|>> (_.ALOAD 0)
-                        (_.INVOKESTATIC (descriptor.class "java.lang.Double") "parseDouble" (descriptor.method [(list $Text) descriptor.double]) #0)
-                        (_.wrap descriptor.double))))
+                        (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)]) #0)
+                        (_.wrap type.double))))
        ))
 
 (def: #export popI
@@ -143,11 +145,11 @@
 
 (def: (illegal-state-exception message)
   (-> Text Inst)
-  (let [IllegalStateException (descriptor.class "java.lang.IllegalStateException")]
+  (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))]
     (|>> (_.NEW IllegalStateException)
          _.DUP
          (_.string message)
-         (_.INVOKESPECIAL IllegalStateException "<init>" (descriptor.method [(list $Text) descriptor.void]) #0))))
+         (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list $Text) type.void (list)]) #0))))
 
 (def: pm-methods
   Def
@@ -170,7 +172,7 @@
          ($d.method #$.Public $.staticM "apply_fail" throw-methodT
                     (|>> (illegal-state-exception "Error while applying function.")
                          _.ATHROW))
-         ($d.method #$.Public $.staticM "pm_push" (descriptor.method [(list $Stack $Value) $Stack])
+         ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)])
                     (|>> (_.int +2)
                          (_.ANEWARRAY $Stack)
                          _.DUP
@@ -182,7 +184,7 @@
                          (_.ALOAD 1)
                          _.AASTORE
                          _.ARETURN))
-         ($d.method #$.Public $.staticM "pm_variant" (descriptor.method [(list //.$Variant $Tag $Flag) $Value])
+         ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
                     (<| _.with-label (function (_ @loop))
                         _.with-label (function (_ @just-return))
                         _.with-label (function (_ @then))
@@ -193,7 +195,7 @@
                                                (function (_ idx)
                                                  (|>> (_.int (.int idx)) _.AALOAD)))
                               tagI (: Inst
-                                      (|>> (variant-partI 0) (_.unwrap descriptor.int)))
+                                      (|>> (variant-partI 0) (_.unwrap type.int)))
                               flagI (variant-partI 1)
                               datumI (variant-partI 2)
                               shortenI (|>> (_.ALOAD 0) tagI ## Get tag
@@ -234,7 +236,7 @@
                              (_.label @wrong) ## tag, sumT
                              ## _.POP2
                              failureI)))
-         ($d.method #$.Public $.staticM "tuple_left" (descriptor.method [(list //.$Tuple $Index) $Value])
+         ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)])
                     (<| _.with-label (function (_ @loop))
                         _.with-label (function (_ @recursive))
                         (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
@@ -245,7 +247,7 @@
                              (_.label @recursive)
                              ## Recursive
                              (recurI @loop))))
-         ($d.method #$.Public $.staticM "tuple_right" (descriptor.method [(list //.$Tuple $Index) $Value])
+         ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)])
                     (<| _.with-label (function (_ @loop))
                         _.with-label (function (_ @not-tail))
                         _.with-label (function (_ @slice))
@@ -258,9 +260,10 @@
                               sub-rightI (|>> (_.ALOAD 0)
                                               right-indexI
                                               tuple-sizeI
-                                              (_.INVOKESTATIC (descriptor.class "java.util.Arrays") "copyOfRange"
-                                                              (descriptor.method [(list //.$Tuple $Index $Index)
-                                                                                  //.$Tuple])
+                                              (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange"
+                                                              (type.method [(list //.$Tuple $Index $Index)
+                                                                            //.$Tuple
+                                                                            (list)])
                                                               #0))])
                         (|>> (_.label @loop)
                              last-rightI right-indexI
@@ -280,8 +283,8 @@
 
 (def: io-methods
   Def
-  (let [StringWriter (descriptor.class "java.io.StringWriter")
-        PrintWriter (descriptor.class "java.io.PrintWriter")
+  (let [StringWriter (type.class "java.io.StringWriter" (list))
+        PrintWriter (type.class "java.io.PrintWriter" (list))
         string-writerI (|>> (_.NEW StringWriter)
                             _.DUP
                             (_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT #0))
@@ -291,9 +294,9 @@
                            _.POP
                            _.SWAP
                            (_.boolean true)
-                           (_.INVOKESPECIAL PrintWriter "<init>" (descriptor.method [(list (descriptor.class "java.io.Writer") descriptor.boolean) descriptor.void]) #0)
+                           (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]) #0)
                            )]
-    (|>> ($d.method #$.Public $.staticM "try" (descriptor.method [(list //.$Function) //.$Variant])
+    (|>> ($d.method #$.Public $.staticM "try" (type.method [(list //.$Function) //.$Variant (list)])
                     (<| _.with-label (function (_ @from))
                         _.with-label (function (_ @to))
                         _.with-label (function (_ @handler))
@@ -309,15 +312,15 @@
                              string-writerI ## TW
                              _.DUP2 ## TWTW
                              print-writerI ## TWTP
-                             (_.INVOKEVIRTUAL $Throwable "printStackTrace" (descriptor.method [(list (descriptor.class "java.io.PrintWriter")) descriptor.void]) #0) ## TW
-                             (_.INVOKEVIRTUAL StringWriter "toString" (descriptor.method [(list) $Text]) #0) ## TS
+                             (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)]) #0) ## TW
+                             (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)]) #0) ## TS
                              _.SWAP _.POP leftI
                              _.ARETURN)))
          )))
 
 (def: translate-runtime
   (Operation ByteCode)
-  (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list)
+  (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) (type.class "java.lang.Object" (list)) (list)
                            (|>> adt-methods
                                 frac-methods
                                 pm-methods
@@ -342,14 +345,15 @@
                                                  _.ARETURN)))))
                    (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
                    $d.fuse)
-        bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list)
-                              (|>> ($d.field #$.Public $.finalF partials-field descriptor.int)
-                                   ($d.method #$.Public $.noneM "<init>" (descriptor.method [(list descriptor.int) descriptor.void])
+        $Object (type.class "java.lang.Object" (list))
+        bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) $Object (list)
+                              (|>> ($d.field #$.Public $.finalF partials-field type.int)
+                                   ($d.method #$.Public $.noneM "<init>" (type.method [(list type.int) type.void (list)])
                                               (|>> (_.ALOAD 0)
-                                                   (_.INVOKESPECIAL (descriptor.class "java.lang.Object") "<init>" nullary-init-methodT #0)
+                                                   (_.INVOKESPECIAL $Object "<init>" nullary-init-methodT #0)
                                                    (_.ALOAD 0)
                                                    (_.ILOAD 1)
-                                                   (_.PUTFIELD //.$Function partials-field descriptor.int)
+                                                   (_.PUTFIELD //.$Function partials-field type.int)
                                                    _.RETURN))
                                    applyI))]
     (do phase.monad