From 6af3807793eba127bda2d2c68b235e6645936787 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 17 Apr 2019 23:19:09 -0400
Subject: Fixed a bug when generating method calls.

---
 new-luxc/source/luxc/lang/host/jvm/type.lux        | 40 +++++++++++++++-------
 .../luxc/lang/translation/jvm/procedure/host.lux   | 16 +++++++--
 2 files changed, 40 insertions(+), 16 deletions(-)

(limited to 'new-luxc')

diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
index 72a1925b4..909344d24 100644
--- a/new-luxc/source/luxc/lang/host/jvm/type.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -1,13 +1,13 @@
 (.module:
   [lux (#- int char)
    [data
+    ["." maybe ("#@." functor)]
     ["." text
      format]
     [collection
-     ["." list ("#/." functor)]]]]
+     ["." list ("#@." functor)]]]]
   ["." //])
 
-## Types
 (template [<name> <primitive>]
   [(def: #export <name> //.Type (#//.Primitive <primitive>))]
 
@@ -21,16 +21,13 @@
   [char    #//.Char]
   )
 
-(def: #export (class name params)
-  (-> Text (List //.Generic) //.Type)
+(template: #export (class name params)
   (#//.Generic (#//.Class name params)))
 
-(def: #export (var name)
-  (-> Text //.Type)
+(template: #export (var name)
   (#//.Generic (#//.Var name)))
 
-(def: #export (wildcard bound)
-  (-> (Maybe [//.Bound //.Generic]) //.Type)
+(template: #export (wildcard bound)
   (#//.Generic (#//.Wildcard bound)))
 
 (def: #export (array depth elemT)
@@ -69,6 +66,24 @@
       (descriptor (#//.Generic (#//.Class "java.lang.Object" (list)))))
     ))
 
+(def: #export (class-name type)
+  (-> //.Type (Maybe Text))
+  (case type
+    (#//.Primitive prim)
+    #.None
+
+    (#//.Array sub)
+    (#.Some (descriptor type))
+
+    (#//.Generic generic)
+    (case generic
+      (#//.Class class params)
+      (#.Some class)
+
+      (^or (#//.Var name) (#//.Wildcard ?bound))
+      (#.Some "java.lang.Object"))
+    ))
+
 (def: #export (signature type)
   (-> //.Type Text)
   (case type
@@ -93,7 +108,7 @@
                       ""
                       (format "<"
                               (|> params
-                                  (list/map (|>> #//.Generic signature))
+                                  (list@map (|>> #//.Generic signature))
                                   (text.join-with ""))
                               ">"))]
         (format "L" (binary-name class) =params ";"))
@@ -111,14 +126,13 @@
        [#//.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 "" (list/map descriptor (get@ #//.args method))) ")"
+  (format "(" (text.join-with "" (list@map descriptor (get@ #//.args method))) ")"
           (case (get@ #//.return method)
             #.None
             "V"
@@ -128,7 +142,7 @@
 
 (def: #export (method-signature method)
   (-> //.Method Text)
-  (format "(" (|> (get@ #//.args method) (list/map signature) (text.join-with "")) ")"
+  (format "(" (|> (get@ #//.args method) (list@map signature) (text.join-with "")) ")"
           (case (get@ #//.return method)
             #.None
             "V"
@@ -136,5 +150,5 @@
             (#.Some return)
             (signature return))
           (|> (get@ #//.exceptions method)
-              (list/map (|>> #//.Generic signature (format "^")))
+              (list@map (|>> #//.Generic signature (format "^")))
               (text.join-with ""))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index 2e39860fc..a9df2710c 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -671,6 +671,16 @@
     _
     (phase@map (|>> #.Some) (generate-type description))))
 
+(def: (prepare-argI [type argI])
+  (-> [$.Type Inst] Inst)
+  (case (_t.class-name type)
+    (#.Some class-name)
+    (|>> argI
+         (_.CHECKCAST class-name))
+
+    #.None
+    argI))
+
 (def: (invoke::static proc generate inputs)
   Handler
   (case inputs
@@ -681,7 +691,7 @@
     (do phase.monad
       [argsTI (monad.map @ (generate-arg generate) argsS)
        returnT (method-return-type unboxed)]
-      (wrap (|>> (_.fuse (list@map product.right argsTI))
+      (wrap (|>> (_.fuse (list@map ..prepare-argI argsTI))
                  (_.INVOKESTATIC class method
                                  (_t.method (list@map product.left argsTI) returnT (list))
                                  false))))
@@ -704,7 +714,7 @@
           returnT (method-return-type unboxed)]
          (wrap (|>> objectI
                     (_.CHECKCAST class)
-                    (_.fuse (list@map product.right argsTI))
+                    (_.fuse (list@map ..prepare-argI argsTI))
                     (<invoke> class method
                               (_t.method (list@map product.left argsTI) returnT (list))
                               <interface?>))))
@@ -725,7 +735,7 @@
       [argsTI (monad.map @ (generate-arg generate) argsS)]
       (wrap (|>> (_.NEW class)
                  _.DUP
-                 (_.fuse (list@map product.right argsTI))
+                 (_.fuse (list@map ..prepare-argI argsTI))
                  (_.INVOKESPECIAL class "<init>"
                                   (_t.method (list@map product.left argsTI) #.None (list))
                                   false))))
-- 
cgit v1.2.3