From 960d0a7945920d6183e8f41557e07f41b4cc6e07 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 5 Apr 2017 19:23:44 -0400
Subject: - Added binary and hexadecimal syntax for degs.

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

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index a854e8bf7..7077ce70c 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -273,10 +273,46 @@
                  (#;Right (i.* sign output)))))
            (#;Left <error>)))))]
 
-  [Binary@Codec<Text,Int> 2  "01"               "Invalid binary syntax."]
-  [Octal@Codec<Text,Int>  8  "01234567"         "Invalid octal syntax."]
+  [Binary@Codec<Text,Int> 2  "01"               "Invalid binary syntax: "]
+  [Octal@Codec<Text,Int>  8  "01234567"         "Invalid octal syntax: "]
   [_                      10 "0123456789"       "Invalid syntax for Int: "]
-  [Hex@Codec<Text,Int>    16 "0123456789ABCDEF" "Invalid hexadecimal syntax."]
+  [Hex@Codec<Text,Int>    16 "0123456789ABCDEF" "Invalid hexadecimal syntax: "]
+  )
+
+(def: (de-prefix input)
+  (-> Text Text)
+  (assume (_lux_proc ["text" "clip"] [input +1 (_lux_proc ["text" "size"] [input])])))
+
+(do-template [<struct> <nat> <char-bit-size> <error>]
+  [(struct: #export <struct> (Codec Text Deg)
+     (def: (encode value)
+       (let [raw-output (de-prefix (:: <nat> encode (:! Nat value)))
+             max-num-chars (n./ <char-bit-size> +64)
+             raw-size (_lux_proc ["text" "size"] [raw-output])
+             zero-padding (loop [zeroes-left (n.- raw-size max-num-chars)
+                                 output ""]
+                            (if (n.= +0 zeroes-left)
+                              output
+                              (recur (n.dec zeroes-left)
+                                     (_lux_proc ["text" "append"] ["0" output]))))
+             padded-output (_lux_proc ["text" "append"] [zero-padding raw-output])]
+         (_lux_proc ["text" "append"] ["." padded-output])))
+
+     (def: (decode repr)
+       (let [repr-size (_lux_proc ["text" "size"] [repr])]
+         (if (n.>= +2 repr-size)
+           (case (_lux_proc ["text" "char"] [repr +0])
+             (^=> (#;Some #".")
+                  [(:: <nat> decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)]))
+                   (#;Some output)])
+             (#;Some (:! Deg output))
+
+             _
+             (#;Left (_lux_proc ["text" "append"] [<error> repr])))
+           (#;Left (_lux_proc ["text" "append"] [<error> repr]))))))]
+
+  [Binary@Codec<Text,Deg> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "]
+  [Hex@Codec<Text,Deg>    Hex@Codec<Text,Nat>    +4 "Invalid hexadecimal syntax: "]
   )
 
 (do-template [<macro> <nat> <int> <error> <doc>]
-- 
cgit v1.2.3