aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/number.lux179
1 files changed, 170 insertions, 9 deletions
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 0468a9f40..40905d0d5 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -8,7 +8,7 @@
enum
interval
codec)
- (data error)))
+ (data ["E" error])))
## [Structures]
(do-template [<type> <test>]
@@ -161,7 +161,6 @@
(#;Left <error>))))]
[Real ["real" "encode"] ["real" "decode"] "Could not decode Real"]
- [ Deg [ "deg" "encode"] [ "deg" "decode"] "Could not decode Deg"]
)
(struct: #export _ (Hash Nat)
@@ -218,10 +217,10 @@
(#;Left (_lux_proc ["text" "append"] [<error> repr])))
(#;Left (_lux_proc ["text" "append"] [<error> repr]))))))]
- [Binary@Codec<Text,Nat> +2 "01" "Invalid binary syntax: "]
- [Octal@Codec<Text,Nat> +8 "01234567" "Invalid octal syntax: "]
+ [Binary@Codec<Text,Nat> +2 "01" "Invalid binary syntax for Nat: "]
+ [Octal@Codec<Text,Nat> +8 "01234567" "Invalid octal syntax for Nat: "]
[_ +10 "0123456789" "Invalid syntax for Nat: "]
- [Hex@Codec<Text,Nat> +16 "0123456789ABCDEF" "Invalid hexadecimal syntax: "]
+ [Hex@Codec<Text,Nat> +16 "0123456789ABCDEF" "Invalid hexadecimal syntax for Nat: "]
)
(do-template [<struct> <base> <char-set> <error>]
@@ -268,14 +267,14 @@
(#;Some index)
(recur (n.inc idx)
- (|> output (i.* <base>) (i.+ (nat-to-int index))))))
+ (|> output (i.* <base>) (i.+ (:! Int index))))))
(#;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 for Int: "]
+ [Octal@Codec<Text,Int> 8 "01234567" "Invalid octal syntax for Int: "]
[_ 10 "0123456789" "Invalid syntax for Int: "]
- [Hex@Codec<Text,Int> 16 "0123456789ABCDEF" "Invalid hexadecimal syntax: "]
+ [Hex@Codec<Text,Int> 16 "0123456789ABCDEF" "Invalid hexadecimal syntax for Int: "]
)
(def: (de-prefix input)
@@ -590,3 +589,165 @@
(doc "Given syntax for a hexadecimal number, generates a Nat, an Int, a Deg or a Real."
(hex "deadBEEF"))]
)
+
+## The following code allows one to encode/decode Deg numbers as text.
+## This is not a simple algorithm, and it requires subverting the Deg
+## abstraction a bit.
+## It takes into account the fact that Deg numbers are represented by
+## Lux as 64-bit integers.
+## A valid way to model them is as Lux's Nat type.
+## This is a somewhat hackish way to do things, but it allows one to
+## write the encoding/decoding algorithm once, in pure Lux, rather
+## than having to implement it on the compiler for every platform
+## targeted by Lux.
+(def: deg-bits Nat +64)
+
+(def: (bit-shift-left param subject)
+ (-> Nat Nat Nat)
+ (_lux_proc ["bit" "shift-left"] [subject param]))
+
+(def: (bit-and param subject)
+ (-> Nat Nat Nat)
+ (_lux_proc ["bit" "and"] [subject param]))
+
+(def: (bit-or param subject)
+ (-> Nat Nat Nat)
+ (_lux_proc ["bit" "or"] [subject param]))
+
+(def: (bit-set? idx input)
+ (-> Nat Nat Bool)
+ (|> input (bit-and (bit-shift-left idx +1)) (n.= +0) ;not))
+
+(def: (bit-set idx input)
+ (-> Nat Nat Nat)
+ (bit-or (bit-shift-left idx +1) input))
+
+(type: Digits (#;HostT "#Array" (#;Cons Nat #;Nil)))
+
+(def: (make-digits _)
+ (-> Top Digits)
+ (_lux_proc ["array" "new"] [deg-bits]))
+
+(def: (digits-get idx digits)
+ (-> Nat Digits (Maybe Nat))
+ (_lux_proc ["array" "get"] [digits idx]))
+
+(def: (digits-put idx digit digits)
+ (-> Nat Nat Digits Digits)
+ (_lux_proc ["array" "put"] [digits idx digit]))
+
+(def: (prepend left right)
+ (-> Text Text Text)
+ (_lux_proc ["text" "append"] [left right]))
+
+(def: (digits-times-5! idx output)
+ (-> Nat Digits Digits)
+ (loop [idx idx
+ carry +0
+ output output]
+ (if (i.>= 0 (:! Int idx))
+ (let [raw (|> (digits-get idx output)
+ (default +0)
+ (n.* +5)
+ (n.+ carry))]
+ (recur (n.dec idx)
+ (n./ +10 raw)
+ (digits-put idx (n.% +10 raw) output)))
+ output)))
+
+(def: (digits-power power)
+ (-> Nat Digits)
+ (loop [times power
+ output (|> (make-digits [])
+ (digits-put power +1))]
+ (if (i.>= 0 (:! Int times))
+ (recur (n.dec times)
+ (digits-times-5! power output))
+ output)))
+
+(def: (digits-to-text digits)
+ (-> Digits Text)
+ (loop [idx (n.dec deg-bits)
+ all-zeroes? true
+ output ""]
+ (if (i.>= 0 (:! Int idx))
+ (let [digit (default +0 (digits-get idx digits))]
+ (if (and (n.= +0 digit)
+ all-zeroes?)
+ (recur (n.dec idx) true output)
+ (recur (n.dec idx)
+ false
+ (_lux_proc ["text" "append"]
+ [(:: Codec<Text,Int> encode (:! Int digit))
+ output]))))
+ (if all-zeroes?
+ "0"
+ output))))
+
+(def: (digits-add param subject)
+ (-> Digits Digits Digits)
+ (loop [idx (n.dec deg-bits)
+ carry +0
+ output (make-digits [])]
+ (if (i.>= 0 (:! Int idx))
+ (let [raw ($_ n.+
+ carry
+ (default +0 (digits-get idx param))
+ (default +0 (digits-get idx subject)))]
+ (recur (n.dec idx)
+ (n./ +10 raw)
+ (digits-put idx (n.% +10 raw) output)))
+ output)))
+
+(struct: #export _ (Codec Text Deg)
+ (def: (encode input)
+ (let [input (:! Nat input)
+ last-idx (n.dec deg-bits)]
+ (if (n.= +0 input)
+ ".0"
+ (loop [idx last-idx
+ digits (make-digits [])]
+ (if (i.>= 0 (:! Int idx))
+ (if (bit-set? idx input)
+ (let [digits' (digits-add (digits-power (n.- idx last-idx))
+ digits)]
+ (recur (n.dec idx)
+ digits'))
+ (recur (n.dec idx)
+ digits))
+ (_lux_proc ["text" "append"] ["." (digits-to-text digits)])
+ )))))
+
+ (def: (decode input)
+ (case (_lux_proc ["deg" "decode"] [input])
+ (#;Some value)
+ (#;Right value)
+
+ #;None
+ (#;Left (_lux_proc ["text" "append"]
+ ["Could not decode Deg: " input])))
+ ## (let [length (text-size input)]
+ ## (if (and (starts-with? "." input)
+ ## (n.<= (n.inc deg-bits) length))
+ ## (let [input (|> input
+ ## (substring +1 length)
+ ## clean-separators)]
+ ## (case (deg-text-to-digits input)
+ ## (#;Some digits)
+ ## (loop [digits digits
+ ## idx +0
+ ## output +0]
+ ## (if (n.< deg-bits idx)
+ ## (let [power (digits-power idx)]
+ ## (if (deg-digits-lt power digits)
+ ## ## Skip power
+ ## (recur digits (n.inc idx) output)
+ ## (recur (deg-digits-sub power digits)
+ ## (n.inc idx)
+ ## (bit-set idx output))))
+ ## (#E;Success (:! Deg output))))
+
+ ## #;None
+ ## (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))))
+ ## (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))))
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 22:56:51 +0000