From febfa99c2823219c2e76d2c73b1fd8db8f6c9918 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 May 2018 01:37:38 -0400 Subject: - Implemented Deg functionality in pure Lux. --- .../lang/translation/jvm/procedure/common.jvm.lux | 40 --------- .../luxc/lang/translation/jvm/runtime.jvm.lux | 98 ---------------------- 2 files changed, 138 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/jvm') 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 05a38eb2f..59b7c8b4b 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 @@ -265,8 +265,6 @@ $.Method ($t.method (list $t.long $t.long) (#.Some $t.long) (list))) -(def: deg-method $.Method nat-method) - (do-template [ ] [(def: ( _) Nullary @@ -281,9 +279,6 @@ [frac//not-a-number ($i.double Double::NaN) #$.Double] [frac//positive-infinity ($i.double Double::POSITIVE_INFINITY) #$.Double] [frac//negative-infinity ($i.double Double::NEGATIVE_INFINITY) #$.Double] - - [deg//min ($i.long 0) #$.Long] - [deg//max ($i.long -1) #$.Long] ) (do-template [ ] @@ -305,14 +300,6 @@ [frac//mul #$.Double $i.DMUL] [frac//div #$.Double $i.DDIV] [frac//rem #$.Double $i.DREM] - - [deg//add #$.Long $i.LADD] - [deg//sub #$.Long $i.LSUB] - [deg//mul #$.Long ($i.INVOKESTATIC hostL.runtime-class "mul_deg" deg-method false)] - [deg//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_deg" deg-method false)] - [deg//rem #$.Long $i.LSUB] - [deg//scale #$.Long $i.LMUL] - [deg//reciprocal #$.Long $i.LDIV] ) (do-template [ ] @@ -329,7 +316,6 @@ [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.LCMP] ) (do-template [ ] @@ -342,17 +328,10 @@ ((|>> $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) - (<| ($i.wrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "frac_to_deg" - ($t.method (list $t.double) (#.Some $t.long) (list)) false))] [frac//encode ($i.unwrap #$.Double) ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) false)] [frac//decode ($i.CHECKCAST "java.lang.String") ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) false)] - - [deg//to-frac ($i.unwrap #$.Long) - (<| ($i.wrap #$.Double) ($i.INVOKESTATIC hostL.runtime-class "deg_to_frac" - ($t.method (list $t.long) (#.Some $t.double) (list)) false))] ) ## [[Text]] @@ -622,23 +601,6 @@ (install "to-frac" (unary int//to-frac)) (install "char" (unary int//char))))) -(def: deg-procs - Bundle - (<| (prefix "deg") - (|> (dict.new text.Hash) - (install "+" (binary deg//add)) - (install "-" (binary deg//sub)) - (install "*" (binary deg//mul)) - (install "/" (binary deg//div)) - (install "%" (binary deg//rem)) - (install "=" (binary deg//eq)) - (install "<" (binary deg//lt)) - (install "scale" (binary deg//scale)) - (install "reciprocal" (binary deg//reciprocal)) - (install "min" (nullary deg//min)) - (install "max" (nullary deg//max)) - (install "to-frac" (unary deg//to-frac))))) - (def: frac-procs Bundle (<| (prefix "frac") @@ -656,7 +618,6 @@ (install "not-a-number" (nullary frac//not-a-number)) (install "positive-infinity" (nullary frac//positive-infinity)) (install "negative-infinity" (nullary frac//negative-infinity)) - (install "to-deg" (unary frac//to-deg)) (install "to-int" (unary frac//to-int)) (install "encode" (unary frac//encode)) (install "decode" (unary frac//decode))))) @@ -750,7 +711,6 @@ (|> lux-procs (dict.merge bit-procs) (dict.merge int-procs) - (dict.merge deg-procs) (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-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 58ed736ab..300c0c353 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -176,107 +176,10 @@ (|>> ($i.ALOAD +0) ($i.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) false) ($i.wrap #$.Double)))) - ($d.method #$.Public $.staticM "frac_to_deg" ($t.method (list $t.double) (#.Some $t.long) (list)) - (let [swap2 (|>> $i.DUP2_X2 $i.POP2) - drop-excessI (|>> ($i.double 1.0) $i.DREM) - shiftI (|>> frac-shiftI $i.DMUL)] - (|>> ($i.DLOAD +0) - ## Get upper half - drop-excessI - shiftI - ## Make a copy, so the lower half can be extracted - $i.DUP2 - ## Get lower half - drop-excessI - shiftI - ## Turn it into a deg - $i.D2L - ## Turn the upper half into deg too - swap2 - $i.D2L - ## Combine both pieces - $i.LADD - ## FINISH - $i.LRETURN - ))) )) -(def: deg-bits Nat +64) -(def: deg-method $.Method ($t.method (list $t.long $t.long) (#.Some $t.long) (list))) (def: clz-method $.Method ($t.method (list $t.long) (#.Some $t.int) (list))) -(def: deg-methods - $.Def - (let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits. - low-half (|>> ($i.int -1) $i.I2L $i.LAND) - high-half (|>> ($i.int 32) $i.LUSHR)] - (|>> ($d.method #$.Public $.staticM "mul_deg" deg-method - ## Based on: http://stackoverflow.com/a/31629280/6823464 - (let [shift-downI (|>> ($i.int 32) $i.LUSHR) - low-leftI (|>> ($i.LLOAD +0) low-half) - high-leftI (|>> ($i.LLOAD +0) high-half) - low-rightI (|>> ($i.LLOAD +2) low-half) - high-rightI (|>> ($i.LLOAD +2) high-half) - bottomI (|>> low-leftI low-rightI $i.LMUL) - middleLI (|>> high-leftI low-rightI $i.LMUL) - middleRI (|>> low-leftI high-rightI $i.LMUL) - middleI (|>> middleLI middleRI $i.LADD) - topI (|>> high-leftI high-rightI $i.LMUL)] - (|>> bottomI shift-downI - middleI $i.LADD shift-downI - topI $i.LADD - $i.LRETURN))) - ($d.method #$.Public $.staticM "count_leading_zeros" clz-method - (let [when-zeroI (function (_ @where) (|>> ($i.long 0) $i.LCMP ($i.IFEQ @where))) - shift-rightI (function (_ amount) (|>> ($i.int amount) $i.LUSHR)) - decI (|>> ($i.int 1) $i.ISUB)] - (<| $i.with-label (function (_ @start)) - $i.with-label (function (_ @done)) - (|>> ($i.int 64) - ($i.label @start) - ($i.LLOAD +0) (when-zeroI @done) - ($i.LLOAD +0) (shift-rightI 1) ($i.LSTORE +0) - decI - ($i.GOTO @start) - ($i.label @done) - $i.IRETURN)))) - ($d.method #$.Public $.staticM "div_deg" deg-method - (<| $i.with-label (function (_ @same)) - (let [subjectI ($i.LLOAD +0) - paramI ($i.LLOAD +2) - equal?I (function (_ @where) (|>> $i.LCMP ($i.IFEQ @where))) - count-leading-zerosI ($i.INVOKESTATIC hostL.runtime-class "count_leading_zeros" clz-method false) - calc-max-shiftI (|>> subjectI count-leading-zerosI - paramI count-leading-zerosI - ($i.INVOKESTATIC "java.lang.Math" "min" ($t.method (list $t.int $t.int) (#.Some $t.int) (list)) false) - ($i.ISTORE +4)) - shiftI (|>> ($i.ILOAD +4) $i.LSHL) - imprecise-divisionI (|>> subjectI shiftI - paramI shiftI high-half - $i.LDIV) - scale-downI (|>> ($i.int 32) $i.LSHL)] - (|>> subjectI paramI - (equal?I @same) - ## Based on: http://stackoverflow.com/a/8510587/6823464 - ## Shifting the operands as much as possible can help - ## avoid some loss of precision later. - calc-max-shiftI - imprecise-divisionI - scale-downI - $i.LRETURN - ($i.label @same) - ($i.long -1) ## ~= 1.0 Degrees - $i.LRETURN)))) - ($d.method #$.Public $.staticM "deg_to_frac" ($t.method (list $t.long) (#.Some $t.double) (list)) - (let [highI (|>> ($i.LLOAD +0) high-half $i.L2D) - lowI (|>> ($i.LLOAD +0) low-half $i.L2D) - scaleI (|>> frac-shiftI $i.DDIV)] - (|>> highI scaleI - lowI scaleI scaleI - $i.DADD - $i.DRETURN))) - ))) - (def: text-methods $.Def (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) @@ -533,7 +436,6 @@ #let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list) (|>> adt-methods frac-methods - deg-methods text-methods pm-methods io-methods -- cgit v1.2.3