From 5690e2329296f63d55ba39d1d07218528d1cb984 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 11 May 2017 19:08:10 -0400
Subject: - Fixed bugs with octal and hexadecimal encodings for reals.

---
 stdlib/source/lux/data/number.lux    | 30 +++++++++++++++++++-----------
 stdlib/test/test/lux/data/number.lux | 28 ++++++++++++++--------------
 2 files changed, 33 insertions(+), 25 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 418e84a14..cb98f5624 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -381,12 +381,18 @@
 
 (def: (segment-digits chunk-size digits)
   (-> Nat Text (List Text))
-  (let [num-digits (_lux_proc ["text" "size"] [digits])]
-    (if (n.<= chunk-size num-digits)
-      (list digits)
-      (let [chunk (assume (_lux_proc ["text" "clip"] [digits +0 chunk-size]))
-            remaining (assume (_lux_proc ["text" "clip"] [digits chunk-size num-digits]))]
-        (list& chunk (segment-digits chunk-size remaining))))))
+  (case digits
+    ""
+    (list)
+
+    _
+    (let [num-digits (_lux_proc ["text" "size"] [digits])]
+      (if (n.<= chunk-size num-digits)
+        (list digits)
+        (let [boundary (n.- chunk-size num-digits)
+              chunk (assume (_lux_proc ["text" "clip"] [digits boundary num-digits]))
+              remaining (assume (_lux_proc ["text" "clip"] [digits +0 boundary]))]
+          (list& chunk (segment-digits chunk-size remaining)))))))
 
 (def: (bin-segment-to-hex input)
   (-> Text Text)
@@ -475,8 +481,8 @@
     (_lux_proc ["text" "append"] [x (re-join-chunks xs')])))
 
 (do-template [<from> <from-translator> <to> <to-translator> <base-bits>]
-  [(def: (<from> input)
-     (-> Text Text)
+  [(def: (<from> on-left? input)
+     (-> Bool Text Text)
      (let [max-num-chars (n./ <base-bits> +64)
            input-size (_lux_proc ["text" "size"] [input])
            zero-padding (let [num-digits-that-need-padding (n.% <base-bits> input-size)]
@@ -489,7 +495,9 @@
                                 output
                                 (recur (n.dec zeroes-left)
                                        (_lux_proc ["text" "append"] ["0" output]))))))
-           padded-input (_lux_proc ["text" "append"] [input zero-padding])]
+           padded-input (if on-left?
+                          (_lux_proc ["text" "append"] [zero-padding input])
+                          (_lux_proc ["text" "append"] [input zero-padding]))]
        (|> padded-input
            (segment-digits <base-bits>)
            (map <from-translator>)
@@ -516,10 +524,10 @@
                                                             (if (r.= -1.0 sign) +1 +0)
                                                             dot-idx]))
              decimal-part (assume (_lux_proc ["text" "clip"] [raw-bin (n.inc dot-idx) (_lux_proc ["text" "size"] [raw-bin])]))
-             hex-output (|> (<from> decimal-part)
+             hex-output (|> (<from> false decimal-part)
                             ["."]
                             (_lux_proc ["text" "append"])
-                            [(<from> whole-part)]
+                            [(<from> true whole-part)]
                             (_lux_proc ["text" "append"])
                             [(if (r.= -1.0 sign) "-" "")]
                             (_lux_proc ["text" "append"]))]
diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux
index dbae41674..3b4ba4909 100644
--- a/stdlib/test/test/lux/data/number.lux
+++ b/stdlib/test/test/lux/data/number.lux
@@ -122,20 +122,20 @@
                         (#;Left _)
                         false))))]
 
-  ["Nat/Binary"  R;nat  Eq<Nat>  Binary@Codec<Text,Nat>]
-  ["Nat/Octal"   R;nat  Eq<Nat>  Octal@Codec<Text,Nat>]
-  ["Nat/Decimal" 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/Decimal" R;int  Eq<Int>  Codec<Text,Int>]
-  ["Int/Hex"     R;int  Eq<Int>  Hex@Codec<Text,Int>]
-
-  ["Deg/Binary"  R;deg  Eq<Deg>  Binary@Codec<Text,Deg>]
-  ["Deg/Octal"   R;deg  Eq<Deg>  Octal@Codec<Text,Deg>]
-  ["Deg/Decimal" R;deg  Eq<Deg>  Codec<Text,Deg>]
-  ["Deg/Hex"     R;deg  Eq<Deg>  Hex@Codec<Text,Deg>]
+  ["Nat/Binary"   R;nat  Eq<Nat>  Binary@Codec<Text,Nat>]
+  ["Nat/Octal"    R;nat  Eq<Nat>  Octal@Codec<Text,Nat>]
+  ["Nat/Decimal"  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/Decimal"  R;int  Eq<Int>  Codec<Text,Int>]
+  ["Int/Hex"      R;int  Eq<Int>  Hex@Codec<Text,Int>]
+
+  ["Deg/Binary"   R;deg  Eq<Deg>  Binary@Codec<Text,Deg>]
+  ["Deg/Octal"    R;deg  Eq<Deg>  Octal@Codec<Text,Deg>]
+  ["Deg/Decimal"  R;deg  Eq<Deg>  Codec<Text,Deg>]
+  ["Deg/Hex"      R;deg  Eq<Deg>  Hex@Codec<Text,Deg>]
 
   ["Real/Binary"  R;real Eq<Real> Binary@Codec<Text,Real>]
   ["Real/Octal"   R;real Eq<Real> Octal@Codec<Text,Real>]
-- 
cgit v1.2.3