aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/scheme
diff options
context:
space:
mode:
authorEduardo Julian2018-05-06 23:27:12 -0400
committerEduardo Julian2018-05-06 23:27:12 -0400
commitfb72b937aba7886ce204379e97aa06c327a4029f (patch)
tree20bc243f1605c5b6c37b833b8046b82eac805494 /new-luxc/source/luxc/lang/translation/scheme
parent0b53bcc87ad3563daedaa64306d0bbe6df01ca49 (diff)
- Implemented Nat functionality in pure Lux.
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/scheme')
-rw-r--r--new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux37
-rw-r--r--new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux38
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