diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux | 37 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux | 38 |
2 files changed, 4 insertions, 71 deletions
diff --git a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux index cd828e082..67ec0e95c 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux @@ -235,9 +235,6 @@ Nullary (_.int <expression>))] - [nat//min 0] - [nat//max -1] - [int//min ("lux int min")] [int//max ("lux int max")] @@ -266,12 +263,6 @@ [int//div _.quotient] [int//rem _.remainder] - [nat//add _.+] - [nat//sub _.-] - [nat//mul _.*] - [nat//div runtimeT.nat///] - [nat//rem runtimeT.nat//%] - [deg//add _.+] [deg//sub _.-] [deg//rem _.-] @@ -303,14 +294,11 @@ Binary (<cmp> paramO subjectO))] - [nat//= _.=] - [nat//< runtimeT.nat//<] - [int//= _.=] [int//< _.<] [deg//= _.=] - [deg//< runtimeT.nat//<] + [deg//< _.<] ) (def: deg//to-frac @@ -321,25 +309,9 @@ (_./ f2^32) (_./ (_.float 1.0))))) -(def: nat//char (|>> (_.apply1 (_.global "integer->char")) +(def: int//char (|>> (_.apply1 (_.global "integer->char")) (_.apply1 (_.global "string")))) -(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//=)) - (install "<" (binary nat//<)) - (install "min" (nullary nat//min)) - (install "max" (nullary nat//max)) - (install "to-int" (unary id)) - (install "char" (unary nat//char))))) - (def: int-procs Bundle (<| (prefix "int") @@ -353,8 +325,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary id)) - (install "to-frac" (unary (|>> (_./ (_.float 1.0)))))))) + (install "to-frac" (unary (|>> (_./ (_.float 1.0))))) + (install "char" (unary int//char))))) (def: deg-procs Bundle @@ -519,7 +491,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/scheme/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux index 09259c2b9..e8016eb0a 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux @@ -239,43 +239,6 @@ (def: int-high (bit//logical-right-shift (_.int 32))) (def: int-low (_.bit-and (_.int (hex "FFFFFFFF")))) -(runtime: (nat//< param subject) - (with-vars [pH sH] - (_.let (list [pH (int-high (@@ param))] - [sH (int-high (@@ subject))]) - (_.or (list (_.< (@@ pH) (@@ sH)) - (_.and (list (_.= (@@ pH) (@@ sH)) - (_.< (int-low (@@ param)) (int-low (@@ subject)))))))))) - -(runtime: (nat/// param subject) - (_.if (_.< (_.int 0) (@@ param)) - (_.if (nat//< (@@ param) (@@ subject)) - (_.int 0) - (_.int 1)) - (with-vars [quotient] - (_.let (list [quotient (|> (@@ subject) - (bit//logical-right-shift (_.int 1)) - (_.quotient (@@ param)) - (_.arithmetic-shift (_.int 1)))]) - (let [remainder (_.- (_.* (@@ param) (@@ quotient)) - (@@ subject))] - (_.if (_.not (nat//< (@@ param) remainder)) - (_.+ (_.int 1) (@@ quotient)) - (@@ quotient))))))) - -(runtime: (nat//% param subject) - (let [flat (|> (@@ subject) - (nat/// (@@ param)) - (_.* (@@ param)))] - (|> (@@ subject) (_.- flat)))) - -(def: runtime//nat - Runtime - (_.begin - (list @@nat//< - @@nat/// - @@nat//%))) - (runtime: (frac//to-deg input) (with-vars [two32 shifted] (_.let* (list [two32 (|> (_.float 2.0) (_.expt (_.float 32.0)))] @@ -405,7 +368,6 @@ runtime//lux runtime//bit runtime//adt - runtime//nat runtime//frac ## runtime//text runtime//array |