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 +++++++++++++++++++++++++++++++++---
 stdlib/test/test/lux/data/number.lux | 10 +++++----
 2 files changed, 45 insertions(+), 7 deletions(-)

(limited to 'stdlib')

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>]
diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux
index 8e959cf6f..eb09eec09 100644
--- a/stdlib/test/test/lux/data/number.lux
+++ b/stdlib/test/test/lux/data/number.lux
@@ -124,15 +124,17 @@
 
   ["Nat/Binary" R;nat  Eq<Nat>  Binary@Codec<Text,Nat>]
   ["Nat/Octal"  R;nat  Eq<Nat>  Octal@Codec<Text,Nat>]
-  ["Nat"  R;nat  Eq<Nat>  Codec<Text,Nat>]
+  ["Nat"        R;nat  Eq<Nat>  Codec<Text,Nat>]
   ["Nat/Hex"    R;nat  Eq<Nat>  Hex@Codec<Text,Nat>]
 
   ["Int/Binary" R;int  Eq<Int>  Binary@Codec<Text,Int>]
   ["Int/Octal"  R;int  Eq<Int>  Octal@Codec<Text,Int>]
-  ["Int"  R;int  Eq<Int>  Codec<Text,Int>]
+  ["Int"        R;int  Eq<Int>  Codec<Text,Int>]
   ["Int/Hex"    R;int  Eq<Int>  Hex@Codec<Text,Int>]
 
-  ["Deg"  R;deg  Eq<Deg>  Codec<Text,Deg>]
+  ["Deg/Binary" R;deg  Eq<Deg>  Binary@Codec<Text,Deg>]
+  ["Deg"        R;deg  Eq<Deg>  Codec<Text,Deg>]
+  ["Deg/Hex"    R;deg  Eq<Deg>  Hex@Codec<Text,Deg>]
 
-  ["Real" R;real Eq<Real> Codec<Text,Real>]
+  ["Real"       R;real Eq<Real> Codec<Text,Real>]
   )
-- 
cgit v1.2.3