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