diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 122 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/type.lux | 13 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux | 59 |
3 files changed, 96 insertions, 98 deletions
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 495d8a7ce..c8d413421 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -22,8 +22,9 @@ ["." list ("#@." monad fold monoid)] ["." dictionary (#+ Dictionary)]]] ["." macro (#+ with-gensyms) + [syntax (#+ syntax:)] ["." code] - [syntax (#+ syntax:)]] + ["." template]] [target ["." jvm #_ ["#" type (#+ Primitive Var Bound Class Generic Type Argument Return Typed)]]]]) @@ -1490,80 +1491,64 @@ (-> Var Code) code.local-identifier) -(template [<name> <unbox/box> - <byte> <for-byte> - <short> <for-short> - <int> <for-int> - <float> <for-float>] +(template [<input?> <name> <unbox/box> <special+>] [(def: (<name> mode [unboxed raw]) (-> Primitive-Mode [Text Code] Code) - (let [[unboxed refined] (case mode - #ManualPrM - [unboxed raw] - - #AutoPrM - (case unboxed - (^ (static jvm.byte-descriptor)) - [<byte> (` (<for-byte> (~ raw)))] - - (^ (static jvm.short-descriptor)) - [<short> (` (<for-short> (~ raw)))] - - (^ (static jvm.int-descriptor)) - [<int> (` (<for-int> (~ raw)))] - - (^ (static jvm.float-descriptor)) - [<float> (` (<for-float> (~ raw)))] - - _ - [unboxed raw]))] - (case (dictionary.get unboxed boxes) - (#.Some boxed) - (<unbox/box> unboxed boxed refined) - - #.None - refined)))] - - [auto-convert-input ..unbox - jvm.byte-descriptor ..long-to-byte - jvm.short-descriptor ..long-to-short - jvm.int-descriptor ..long-to-int - jvm.float-descriptor ..double-to-float] - [auto-convert-output ..box - jvm.long-descriptor "jvm conversion byte-to-long" - jvm.long-descriptor "jvm conversion short-to-long" - jvm.long-descriptor "jvm conversion int-to-long" - jvm.double-descriptor "jvm conversion float-to-double"] + (let [[unboxed refined post] (: [Text Code (List Code)] + (case mode + #ManualPrM + [unboxed raw (list)] + + #AutoPrM + (`` (case unboxed + (^template [<old> <new> <pre> <post>] + (^ (static <old>)) + (with-expansions [<post>' (template.splice <post>)] + [<new> + (` (.|> (~ raw) (~+ <pre>))) + (list <post>')])) + ((~~ (template.splice <special+>))) + + _ + [unboxed + (if <input?> + (` ("jvm object cast" (~ raw))) + raw) + (list)])))) + unboxed/boxed (case (dictionary.get unboxed boxes) + (#.Some boxed) + (<unbox/box> unboxed boxed refined) + + #.None + refined) + post-processed (case post + #.Nil + unboxed/boxed + + _ + (` (.|> (~ unboxed/boxed) (~+ post))))] + post-processed))] + + [#1 auto-convert-input ..unbox + [[jvm.byte-descriptor jvm.byte-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-byte)) []] + [jvm.short-descriptor jvm.short-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-short)) []] + [jvm.int-descriptor jvm.int-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-int)) []] + [jvm.long-descriptor jvm.long-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long")))) []] + [jvm.float-descriptor jvm.float-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive "java.lang.Double"))) (` ..double-to-float)) []] + [jvm.double-descriptor jvm.double-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive "java.lang.Double")))) []]]] + [#0 auto-convert-output ..box + [[jvm.byte-descriptor jvm.long-descriptor (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] + [jvm.short-descriptor jvm.long-descriptor (list (` "jvm conversion short-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] + [jvm.int-descriptor jvm.long-descriptor (list (` "jvm conversion int-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] + [jvm.long-descriptor jvm.long-descriptor (list) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]] + [jvm.float-descriptor jvm.double-descriptor (list (` "jvm conversion float-to-double")) [(` (.: (.primitive "java.lang.Double"))) (` (.:coerce .Frac))]] + [jvm.double-descriptor jvm.double-descriptor (list) [(` (.: (.primitive "java.lang.Double"))) (` (.:coerce .Frac))]]]] ) (def: (un-quote quoted) (-> Code Code) (` ((~' ~) (~ quoted)))) -(def: (jvm-input [unboxed raw]) - (-> [Text Code] [Text Code]) - [unboxed (case unboxed - (^ (static jvm.byte-descriptor)) - (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw)))) - - (^ (static jvm.short-descriptor)) - (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw)))) - - (^ (static jvm.int-descriptor)) - (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw)))) - - (^ (static jvm.long-descriptor)) - (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw)))) - - (^ (static jvm.float-descriptor)) - (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw)))) - - (^ (static jvm.double-descriptor)) - (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw)))) - - _ - (` ("jvm object cast" (~ raw))))]) - (def: (jvm-invoke-inputs mode classes inputs) (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code)) (|> inputs @@ -1572,7 +1557,7 @@ (` ((~! !!!) (~ (un-quote input)))) (un-quote input)))) (list.zip2 classes) - (list@map (|>> jvm-input (auto-convert-input mode))))) + (list@map (auto-convert-input mode)))) (def: (with-class-type class expression) (-> Text Code Code) @@ -1695,7 +1680,6 @@ (` ((~ setter-name) (~ g!value))) (` ((~ setter-name) (~ g!value) (~ g!obj)))) setter-value (|> [(jvm.signature import-field-type) (un-quote g!value)] - ..jvm-input (auto-convert-input import-field-mode)) setter-value (if import-field-maybe? (` ((~! !!!) (~ setter-value))) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index d8851d978..6e3269df5 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -39,6 +39,19 @@ [char-reflection "char"] ) +(template [<name> <box>] + [(def: #export <name> <box>)] + + [boolean-box "java.lang.Boolean"] + [byte-box "java.lang.Byte"] + [short-box "java.lang.Short"] + [int-box "java.lang.Integer"] + [long-box "java.lang.Long"] + [float-box "java.lang.Float"] + [double-box "java.lang.Double"] + [char-box "java.lang.Character"] + ) + (def: #export array-prefix "[") (def: object-prefix "L") (def: var-prefix "T") diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux index 947bbc69f..358c666c7 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux @@ -60,14 +60,14 @@ [(def: #export <name> .Type (#.Primitive <class> #.Nil))] ## Boxes - [Boolean "java.lang.Boolean"] - [Byte "java.lang.Byte"] - [Short "java.lang.Short"] - [Integer "java.lang.Integer"] - [Long "java.lang.Long"] - [Float "java.lang.Float"] - [Double "java.lang.Double"] - [Character "java.lang.Character"] + [Boolean jvm.boolean-box] + [Byte jvm.byte-box] + [Short jvm.short-box] + [Integer jvm.int-box] + [Long jvm.long-box] + [Float jvm.float-box] + [Double jvm.double-box] + [Character jvm.char-box] [String "java.lang.String"] ## Primitives @@ -354,14 +354,14 @@ (def: #export boxes (Dictionary Text Text) - (|> (list [jvm.boolean-reflection "java.lang.Boolean"] - [jvm.byte-reflection "java.lang.Byte"] - [jvm.short-reflection "java.lang.Short"] - [jvm.int-reflection "java.lang.Integer"] - [jvm.long-reflection "java.lang.Long"] - [jvm.float-reflection "java.lang.Float"] - [jvm.double-reflection "java.lang.Double"] - [jvm.char-reflection "java.lang.Character"]) + (|> (list [jvm.boolean-reflection jvm.boolean-box] + [jvm.byte-reflection jvm.byte-box] + [jvm.short-reflection jvm.short-box] + [jvm.int-reflection jvm.int-box] + [jvm.long-reflection jvm.long-box] + [jvm.float-reflection jvm.float-box] + [jvm.double-reflection jvm.double-box] + [jvm.char-reflection jvm.char-box]) (dictionary.from-list text.hash))) (def: (array-type-info allow-primitives? arrayT) @@ -518,10 +518,10 @@ (check-jvm outputT) #.None - (/////analysis.throw non-object objectT)) + (/////analysis.throw ..non-object objectT)) _ - (/////analysis.throw non-object objectT))) + (/////analysis.throw ..non-object objectT))) (def: (check-object objectT) (-> .Type (Operation Text)) @@ -1032,17 +1032,18 @@ can-cast? (: (Operation Bit) (case [from-name to-name] (^template [<primitive> <object>] - (^or (^ [(static <primitive>) <object>]) - (^ [<object> (static <primitive>)])) + (^or (^ [(static <primitive>) (static <object>)]) + (^ [(static <object>) (static <primitive>)]) + (^ [(static <primitive>) (static <primitive>)])) (wrap #1)) - ([jvm.boolean-reflection "java.lang.Boolean"] - [jvm.byte-reflection "java.lang.Byte"] - [jvm.short-reflection "java.lang.Short"] - [jvm.int-reflection "java.lang.Integer"] - [jvm.long-reflection "java.lang.Long"] - [jvm.float-reflection "java.lang.Float"] - [jvm.double-reflection "java.lang.Double"] - [jvm.char-reflection "java.lang.Character"]) + ([jvm.boolean-reflection jvm.boolean-box] + [jvm.byte-reflection jvm.byte-box] + [jvm.short-reflection jvm.short-box] + [jvm.int-reflection jvm.int-box] + [jvm.long-reflection jvm.long-box] + [jvm.float-reflection jvm.float-box] + [jvm.double-reflection jvm.double-box] + [jvm.char-reflection jvm.char-box]) _ (do @ @@ -1188,7 +1189,7 @@ (dictionary.from-list text.hash)))) _ - (/////analysis.throw non-object objectT))) + (/////analysis.throw ..non-object objectT))) fieldT (java-type-to-lux-type mapping fieldJT)] (wrap [fieldT (Modifier::isFinal modifiers)])) (/////analysis.throw not-a-virtual-field [class-name field-name])))) |