- Added binary, octal and hexadecimal codecs for ints.

- Generalized the bin, oct and hex macros so they also work with ints (in the future, they will also work with degs and reals).
- Binary, octal and hexadecimal nats now have a + sign in front, like normal nats.

1 files changed, 110 insertions, 132 deletions

diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 62c7abd6b..a854e8bf7 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -131,6 +131,22 @@
   [ Min@Monoid<Deg>  Deg (:: Interval<Deg> top)     d.min]
   )
 
+(do-template [<name> <const> <doc>]
+  [(def: #export <name>
+     {#;doc <doc>}
+     Real
+     (_lux_proc ["real" <const>] []))]
+
+  [not-a-number      "not-a-number"      "Not-a-number."]
+  [positive-infinity "positive-infinity" "Positive infinity."]
+  [negative-infinity "negative-infinity" "Negative infinity."]
+  )
+
+(def: #export (not-a-number? number)
+  {#;doc "Tests whether a real is actually not-a-number."}
+  (-> Real Bool)
+  (not (r.= number number)))
+
 (do-template [<type> <encoder> <decoder> <error>]
   [(struct: #export _ (Codec Text <type>)
      (def: (encode x)
@@ -144,103 +160,10 @@
          #;None
          (#;Left <error>))))]
 
-  [ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"]
   [Real ["real" "encode"] ["real" "decode"] "Couldn't decode Real"]
+  [ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"]
   )
 
-(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 Int)
-  (def: (encode value)
-    (if (i.= 0 value)
-      "0"
-      (let [sign (if (i.> 0 value)
-                   ""
-                   "-")]
-        (loop [input (|> value (i./ 10) (:: Number<Int> abs))
-               output (|> value (i.% 10) (:: Number<Int> abs) int-to-nat digit-to-text)]
-          (if (i.= 0 input)
-            (_lux_proc ["text" "append"] [sign output])
-            (recur (i./ 10 input)
-                   (_lux_proc ["text" "append"] [(|> input (i.% 10) int-to-nat digit-to-text)
-                                                 output])))))
-      ))
-
-  (def: (decode repr)
-    (let [input-size (_lux_proc ["text" "size"] [repr])]
-      (if (n.>= +1 input-size)
-        (let [sign (case (_lux_proc ["text" "char"] [repr +0])
-                     (#;Some #"-")
-                     -1
-
-                     _
-                     1)]
-          (loop [idx (if (i.= -1 sign) +1 +0)
-                 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 (i.* 10) (i.+ (nat-to-int digit))))
-
-                _
-                (undefined))
-              (#;Right (i.* sign output)))))
-        (#;Left "Invalid syntax for Int.")))))
-
-(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 syntax for Nat."))
-        (#;Left "Invalid syntax for Nat.")))))
-
 (struct: #export _ (Hash Nat)
   (def: eq Eq<Nat>)
   (def: hash id))
@@ -255,24 +178,8 @@
   (def: (hash value)
     (_lux_proc ["real" "hash"] [value])))
 
-(do-template [<name> <const> <doc>]
-  [(def: #export <name>
-     {#;doc <doc>}
-     Real
-     (_lux_proc ["real" <const>] []))]
-
-  [not-a-number      "not-a-number"      "Not-a-number."]
-  [positive-infinity "positive-infinity" "Positive infinity."]
-  [negative-infinity "negative-infinity" "Negative infinity."]
-  )
-
-(def: #export (not-a-number? number)
-  {#;doc "Tests whether a real is actually not-a-number."}
-  (-> Real Bool)
-  (not (r.= number number)))
-
 ## [Values & Syntax]
-(do-template [<struct> <base> <macro> <error> <char-set> <doc>]
+(do-template [<struct> <base> <char-set> <error>]
   [(struct: #export <struct> (Codec Text Nat)
      (def: (encode value)
        (loop [input value
@@ -282,16 +189,75 @@
                                                      output])
                input' (n./ <base> input)]
            (if (n.= +0 input')
-             output'
+             (_lux_proc ["text" "append"] ["+" output'])
              (recur input' output')))))
 
      (def: (decode repr)
        (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.>= +2 input-size)
+           (case (_lux_proc ["text" "char"] [repr +0])
+             (#;Some #"+")
+             (let [input (_lux_proc ["text" "upper-case"] [repr])]
+               (loop [idx +1
+                      output +0]
+                 (if (n.< input-size idx)
+                   (let [digit (assume (_lux_proc ["text" "char"] [input idx]))]
+                     (case (_lux_proc ["text" "index"]
+                                      [<char-set>
+                                       (_lux_proc ["char" "to-text"] [digit])
+                                       +0])
+                       #;None
+                       (#;Left (_lux_proc ["text" "append"] [<error> repr]))
+
+                       (#;Some index)
+                       (recur (n.inc idx)
+                              (|> output (n.* <base>) (n.+ index)))))
+                   (#;Right output))))
+
+             _
+             (#;Left (_lux_proc ["text" "append"] [<error> repr])))
+           (#;Left (_lux_proc ["text" "append"] [<error> repr]))))))]
+
+  [Binary@Codec<Text,Nat> +2  "01"               "Invalid binary syntax: "]
+  [Octal@Codec<Text,Nat>  +8  "01234567"         "Invalid octal syntax: "]
+  [_                      +10 "0123456789"       "Invalid syntax for Nat: "]
+  [Hex@Codec<Text,Nat>    +16 "0123456789ABCDEF" "Invalid hexadecimal syntax: "]
+  )
+
+(do-template [<struct> <base> <char-set> <error>]
+  [(struct: #export <struct> (Codec Text Int)
+     (def: (encode value)
+       (if (i.= 0 value)
+         "0"
+         (let [sign (if (i.< 0 value)
+                      "-"
+                      "")]
+           (loop [input (|> value (i./ <base>) (:: Number<Int> abs))
+                  output (|> value (i.% <base>) (:: Number<Int> abs)
+                             int-to-nat [<char-set>] (_lux_proc ["text" "char"])
+                             assume
+                             []
+                             (_lux_proc ["char" "to-text"]))]
+             (let [digit (assume (_lux_proc ["text" "char"] [<char-set> (int-to-nat (i.% <base> input))]))
+                   output' (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit])
+                                                         output])
+                   input' (i./ <base> input)]
+               (if (i.= 0 input')
+                 (_lux_proc ["text" "append"] [sign output'])
+                 (recur input' output')))))))
+
+     (def: (decode repr)
+       (let [input-size (_lux_proc ["text" "size"] [repr])]
+         (if (n.>= +1 input-size)
+           (let [sign (case (_lux_proc ["text" "char"] [repr +0])
+                        (#;Some #"-")
+                        -1
+
+                        _
+                        1)
+                 input (_lux_proc ["text" "upper-case"] [repr])]
+             (loop [idx (if (i.= -1 sign) +1 +0)
+                    output 0]
                (if (n.< input-size idx)
                  (let [digit (assume (_lux_proc ["text" "char"] [input idx]))]
                    (case (_lux_proc ["text" "index"]
@@ -303,33 +269,45 @@
 
                      (#;Some index)
                      (recur (n.inc idx)
-                            (|> output (n.* <base>) (n.+ index)))))
-                 (#;Right output))))))))
+                            (|> output (i.* <base>) (i.+ (nat-to-int index))))))
+                 (#;Right (i.* sign output)))))
+           (#;Left <error>)))))]
+
+  [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."]
+  )
 
-   (macro: #export (<macro> tokens state)
+(do-template [<macro> <nat> <int> <error> <doc>]
+  [(macro: #export (<macro> tokens state)
      {#;doc <doc>}
      (case tokens
        (#;Cons [meta (#;TextS repr)] #;Nil)
-       (case (:: <struct> decode repr)
+       (case (:: <nat> decode repr)
          (#;Right value)
          (#;Right [state (list [meta (#;NatS value)])])
 
-         (#;Left error)
-         (#;Left error))
+         (^=> (#;Left _)
+              [(:: <int> decode repr) (#;Right value)])
+         (#;Right [state (list [meta (#;IntS value)])])
+
+         _
+         (#;Left <error>))
 
        _
        (#;Left <error>)))]
 
-  [Binary@Codec<Text,Nat> +2  bin "Invalid binary syntax."
-   "01"
-   (doc "Given syntax for a binary number, generates a Nat."
+  [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int>
+   "Invalid binary syntax."
+   (doc "Given syntax for a binary number, generates a Nat, an Int, a Real or a Deg."
         (bin "11001001"))]
-  [Octal@Codec<Text,Nat>  +8  oct "Invalid octal syntax."
-   "01234567"
-   (doc "Given syntax for an octal number, generates a Nat."
+  [oct Octal@Codec<Text,Nat>  Octal@Codec<Text,Int>
+   "Invalid octal syntax."
+   (doc "Given syntax for an octal number, generates a Nat, an Int, a Real or a Deg."
         (oct "615243"))]
-  [Hex@Codec<Text,Nat>    +16 hex "Invalid hexadecimal syntax."
-   "0123456789ABCDEF"
-   (doc "Given syntax for a hexadecimal number, generates a Nat."
+  [hex Hex@Codec<Text,Nat>    Hex@Codec<Text,Int>
+   "Invalid hexadecimal syntax."
+   (doc "Given syntax for a hexadecimal number, generates a Nat, an Int, a Real or a Deg."
         (hex "deadBEEF"))]
   )