From 277747aee1b0b19e88a0e685299f278201737011 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 17 Feb 2017 18:24:45 -0400
Subject: - Added more common procedures. - Fixed some bugs in the
 type-checking of some common procedures. - Removed the "_name" field for
 generated classes. - Now compiling loops in JS. - Did some refactoring to the
 caching machinery. - Implemented binary, octal and hexadecimal encoding
 purely in Lux.

---
 stdlib/source/lux/data/number.lux | 42 +++++++++++++++++++++++++++++++--------
 1 file changed, 34 insertions(+), 8 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index ce0d5f887..cad152f2b 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -178,15 +178,38 @@
   (not (r.= number number)))
 
 ## [Values & Syntax]
-(do-template [<struct> <to-proc> <radix> <macro> <error> <doc>]
+(do-template [<struct> <base> <macro> <error> <char-set> <doc>]
   [(struct: #export <struct> (Codec Text Nat)
      (def: (encode value)
-       (_lux_proc ["jvm" <to-proc>] [(nat-to-int value)]))
+       (loop [input value
+              output ""]
+         (let [digit (assume (_lux_proc ["text" "char"] [<char-set> (n.% <base> input)]))
+               output' (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit])
+                                                     output])
+               input' (n./ <base> input)]
+           (if (n.= +0 input')
+             output'
+             (recur input' output')))))
 
      (def: (decode repr)
-       (_lux_proc ["jvm" "try"]
-                  [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:parseUnsignedLong:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])])))
-                   (lambda [ex] (#;Left <error>))])))
+       (let [input-size (_lux_proc ["text" "size"] [repr])]
+         (if (n.= +0 input-size)
+           (#;Left "Empty input.")
+           (let [input (_lux_proc ["text" "upper-case"] [repr])]
+             (loop [idx +0
+                    output +0]
+               (if (n.< input-size idx)
+                 (let [digit (assume (_lux_proc ["text" "char"] [input idx]))]
+                   (case (_lux_proc ["text" "index"]
+                                    [input
+                                     (_lux_proc ["char" "to-text"] [digit])])
+                     #;None
+                     (#;Left <error>)
+
+                     (#;Some index)
+                     (recur (n.inc idx)
+                            (|> output (n.* <base>) (n.* index)))))
+                 (#;Right output))))))))
 
    (macro: #export (<macro> tokens state)
      {#;doc <doc>}
@@ -202,13 +225,16 @@
        _
        (#;Left <error>)))]
 
-  [Binary@Codec<Text,Nat> "invokestatic:java.lang.Long:toBinaryString:long" 2  bin "Invalid binary syntax."
+  [Binary@Codec<Text,Nat> +2  bin "Invalid binary syntax."
+   "01"
    (doc "Given syntax for a binary number, generates a Nat."
         (bin "11001001"))]
-  [Octal@Codec<Text,Nat>  "invokestatic:java.lang.Long:toOctalString:long"  8  oct "Invalid octal syntax."
+  [Octal@Codec<Text,Nat>  +8  oct "Invalid octal syntax."
+   "01234567"
    (doc "Given syntax for an octal number, generates a Nat."
         (oct "615243"))]
-  [Hex@Codec<Text,Nat>    "invokestatic:java.lang.Long:toHexString:long"    16 hex "Invalid hexadecimal syntax."
+  [Hex@Codec<Text,Nat>    +16 hex "Invalid hexadecimal syntax."
+   "0123456789ABCDEF"
    (doc "Given syntax for a hexadecimal number, generates a Nat."
         (hex "deadBEEF"))]
   )
-- 
cgit v1.2.3