aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/procedure
diff options
context:
space:
mode:
authorEduardo Julian2019-05-16 21:18:23 -0400
committerEduardo Julian2019-05-16 21:18:23 -0400
commitea0cff44a5f003f8956ffbce9ea5f6957fdf4c92 (patch)
tree2e1d18dc3cc41576e9cb128ab203a8f955e66ceb /new-luxc/source/luxc/lang/translation/jvm/procedure
parent0a06ea82722b863af8d0f75762068054008b27ac (diff)
Yet more fiddling with types for JVM interop.
+ Some progress on anonymous classes. + More elaborate handling of JVM arrays.
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux239
1 files changed, 124 insertions, 115 deletions
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 55798c806..be2a0bace 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -31,6 +31,8 @@
["." generation
[extension (#+ Nullary Unary Binary
nullary unary binary)]]
+ [analysis
+ [".A" reference]]
["." extension
["." bundle]
[analysis
@@ -39,17 +41,27 @@
[luxc
[lang
[host
- ["$" jvm (#+ Label Inst Handler Bundle Operation Phase)
+ ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
["_" inst]
- ["_." def]]]]])
+ ["_." def]]]]]
+ ["." /// #_
+ ["#." reference]
+ ["#." function]])
-(template [<name>]
- [(exception: #export (<name> {message Text})
- message)]
+(exception: #export invalid-syntax-for-argument-generation)
- [invalid-syntax-for-jvm-type]
- [invalid-syntax-for-argument-generation]
- )
+(def: (custom [parser handler])
+ (All [s]
+ (-> [(<s>.Parser s)
+ (-> Text Phase s (Operation Inst))]
+ Handler))
+ (function (_ extension-name phase input)
+ (case (<s>.run input parser)
+ (#error.Success input')
+ (handler extension-name phase input')
+
+ (#error.Failure error)
+ (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
(template [<name> <inst>]
[(def: <name>
@@ -306,7 +318,17 @@
"char" jvm.char
_ (jvm.class elem-class (list)))))
-(def: (array::length extension-name generate inputs)
+(def: (primitive-array-length-handler jvm-primitive)
+ (-> Type Handler)
+ (..custom [<s>.any
+ (function (_ extension-name generate arrayS)
+ (do phase.monad
+ [arrayI (generate arrayS)]
+ (wrap (|>> arrayI
+ (_.CHECKCAST (jvm.descriptor (jvm.array 1 jvm-primitive)))
+ _.ARRAYLENGTH))))]))
+
+(def: (array::length::object extension-name generate inputs)
Handler
(case inputs
(^ (list (synthesis.i64 nesting)
@@ -427,7 +449,17 @@
Bundle
(<| (bundle.prefix "array")
(|> bundle.empty
- (bundle.install "length" array::length)
+ (dictionary.merge (<| (bundle.prefix "length")
+ (|> bundle.empty
+ (bundle.install "boolean" (primitive-array-length-handler jvm.boolean))
+ (bundle.install "byte" (primitive-array-length-handler jvm.byte))
+ (bundle.install "short" (primitive-array-length-handler jvm.short))
+ (bundle.install "int" (primitive-array-length-handler jvm.int))
+ (bundle.install "long" (primitive-array-length-handler jvm.long))
+ (bundle.install "float" (primitive-array-length-handler jvm.float))
+ (bundle.install "double" (primitive-array-length-handler jvm.double))
+ (bundle.install "char" (primitive-array-length-handler jvm.char))
+ (bundle.install "object" array::length::object))))
(dictionary.merge (<| (bundle.prefix "new")
(|> bundle.empty
(bundle.install "boolean" (new-primitive-array-handler jvm.boolean))
@@ -671,62 +703,30 @@
_
(phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-(def: base-type
- (<t>.Parser Type)
- ($_ <>.either
- (<>.after (<t>.this "boolean") (<>@wrap jvm.boolean))
- (<>.after (<t>.this "byte") (<>@wrap jvm.byte))
- (<>.after (<t>.this "short") (<>@wrap jvm.short))
- (<>.after (<t>.this "int") (<>@wrap jvm.int))
- (<>.after (<t>.this "long") (<>@wrap jvm.long))
- (<>.after (<t>.this "float") (<>@wrap jvm.float))
- (<>.after (<t>.this "double") (<>@wrap jvm.double))
- (<>.after (<t>.this "char") (<>@wrap jvm.char))
- (<>@map (function (_ name)
- (jvm.class name (list)))
- (<t>.many (<t>.none-of "[")))
- ))
-
-(def: java-type
- (<t>.Parser Type)
- (do <>.monad
- [raw base-type
- nesting (<>.some (<t>.this "[]"))]
- (wrap (jvm.array (list.size nesting) raw))))
-
-(def: (generate-type argD)
- (-> Text (Operation Type))
- (case (<t>.run java-type argD)
- (#error.Failure error)
- (phase.throw invalid-syntax-for-jvm-type argD)
-
- (#error.Success type)
- (phase@wrap type)))
-
(def: (generate-arg generate argS)
(-> (-> Synthesis (Operation Inst)) Synthesis
(Operation [Type Inst]))
(case argS
(^ (synthesis.tuple (list (synthesis.text argD) argS)))
(do phase.monad
- [argD (phase.lift (:: error.monad map
- jvm.reflection-class
- (jvm.parse-signature argD)))
- argT (generate-type argD)
+ [argT (phase.lift (<t>.run jvm.parse-signature argD))
argI (generate argS)]
(wrap [argT argI]))
_
- (phase.throw invalid-syntax-for-argument-generation "")))
+ (phase.throw invalid-syntax-for-argument-generation [])))
(def: (method-return-type description)
(-> Text (Operation (Maybe Type)))
(case description
- "void"
+ (^ (static jvm.void-descriptor))
(phase@wrap #.None)
_
- (phase@map (|>> #.Some) (generate-type description))))
+ (|> description
+ (<t>.run jvm.parse-signature)
+ phase.lift
+ (phase@map (|>> #.Some)))))
(def: (prepare-argI [type argI])
(-> [Type Inst] Inst)
@@ -738,46 +738,35 @@
#.None
argI))
-(def: (invoke::static extension-name generate inputs)
+(def: invoke::static
Handler
- (case inputs
- (^ (list& (synthesis.text class)
- (synthesis.text method)
- (synthesis.text unboxed)
- argsS))
- (do phase.monad
- [argsTI (monad.map @ (generate-arg generate) argsS)
- returnT (method-return-type unboxed)]
- (wrap (|>> (_.fuse (list@map ..prepare-argI argsTI))
- (_.INVOKESTATIC class method
- (jvm.method (list@map product.left argsTI) returnT (list))
- false))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+ (..custom
+ [($_ <>.and <s>.text <s>.text <s>.text (<>.some <s>.any))
+ (function (_ extension-name generate [class method unboxed argsS])
+ (do phase.monad
+ [argsTI (monad.map @ (generate-arg generate) argsS)
+ returnT (method-return-type unboxed)]
+ (wrap (|>> (_.fuse (list@map ..prepare-argI argsTI))
+ (_.INVOKESTATIC class method
+ (jvm.method (list@map product.left argsTI) returnT (list))
+ false)))))]))
(template [<name> <invoke> <interface?>]
- [(def: (<name> extension-name generate inputs)
+ [(def: <name>
Handler
- (case inputs
- (^ (list& (synthesis.text class)
- (synthesis.text method)
- (synthesis.text unboxed)
- objectS
- argsS))
- (do phase.monad
- [objectI (generate objectS)
- argsTI (monad.map @ (generate-arg generate) argsS)
- returnT (method-return-type unboxed)]
- (wrap (|>> objectI
- (_.CHECKCAST class)
- (_.fuse (list@map ..prepare-argI argsTI))
- (<invoke> class method
- (jvm.method (list@map product.left argsTI) returnT (list))
- <interface?>))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))]
+ (..custom
+ [($_ <>.and <s>.text <s>.text <s>.text <s>.any (<>.some <s>.any))
+ (function (_ extension-name generate [class method unboxed objectS argsS])
+ (do phase.monad
+ [objectI (generate objectS)
+ argsTI (monad.map @ (generate-arg generate) argsS)
+ returnT (method-return-type unboxed)]
+ (wrap (|>> objectI
+ (_.CHECKCAST class)
+ (_.fuse (list@map ..prepare-argI argsTI))
+ (<invoke> class method
+ (jvm.method (list@map product.left argsTI) returnT (list))
+ <interface?>)))))]))]
[invoke::virtual _.INVOKEVIRTUAL false]
[invoke::special _.INVOKESPECIAL false]
@@ -821,19 +810,6 @@
(bundle.install "constructor" invoke::constructor))))
)))
-(def: (custom [parser handler])
- (All [s]
- (-> [(<s>.Parser s)
- (-> Text Phase s (Operation Inst))]
- Handler))
- (function (_ extension-name phase input)
- (case (<s>.run input parser)
- (#error.Success input')
- (handler extension-name phase input')
-
- (#error.Failure error)
- (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
-
(def: var
(<s>.Parser Var)
<s>.text)
@@ -902,7 +878,7 @@
(def: return
(<s>.Parser Return)
- (<>.or (<s>.constant! ["" "void"])
+ (<>.or (<s>.constant! ["" jvm.void-descriptor])
..jvm-type))
(def: overriden-method-definition
@@ -998,6 +974,39 @@
(#synthesis.Extension [name inputsS+])
(#synthesis.Extension [name (list@map recur inputsS+)]))))
+(def: $Object (jvm.class jvm.object-class (list)))
+
+(def: (anonymous-init-method env)
+ (-> Environment Method)
+ (jvm.method (list.repeat (list.size env) $Object)
+ #.None
+ (list)))
+
+(def: (with-anonymous-init class env)
+ (-> Text Environment Def)
+ (let [store-capturedI (|> env
+ list.size
+ list.indices
+ (list@map (.function (_ register)
+ (|>> (_.ALOAD 0)
+ (_.ALOAD (inc register))
+ (_.PUTFIELD class (///reference.foreign-name register) $Object))))
+ _.fuse)]
+ (_def.method #$.Public $.noneM "<init>" (anonymous-init-method env)
+ (|>> (_.ALOAD 0)
+ (_.INVOKESPECIAL jvm.object-class "<init>" (jvm.method (list) #.None (list)) #0)
+ store-capturedI
+ _.RETURN))))
+
+(def: (anonymous-instance class env)
+ (-> Text Environment (Operation Inst))
+ (do phase.monad
+ [captureI+ (monad.map @ ///reference.variable env)]
+ (wrap (|>> (_.NEW class)
+ _.DUP
+ (_.fuse captureI+)
+ (_.INVOKESPECIAL class "<init>" (anonymous-init-method env) #0)))))
+
(def: class::anonymous
Handler
(..custom
@@ -1012,14 +1021,15 @@
constructor-args
overriden-methods])
(do phase.monad
- [#let [global-mapping (|> overriden-methods
- ## Get all the environments.
- (list@map product.left)
- ## Combine them.
- list@join
- ## Remove duplicates.
- (set.from-list reference.hash)
- set.to-list
+ [#let [total-environment (|> overriden-methods
+ ## Get all the environments.
+ (list@map product.left)
+ ## Combine them.
+ list@join
+ ## Remove duplicates.
+ (set.from-list reference.hash)
+ set.to-list)
+ global-mapping (|> total-environment
## Give them names as "foreign" variables.
list.enumerate
(list@map (function (_ [id capture])
@@ -1043,14 +1053,13 @@
self-name arguments returnT exceptionsT
(normalize-method-body local-mapping body)]))
overriden-methods)]
- ## _ (generation.save! true ["" function-class]
- ## [function-class
- ## (def.class #$.V1_6 #$.Public $.finalC
- ## function-class (list)
- ## ($.simple-class //.function-class) (list)
- ## functionD)])
- _ (phase.throw extension.invalid-syntax ["YOLO-TRON" %synthesis (list)])]
- (wrap _.DUP)))]))
+ _ (generation.save! true ["" class-name]
+ [class-name
+ (_def.class #$.V1_6 #$.Public $.finalC
+ class-name (list)
+ super-class super-interfaces
+ (|>> (///function.with-environment total-environment)))])]
+ (anonymous-instance class-name total-environment)))]))
(def: bundle::class
Bundle