aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux44
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux89
2 files changed, 5 insertions, 128 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 3a5cc9b70..05a38eb2f 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -267,18 +267,11 @@
(def: deg-method $.Method nat-method)
-(def: compare-nat-method
- $.Method
- ($t.method (list $t.long $t.long) (#.Some $t.int) (list)))
-
(do-template [<name> <const> <type>]
[(def: (<name> _)
Nullary
(|>> <const> ($i.wrap <type>)))]
- [nat//min ($i.long 0) #$.Long]
- [nat//max ($i.long -1) #$.Long]
-
[int//min ($i.long Long::MIN_VALUE) #$.Long]
[int//max ($i.long Long::MAX_VALUE) #$.Long]
@@ -307,12 +300,6 @@
[int//div #$.Long $i.LDIV]
[int//rem #$.Long $i.LREM]
- [nat//add #$.Long $i.LADD]
- [nat//sub #$.Long $i.LSUB]
- [nat//mul #$.Long $i.LMUL]
- [nat//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_nat" nat-method false)]
- [nat//rem #$.Long ($i.INVOKESTATIC hostL.runtime-class "rem_nat" nat-method false)]
-
[frac//add #$.Double $i.DADD]
[frac//sub #$.Double $i.DSUB]
[frac//mul #$.Double $i.DMUL]
@@ -340,10 +327,9 @@
[<eq> 0]
[<lt> -1])]
- [nat//eq nat//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
[int//eq int//lt ($i.unwrap #$.Long) $i.LCMP]
[frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG]
- [deg//eq deg//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
+ [deg//eq deg//lt ($i.unwrap #$.Long) $i.LCMP]
)
(do-template [<name> <prepare> <transform>]
@@ -351,12 +337,9 @@
Unary
(|>> inputI <prepare> <transform>))]
- [nat//to-int id id]
- [nat//char ($i.unwrap #$.Long)
- ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))]
-
- [int//to-nat id id]
[int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)]
+ [int//char ($i.unwrap #$.Long)
+ ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))]
[frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)]
[frac//to-deg ($i.unwrap #$.Double)
@@ -623,22 +606,6 @@
(install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
)))
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//eq))
- (install "<" (binary nat//lt))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary nat//to-int))
- (install "char" (unary nat//char)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -652,8 +619,8 @@
(install "<" (binary int//lt))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary int//to-nat))
- (install "to-frac" (unary int//to-frac)))))
+ (install "to-frac" (unary int//to-frac))
+ (install "char" (unary int//char)))))
(def: deg-procs
Bundle
@@ -782,7 +749,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index b394a7f53..58ed736ab 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -167,94 +167,6 @@
$.Inst
($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) false))
-(def: nat-methods
- $.Def
- (let [compare-nat-method ($t.method (list $t.long $t.long) (#.Some $t.int) (list))
- less-thanI (function (_ @where) (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where)))
- $BigInteger ($t.class "java.math.BigInteger" (list))
- upcast-method ($t.method (list $t.long) (#.Some $BigInteger) (list))
- div-method ($t.method (list $t.long $t.long) (#.Some $t.long) (list))
- upcastI ($i.INVOKESTATIC hostL.runtime-class "_toUnsignedBigInteger" upcast-method false)
- downcastI ($i.INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t.method (list) (#.Some $t.long) (list)) false)]
- (|>> ($d.method #$.Public $.staticM "_toUnsignedBigInteger" upcast-method
- (let [upcastI ($i.INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false)
- discernI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where)))
- prepare-upperI (|>> ($i.LLOAD +0) ($i.int 32) $i.LUSHR
- upcastI
- ($i.int 32) ($i.INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t.method (list $t.int) (#.Some $BigInteger) (list)) false))
- prepare-lowerI (|>> ($i.LLOAD +0) ($i.int 32) $i.LSHL
- ($i.int 32) $i.LUSHR
- upcastI)]
- (<| $i.with-label (function (_ @simple))
- (|>> (discernI @simple)
- ## else
- prepare-upperI
- prepare-lowerI
- ($i.INVOKEVIRTUAL "java.math.BigInteger" "add" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)
- $i.ARETURN
- ## then
- ($i.label @simple)
- ($i.LLOAD +0)
- upcastI
- $i.ARETURN))))
- ($d.method #$.Public $.staticM "compare_nat" compare-nat-method
- (let [shiftI (|>> ($i.GETSTATIC "java.lang.Long" "MIN_VALUE" $t.long) $i.LADD)]
- (|>> ($i.LLOAD +0) shiftI
- ($i.LLOAD +2) shiftI
- $i.LCMP
- $i.IRETURN)))
- ($d.method #$.Public $.staticM "div_nat" div-method
- (let [is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where)))
- is-subject-smallI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where)))
- small-division (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LDIV $i.LRETURN)
- big-divisionI ($i.INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)]
- (<| $i.with-label (function (_ @is-zero))
- $i.with-label (function (_ @param-is-large))
- $i.with-label (function (_ @subject-is-small))
- (|>> (is-param-largeI @param-is-large)
- ## Param is not too large
- (is-subject-smallI @subject-is-small)
- ## Param is small, but subject is large
- ($i.LLOAD +0) upcastI
- ($i.LLOAD +2) upcastI
- big-divisionI downcastI $i.LRETURN
- ## Both param and subject are small,
- ## and can thus be divided normally.
- ($i.label @subject-is-small)
- small-division
- ## Param is too large. Cannot simply divide.
- ## Depending on the result of the
- ## comparison, a result will be determined.
- ($i.label @param-is-large)
- ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @is-zero)
- ## Greater-than or equals
- ($i.long 1) $i.LRETURN
- ## Less than
- ($i.label @is-zero)
- ($i.long 0) $i.LRETURN))))
- ($d.method #$.Public $.staticM "rem_nat" div-method
- (let [is-subject-largeI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where)))
- is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where)))
- small-remainderI (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LREM $i.LRETURN)
- big-remainderI ($i.INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)]
- (<| $i.with-label (function (_ @large-number))
- $i.with-label (function (_ @subject-is-smaller-than-param))
- (|>> (is-subject-largeI @large-number)
- (is-param-largeI @large-number)
- small-remainderI
-
- ($i.label @large-number)
- ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @subject-is-smaller-than-param)
-
- ($i.LLOAD +0) upcastI
- ($i.LLOAD +2) upcastI
- big-remainderI downcastI $i.LRETURN
-
- ($i.label @subject-is-smaller-than-param)
- ($i.LLOAD +0)
- $i.LRETURN))))
- )))
-
(def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0)))
(def: frac-methods
@@ -620,7 +532,6 @@
[_ (wrap [])
#let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list)
(|>> adt-methods
- nat-methods
frac-methods
deg-methods
text-methods
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-02 11:50:52 +0000