aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/number.lux189
-rw-r--r--stdlib/source/lux/data/text.lux9
-rw-r--r--stdlib/test/test/lux/data/text.lux8
-rw-r--r--stdlib/test/tests.lux10
4 files changed, 154 insertions, 62 deletions
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 732adbb3b..c67ad0e56 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -175,12 +175,124 @@
(-> Text Nat (Maybe Text))
("lux text clip" full idx (n/inc idx)))
-(do-template [<struct> <base> <char-set> <error>]
+(def: (binary-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ +0 (#.Some "0")
+ +1 (#.Some "1")
+ _ #.None))
+
+(def: (binary-value digit)
+ (-> Text (Maybe Nat))
+ (case digit
+ "0" (#.Some +0)
+ "1" (#.Some +1)
+ _ #.None))
+
+(def: (octal-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ +0 (#.Some "0")
+ +1 (#.Some "1")
+ +2 (#.Some "2")
+ +3 (#.Some "3")
+ +4 (#.Some "4")
+ +5 (#.Some "5")
+ +6 (#.Some "6")
+ +7 (#.Some "7")
+ _ #.None))
+
+(def: (octal-value 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)
+ _ #.None))
+
+(def: (decimal-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ +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))
+
+(def: (decimal-value 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))
+
+(def: (hexadecimal-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ +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")
+ +10 (#.Some "A")
+ +11 (#.Some "B")
+ +12 (#.Some "C")
+ +13 (#.Some "D")
+ +14 (#.Some "E")
+ +15 (#.Some "F")
+ _ #.None))
+
+(def: (hexadecimal-value 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)
+ (^or "a" "A") (#.Some +10)
+ (^or "b" "B") (#.Some +11)
+ (^or "c" "C") (#.Some +12)
+ (^or "d" "D") (#.Some +13)
+ (^or "e" "E") (#.Some +14)
+ (^or "f" "F") (#.Some +15)
+ _ #.None))
+
+(do-template [<struct> <base> <to-character> <to-value> <error>]
[(struct: #export <struct> (Codec Text Nat)
(def: (encode value)
(loop [input value
output ""]
- (let [digit (maybe.assume (get-char <char-set> (n/% <base> input)))
+ (let [digit (maybe.assume (<to-character> (n/% <base> input)))
output' ("lux text concat" digit output)
input' (n// <base> input)]
(if (n/= +0 input')
@@ -192,31 +304,30 @@
(if (n/>= +2 input-size)
(case ("lux text char" repr +0)
(^ (#.Some (char "+")))
- (let [input ("lux text upper" repr)]
- (loop [idx +1
- output +0]
- (if (n/< input-size idx)
- (let [digit (maybe.assume (get-char input idx))]
- (case ("lux text index" <char-set> digit +0)
- #.None
- (#e.Error ("lux text concat" <error> repr))
-
- (#.Some index)
- (recur (n/inc idx)
- (|> output (n/* <base>) (n/+ index)))))
- (#e.Success output))))
+ (loop [idx +1
+ output +0]
+ (if (n/< input-size idx)
+ (let [digit (maybe.assume (get-char repr idx))]
+ (case (<to-value> digit)
+ #.None
+ (#e.Error ("lux text concat" <error> repr))
+
+ (#.Some digit-value)
+ (recur (n/inc idx)
+ (|> output (n/* <base>) (n/+ digit-value)))))
+ (#e.Success output)))
_
(#e.Error ("lux text concat" <error> repr)))
(#e.Error ("lux text concat" <error> repr))))))]
- [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 for Nat: "]
+ [Binary@Codec<Text,Nat> +2 binary-character binary-value "Invalid binary syntax for Nat: "]
+ [Octal@Codec<Text,Nat> +8 octal-character octal-value "Invalid octal syntax for Nat: "]
+ [_ +10 decimal-character decimal-value "Invalid syntax for Nat: "]
+ [Hex@Codec<Text,Nat> +16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
)
-(do-template [<struct> <base> <char-set> <error>]
+(do-template [<struct> <base> <to-character> <to-value> <error>]
[(struct: #export <struct> (Codec Text Int)
(def: (encode value)
(if (i/= 0 value)
@@ -226,11 +337,11 @@
"")]
(loop [input (|> value (i// <base>) (:: Number<Int> abs))
output (|> value (i/% <base>) (:: Number<Int> abs) int-to-nat
- (get-char <char-set>)
+ <to-character>
maybe.assume)]
(if (i/= 0 input)
("lux text concat" sign output)
- (let [digit (maybe.assume (get-char <char-set> (int-to-nat (i/% <base> input))))]
+ (let [digit (maybe.assume (<to-character> (int-to-nat (i/% <base> input))))]
(recur (i// <base> input)
("lux text concat" digit output))))))))
@@ -242,26 +353,25 @@
-1
_
- 1)
- input ("lux text upper" repr)]
+ 1)]
(loop [idx (if (i/= -1 sign) +1 +0)
output 0]
(if (n/< input-size idx)
- (let [digit (maybe.assume (get-char input idx))]
- (case ("lux text index" <char-set> digit +0)
+ (let [digit (maybe.assume (get-char repr idx))]
+ (case (<to-value> digit)
#.None
(#e.Error <error>)
- (#.Some index)
+ (#.Some digit-value)
(recur (n/inc idx)
- (|> output (i/* <base>) (i/+ (:! Int index))))))
+ (|> output (i/* <base>) (i/+ (:! Int digit-value))))))
(#e.Success (i/* sign output)))))
(#e.Error <error>)))))]
- [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 for Int: "]
+ [Binary@Codec<Text,Int> 2 binary-character binary-value "Invalid binary syntax for Int: "]
+ [Octal@Codec<Text,Int> 8 octal-character octal-value "Invalid octal syntax for Int: "]
+ [_ 10 decimal-character decimal-value "Invalid syntax for Int: "]
+ [Hex@Codec<Text,Int> 16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Int: "]
)
(def: (de-prefix input)
@@ -406,12 +516,12 @@
"7" "0111"
"8" "1000"
"9" "1001"
- "A" "1010"
- "B" "1011"
- "C" "1100"
- "D" "1101"
- "E" "1110"
- "F" "1111"
+ (^or "a" "A") "1010"
+ (^or "b" "B") "1011"
+ (^or "c" "C") "1100"
+ (^or "d" "D") "1101"
+ (^or "e" "E") "1110"
+ (^or "f" "F") "1111"
_ (undefined)))
(def: (bin-segment-to-octal input)
@@ -483,8 +593,7 @@
(def: <to>
(-> Text Text)
- (|>> "lux text upper"
- (segment-digits +1)
+ (|>> (segment-digits +1)
(map <to-translator>)
re-join-chunks))]
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index aeaf858cc..90f9bec02 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -27,15 +27,6 @@
_
false))
-(do-template [<name> <proc>]
- [(def: #export (<name> input)
- (-> Text Text)
- (<proc> input))]
-
- [lower-case "lux text lower"]
- [upper-case "lux text upper"]
- )
-
(def: #export (clip from to input)
(-> Nat Nat Text (Maybe Text))
("lux text clip" input from to))
diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux
index 42685e03f..2430c9919 100644
--- a/stdlib/test/test/lux/data/text.lux
+++ b/stdlib/test/test/lux/data/text.lux
@@ -123,14 +123,6 @@
(&.replace-all sep1 sep2 sample1)))
))))
-(context: "Other text functions"
- (let [(^open "&/") &.Eq<Text>]
- ($_ seq
- (test "Can transform texts in certain ways."
- (and (&/= "abc" (&.lower-case "ABC"))
- (&/= "ABC" (&.upper-case "abc"))))
- )))
-
(context: "Structures"
(let [(^open "&/") &.Order<Text>]
($_ seq
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index d4a0c0a32..694ada1c5 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -35,10 +35,13 @@
["_." maybe]
["_." product]
["_." sum]
- ["_." text]
["_." number]
(number ["_." ratio]
["_." complex])
+ ["_." text]
+ (text ["_." format]
+ ["_." lexer]
+ ["_." regex])
(format ["_." json]
["_." xml])
(coll ["_." array]
@@ -54,10 +57,7 @@
["_." queue]
(queue ["_." priority])
(tree ["_." rose]
- (rose ["_." zipper])))
- (text ["_." format]
- ["_." lexer]
- ["_." regex]))
+ (rose ["_." zipper]))))
["_." math]
(math ["_." random]
["_." modular]
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 17:36:34 +0000