diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 55 |
2 files changed, 79 insertions, 5 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index fc606bc36..964cf5b57 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1544,8 +1544,7 @@ #Nil ($' Monad Maybe) {#wrap - (lambda' return [x] - (#Some x)) + (lambda' [x] (#Some x)) #bind (lambda' [f ma] @@ -2070,10 +2069,32 @@ (-> Bool Text) (if x "true" "false")) -(def:''' (Nat/encode x) +(def:''' (digit-to-text digit) #Nil (-> Nat Text) - (_lux_proc ["nat" "encode"] [x])) + (_lux_case digit + +0 "0" + +1 "1" +2 "2" +3 "3" + +4 "4" +5 "5" +6 "6" + +7 "7" +8 "8" +9 "9" + _ (_lux_proc ["io" "error"] ["undefined"]))) + +(def:''' (Nat/encode value) + #Nil + (-> Nat Text) + (_lux_case value + +0 + "+0" + + _ + (let' [loop (_lux_: (-> Nat Text Text) + (lambda' recur [input output] + (if (_lux_proc ["nat" "="] [input +0]) + (_lux_proc ["text" "append"] ["+" output]) + (recur (_lux_proc ["nat" "/"] [input +10]) + (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) + output])))))] + (loop value "")))) (def:''' (Int/encode x) #Nil diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index c90abf76d..9b828ec25 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -144,12 +144,65 @@ #;None (#;Left <error>))))] - [ Nat [ "nat" "encode"] [ "nat" "decode"] "Couldn't decode Nat"] [ Int [ "int" "encode"] [ "int" "decode"] "Couldn't decode Int"] [ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"] [Real ["real" "encode"] ["real" "decode"] "Couldn't decode Real"] ) +(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 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 binary syntax.")) + (#;Left "Invalid binary syntax."))))) + (struct: #export _ (Hash Nat) (def: eq Eq<Nat>) (def: hash id)) |