aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
authorEduardo Julian2019-04-17 23:19:09 -0400
committerEduardo Julian2019-04-17 23:19:09 -0400
commit6af3807793eba127bda2d2c68b235e6645936787 (patch)
tree9b9fc16a1cfe6f5358da481028f7878a972eba8e /new-luxc/source/luxc/lang
parenta2e790c57c49104c63c26a306158141980791da8 (diff)
Fixed a bug when generating method calls.
Diffstat (limited to 'new-luxc/source/luxc/lang')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/type.lux40
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux16
2 files changed, 40 insertions, 16 deletions
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))))