aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2017-03-30 23:09:25 -0400
committerEduardo Julian2017-03-30 23:09:25 -0400
commitae7c062bdf4ab8337f0eedae78b38df24e62822c (patch)
tree21654507c07c719b9d1a480d8b2ea6b9b439a6df /stdlib/source
parent020f625b3d94cdb00242ead397595eeff842533c (diff)
- Nat encoding/decoding is now implemented in the standard library.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux.lux29
-rw-r--r--stdlib/source/lux/data/number.lux55
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))