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/r/procedure/common.jvm.lux | 33 ----------- .../source/luxc/lang/translation/r/runtime.jvm.lux | 67 ---------------------- 2 files changed, 100 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/r') diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index 9554abc86..68b0bb67d 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -231,9 +231,6 @@ [int//min runtimeT.int//min] [int//max runtimeT.int//max] - - [deg//min runtimeT.int//zero] - [deg//max runtimeT.int//-one] ) (do-template [ ] @@ -256,14 +253,6 @@ [int//mul runtimeT.int//*] [int//div runtimeT.int///] [int//rem runtimeT.int//%] - - [deg//add runtimeT.int//+] - [deg//sub runtimeT.int//-] - [deg//rem runtimeT.int//-] - [deg//scale runtimeT.int//*] - [deg//mul runtimeT.deg//*] - [deg//div runtimeT.deg///] - [deg//reciprocal runtimeT.int///] ) (do-template [ ] @@ -290,9 +279,6 @@ [int//= runtimeT.int//=] [int//< runtimeT.int//<] - - [deg//= runtimeT.int//=] - [deg//< runtimeT.int//<] ) (def: (apply1 func) @@ -318,23 +304,6 @@ (install "to-frac" (unary runtimeT.int//to-float)) (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//=)) - (install "<" (binary deg//<)) - (install "scale" (binary deg//scale)) - (install "reciprocal" (binary deg//reciprocal)) - (install "min" (nullary deg//min)) - (install "max" (nullary deg//max)) - (install "to-frac" (unary runtimeT.deg//to-frac))))) - (def: (frac//encode value) (-> Expression Expression) (r.apply (list (r.string "%f") value) (r.global "sprintf"))) @@ -356,7 +325,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 runtimeT.deg//from-frac)) (install "to-int" (unary (apply1 (r.global "as.integer")))) (install "encode" (unary frac//encode)) (install "decode" (unary runtimeT.frac//decode))))) @@ -517,7 +485,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/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux index 70a9f62df..ced898662 100644 --- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux @@ -664,72 +664,6 @@ @@bit//logical-right-shift )) -(runtime: (deg//* param subject) - (with-vars [sL sH pL pH bottom middle top] - ($_ r.then - (r.set! sL (int//from-float (int64-low (@@ subject)))) - (r.set! sH (int//from-float (int64-high (@@ subject)))) - (r.set! pL (int//from-float (int64-low (@@ param)))) - (r.set! pH (int//from-float (int64-high (@@ param)))) - (let [bottom (bit//logical-right-shift (r.int 32) - (int//* (@@ pL) (@@ sL))) - middle (int//+ (int//* (@@ pL) (@@ sH)) - (int//* (@@ pH) (@@ sL))) - top (int//* (@@ pH) (@@ sH))] - (|> bottom - (int//+ middle) - (bit//logical-right-shift (r.int 32)) - (int//+ top)))))) - -(runtime: (deg//leading-zeroes input) - (with-vars [zeroes remaining] - ($_ r.then - (r.set! zeroes (r.int 64)) - (r.set! remaining (@@ input)) - (r.while (|> (@@ remaining) (int//= int//zero) r.not) - ($_ r.then - (r.set! zeroes (|> (@@ zeroes) (r.- (r.int 1)))) - (r.set! remaining (|> (@@ remaining) (bit//logical-right-shift (r.int 1)))))) - (@@ zeroes)))) - -(runtime: (deg/// param subject) - (with-vars [min-shift] - (r.if (|> (@@ subject) (int//= (@@ param))) - int//-one - ($_ r.then - (r.set! min-shift - (r.apply (list (deg//leading-zeroes (@@ param)) - (deg//leading-zeroes (@@ subject))) - (r.global "min"))) - (let [subject' (|> (@@ subject) (bit//left-shift (@@ min-shift))) - param' (|> (@@ param) (bit//left-shift (@@ min-shift)) int64-high int//from-float)] - (|> subject' - (int/// param') - (bit//left-shift (r.int 32)))))))) - -(runtime: (deg//from-frac input) - (with-vars [two32 shifted] - ($_ r.then - (r.set! two32 (|> (r.float 2.0) (r.** (r.float 32.0)))) - (r.set! shifted (|> (@@ input) (r.%% (r.float 1.0)) (r.* (@@ two32)))) - (let [low (|> (@@ shifted) (r.%% (r.float 1.0)) (r.* (@@ two32)) as-integer) - high (|> (@@ shifted) as-integer)] - (int//new high low))))) - -(runtime: (deg//to-frac input) - (let [high (|> (int64-high (@@ input)) (r./ f2^32)) - low (|> (int64-low (@@ input)) (r./ f2^32) (r./ f2^32))] - (|> low (r.+ high)))) - -(def: runtime//deg - Runtime - ($_ r.then - @@deg//* - @@deg//leading-zeroes - @@deg/// - @@deg//from-frac - @@deg//to-frac)) - (runtime: (frac//decode input) (with-vars [output] ($_ r.then @@ -958,7 +892,6 @@ runtime//bit runtime//int runtime//adt - runtime//deg runtime//frac runtime//text runtime//array -- cgit v1.2.3