diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/extension/host.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/extension/host.lux | 104 |
1 files changed, 53 insertions, 51 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux index b5577cfcd..7569a825e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux @@ -31,6 +31,8 @@ [compiler ["." reference (#+ Variable)] ["." phase ("#@." monad)] + [meta + [archive (#+ Archive)]] [language [lux [analysis (#+ Environment)] @@ -335,9 +337,9 @@ (-> (Type Primitive) Handler) (..custom [<s>.any - (function (_ extension-name generate arrayS) + (function (_ extension-name generate archive arrayS) (do phase.monad - [arrayI (generate arrayS)] + [arrayI (generate archive arrayS)] (wrap (|>> arrayI (_.CHECKCAST (type.array jvm-primitive)) _.ARRAYLENGTH))))])) @@ -346,20 +348,20 @@ Handler (..custom [($_ <>.and ..object-array <s>.any) - (function (_ extension-name generate [elementJT arrayS]) + (function (_ extension-name generate archive [elementJT arrayS]) (do phase.monad - [arrayI (generate arrayS)] + [arrayI (generate archive arrayS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) _.ARRAYLENGTH))))])) (def: (new-primitive-array-handler jvm-primitive) (-> (Type Primitive) Handler) - (function (_ extension-name generate inputs) + (function (_ extension-name generate archive inputs) (case inputs (^ (list lengthS)) (do phase.monad - [lengthI (generate lengthS)] + [lengthI (generate archive lengthS)] (wrap (|>> lengthI (_.array jvm-primitive)))) @@ -370,20 +372,20 @@ Handler (..custom [($_ <>.and ..object <s>.any) - (function (_ extension-name generate [objectJT lengthS]) + (function (_ extension-name generate archive [objectJT lengthS]) (do phase.monad - [lengthI (generate lengthS)] + [lengthI (generate archive lengthS)] (wrap (|>> lengthI (_.ANEWARRAY objectJT)))))])) (def: (read-primitive-array-handler jvm-primitive loadI) (-> (Type Primitive) Inst Handler) - (function (_ extension-name generate inputs) + (function (_ extension-name generate archive inputs) (case inputs (^ (list idxS arrayS)) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS)] (wrap (|>> arrayI (_.CHECKCAST (type.array jvm-primitive)) idxI @@ -396,10 +398,10 @@ Handler (..custom [($_ <>.and ..object-array <s>.any <s>.any) - (function (_ extension-name generate [elementJT idxS arrayS]) + (function (_ extension-name generate archive [elementJT idxS arrayS]) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) idxI @@ -407,13 +409,13 @@ (def: (write-primitive-array-handler jvm-primitive storeI) (-> (Type Primitive) Inst Handler) - (function (_ extension-name generate inputs) + (function (_ extension-name generate archive inputs) (case inputs (^ (list idxS valueS arrayS)) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS) - valueI (generate valueS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS) + valueI (generate archive valueS)] (wrap (|>> arrayI (_.CHECKCAST (type.array jvm-primitive)) _.DUP @@ -428,11 +430,11 @@ Handler (..custom [($_ <>.and ..object-array <s>.any <s>.any <s>.any) - (function (_ extension-name generate [elementJT idxS valueS arrayS]) + (function (_ extension-name generate archive [elementJT idxS valueS arrayS]) (do phase.monad - [arrayI (generate arrayS) - idxI (generate idxS) - valueI (generate valueS)] + [arrayI (generate archive arrayS) + idxI (generate archive idxS) + valueI (generate archive valueS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) _.DUP @@ -522,7 +524,7 @@ (def: $Class (type.class "java.lang.Class" (list))) -(def: (object::class extension-name generate inputs) +(def: (object::class extension-name generate archive inputs) Handler (case inputs (^ (list (synthesis.text class))) @@ -538,19 +540,19 @@ Handler (..custom [($_ <>.and <s>.text <s>.any) - (function (_ extension-name generate [class objectS]) + (function (_ extension-name generate archive [class objectS]) (do phase.monad - [objectI (generate objectS)] + [objectI (generate archive objectS)] (wrap (|>> objectI (_.INSTANCEOF (type.class class (list))) (_.wrap type.boolean)))))])) -(def: (object::cast extension-name generate inputs) +(def: (object::cast extension-name generate archive inputs) Handler (case inputs (^ (list (synthesis.text from) (synthesis.text to) valueS)) (do phase.monad - [valueI (generate valueS)] + [valueI (generate archive valueS)] (`` (cond (~~ (template [<object> <type>] [(and (text@= (reflection.reflection (type.reflection <type>)) from) @@ -607,7 +609,7 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text) - (function (_ extension-name generate [class field unboxed]) + (function (_ extension-name generate archive [class field unboxed]) (do phase.monad [] (case (dictionary.get unboxed ..primitives) @@ -621,9 +623,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate [class field unboxed valueS]) + (function (_ extension-name generate archive [class field unboxed valueS]) (do phase.monad - [valueI (generate valueS) + [valueI (generate archive valueS) #let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -641,9 +643,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate [class field unboxed objectS]) + (function (_ extension-name generate archive [class field unboxed objectS]) (do phase.monad - [objectI (generate objectS) + [objectI (generate archive objectS) #let [$class (type.class class (list)) getI (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -659,10 +661,10 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any) - (function (_ extension-name generate [class field unboxed valueS objectS]) + (function (_ extension-name generate archive [class field unboxed valueS objectS]) (do phase.monad - [valueI (generate valueS) - objectI (generate objectS) + [valueI (generate archive valueS) + objectI (generate archive objectS) #let [$class (type.class class (list)) putI (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -684,11 +686,11 @@ (Parser Input) (<s>.tuple (<>.and ..value <s>.any))) -(def: (generate-input generate [valueT valueS]) - (-> (-> Synthesis (Operation Inst)) Input +(def: (generate-input generate archive [valueT valueS]) + (-> Phase Archive Input (Operation (Typed Inst))) (do phase.monad - [valueI (generate valueS)] + [valueI (generate archive valueS)] (case (type.primitive? valueT) (#.Right valueT) (wrap [valueT valueI]) @@ -712,9 +714,9 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) - (function (_ extension-name generate [class method outputT inputsTS]) + (function (_ extension-name generate archive [class method outputT inputsTS]) (do phase.monad - [inputsTI (monad.map @ (generate-input generate) inputsTS)] + [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> (_.fuse (list@map product.right inputsTI)) (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)])) (prepare-output outputT)))))])) @@ -724,10 +726,10 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) - (function (_ extension-name generate [class method outputT objectS inputsTS]) + (function (_ extension-name generate archive [class method outputT objectS inputsTS]) (do phase.monad - [objectI (generate objectS) - inputsTI (monad.map @ (generate-input generate) inputsTS)] + [objectI (generate archive objectS) + inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> objectI (_.CHECKCAST class) (_.fuse (list@map product.right inputsTI)) @@ -746,9 +748,9 @@ Handler (..custom [($_ <>.and ..class (<>.some ..input)) - (function (_ extension-name generate [class inputsTS]) + (function (_ extension-name generate archive [class inputsTS]) (do phase.monad - [inputsTI (monad.map @ (generate-input generate) inputsTS)] + [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> (_.NEW class) _.DUP (_.fuse (list@map product.right inputsTI)) @@ -953,10 +955,10 @@ (<s>.tuple (<>.some ..class)) (<s>.tuple (<>.some ..input)) (<s>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name generate [class-name - super-class super-interfaces - inputsTS - overriden-methods]) + (function (_ extension-name generate archive [class-name + super-class super-interfaces + inputsTS + overriden-methods]) (do phase.monad [#let [class (type.class class-name (list)) total-environment (|> overriden-methods @@ -991,7 +993,7 @@ self-name arguments returnT exceptionsT (normalize-method-body local-mapping body)])) overriden-methods)] - inputsTI (monad.map @ (generate-input generate) inputsTS) + inputsTI (monad.map @ (generate-input generate archive) inputsTS) method-definitions (|> normalized-methods (monad.map @ (function (_ [ownerT name strict-fp? annotations vars @@ -999,7 +1001,7 @@ bodyS]) (do @ [bodyG (generation.with-specific-context class-name - (generate bodyS))] + (generate archive bodyS))] (wrap (_def.method #$.Public (if strict-fp? ($_ $.++M $.finalM $.strictM) |