From ae7c062bdf4ab8337f0eedae78b38df24e62822c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 30 Mar 2017 23:09:25 -0400
Subject: - Nat encoding/decoding is now implemented in the standard library.

---
 stdlib/source/lux.lux             | 29 ++++++++++++++++++---
 stdlib/source/lux/data/number.lux | 55 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 79 insertions(+), 5 deletions(-)

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index fc606bc36..964cf5b57 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1544,8 +1544,7 @@
   #Nil
   ($' Monad Maybe)
   {#wrap
-   (lambda' return [x]
-            (#Some x))
+   (lambda' [x] (#Some x))
    
    #bind
    (lambda' [f ma]
@@ -2070,10 +2069,32 @@
   (-> Bool Text)
   (if x "true" "false"))
 
-(def:''' (Nat/encode x)
+(def:''' (digit-to-text digit)
   #Nil
   (-> Nat Text)
-  (_lux_proc ["nat" "encode"] [x]))
+  (_lux_case digit
+    +0 "0"
+    +1 "1" +2 "2" +3 "3"
+    +4 "4" +5 "5" +6 "6"
+    +7 "7" +8 "8" +9 "9"
+    _ (_lux_proc ["io" "error"] ["undefined"])))
+
+(def:''' (Nat/encode value)
+  #Nil
+  (-> Nat Text)
+  (_lux_case value
+    +0
+    "+0"
+
+    _
+    (let' [loop (_lux_: (-> Nat Text Text)
+                  (lambda' recur [input output]
+                           (if (_lux_proc ["nat" "="] [input +0])
+                             (_lux_proc ["text" "append"] ["+" output])
+                             (recur (_lux_proc ["nat" "/"] [input +10])
+                                    (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10]))
+                                                                  output])))))]
+          (loop value ""))))
 
 (def:''' (Int/encode x)
   #Nil
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index c90abf76d..9b828ec25 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -144,12 +144,65 @@
          #;None
          (#;Left <error>))))]
 
-  [ Nat [ "nat" "encode"] [ "nat" "decode"] "Couldn't decode Nat"]
   [ Int [ "int" "encode"] [ "int" "decode"] "Couldn't decode Int"]
   [ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"]
   [Real ["real" "encode"] ["real" "decode"] "Couldn't decode Real"]
   )
 
+(def: (digit-to-text digit)
+  (-> Nat Text)
+  (case digit
+    +0 "0"
+    +1 "1" +2 "2" +3 "3"
+    +4 "4" +5 "5" +6 "6"
+    +7 "7" +8 "8" +9 "9"
+    _ (undefined)))
+
+(def: (text-to-digit digit)
+  (-> Text (Maybe Nat))
+  (case digit
+    "0" (#;Some +0)
+    "1" (#;Some +1) "2" (#;Some +2) "3" (#;Some +3)
+    "4" (#;Some +4) "5" (#;Some +5) "6" (#;Some +6)
+    "7" (#;Some +7) "8" (#;Some +8) "9" (#;Some +9)
+    _ #;None))
+
+(struct: #export _ (Codec Text Nat)
+  (def: (encode value)
+    (case value
+      +0
+      "+0"
+
+      _
+      (loop [input value
+             output ""]
+        (if (n.= +0 input)
+          (_lux_proc ["text" "append"] ["+" output])
+          (recur (n./ +10 input)
+                 (_lux_proc ["text" "append"] [(digit-to-text (n.% +10 input)) output]))))))
+
+  (def: (decode repr)
+    (let [input-size (_lux_proc ["text" "size"] [repr])]
+      (if (n.>= +2 input-size)
+        (case (_lux_proc ["text" "char"] [repr +0])
+          (#;Some #"+")
+          (loop [idx +1
+                 output +0]
+            (if (n.< input-size idx)
+              (case (_lux_proc ["text" "char"] [repr idx])
+                (^=> (#;Some sample)
+                     [(text-to-digit (_lux_proc ["char" "to-text"] [sample])) (#;Some digit)])
+                (recur (n.inc idx)
+                       (|> output (n.* +10) (n.+ digit)))
+
+                _
+                (undefined))
+              (#;Right output)))
+
+          _
+          (#;Left "Invalid binary syntax."))
+        (#;Left "Invalid binary syntax.")))))
+
 (struct: #export _ (Hash Nat)
   (def: eq Eq<Nat>)
   (def: hash id))
-- 
cgit v1.2.3