diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 30 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/number.lux | 28 |
2 files changed, 33 insertions, 25 deletions
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>] |