From fb72b937aba7886ce204379e97aa06c327a4029f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 6 May 2018 23:27:12 -0400
Subject: - Implemented Nat functionality in pure Lux.

---
 .../translation/scheme/procedure/common.jvm.lux    | 37 +++------------------
 .../luxc/lang/translation/scheme/runtime.jvm.lux   | 38 ----------------------
 2 files changed, 4 insertions(+), 71 deletions(-)

(limited to 'new-luxc/source/luxc/lang/translation/scheme')

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
-- 
cgit v1.2.3