aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux94
-rw-r--r--stdlib/source/lux/data/format/xml.lux2
-rw-r--r--stdlib/source/lux/data/number.lux66
-rw-r--r--stdlib/source/lux/data/number/complex.lux19
-rw-r--r--stdlib/source/lux/data/text.lux54
-rw-r--r--stdlib/source/lux/data/text/lexer.lux4
-rw-r--r--stdlib/test/test/lux/data/number/complex.lux16
-rw-r--r--stdlib/test/test/lux/data/text.lux13
8 files changed, 134 insertions, 134 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 9b41010d9..70563181a 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2364,7 +2364,7 @@
""
"-")]
(("lux check" (-> Int Text Text)
- (function' recur [input output]
+ (function' recur [input output]
(if (i.= 0 input)
("lux text concat" sign output)
(recur (i./ 10 input)
@@ -3355,22 +3355,57 @@
(#Some y)
(#Some y))))
-(do-template [<name> <proc> <start>]
- [(def: (<name> part text)
- (-> Text Text (Maybe Nat))
- (<proc> text part <start>))]
+(do-template [<name> <form> <message> <doc-msg>]
+ [(macro: #export (<name> tokens)
+ {#;doc <doc-msg>}
+ (case (reverse tokens)
+ (^ (list& last init))
+ (return (list (fold (: (-> Code Code Code)
+ (function [pre post] (` <form>)))
+ last
+ init)))
+
+ _
+ (fail <message>)))]
- [index-of "lux text index" +0]
- [last-index-of "lux text last-index" ("lux text size" text)]
- )
+ [and (if (~ pre) (~ post) false) "'and' requires >=1 clauses." "Short-circuiting \"and\".\n(and true false true) ## => false"]
+ [or (if (~ pre) true (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\".\n(or true false true) ## => true"])
+
+(def: (index-of part text)
+ (-> Text Text (Maybe Nat))
+ ("lux text index" text part +0))
+
+(def: (last-index-of' part part-size since text)
+ (-> Text Nat Nat Text (Maybe Nat))
+ (case ("lux text index" text part (n.+ part-size since))
+ #;None
+ (#;Some since)
+
+ (#;Some since')
+ (last-index-of' part part-size since' text)))
+
+(def: (last-index-of part text)
+ (-> Text Text (Maybe Nat))
+ (case ("lux text index" text part +0)
+ (#;Some since)
+ (last-index-of' part ("lux text size" part) since text)
+
+ #;None
+ #;None))
(def: (clip1 from text)
(-> Nat Text (Maybe Text))
- ("lux text clip" text from ("lux text size" text)))
+ (let [to ("lux text size" text)]
+ (if (n.<= to from)
+ (#;Some ("lux text clip" text from to))
+ #;None)))
(def: (clip2 from to text)
(-> Nat Nat Text (Maybe Text))
- ("lux text clip" text from to))
+ (if (and (n.<= ("lux text size" text) to)
+ (n.<= to from))
+ (#;Some ("lux text clip" text from to))
+ #;None))
(def: #export (error! message)
{#;doc "## Causes an error, with the given error message.
@@ -3762,22 +3797,6 @@
(All [a] (-> a a))
x)
-(do-template [<name> <form> <message> <doc-msg>]
- [(macro: #export (<name> tokens)
- {#;doc <doc-msg>}
- (case (reverse tokens)
- (^ (list& last init))
- (return (list (fold (: (-> Code Code Code)
- (function [pre post] (` <form>)))
- last
- init)))
-
- _
- (fail <message>)))]
-
- [and (if (~ pre) (~ post) false) "'and' requires >=1 clauses." "Short-circuiting \"and\".\n(and true false true) ## => false"]
- [or (if (~ pre) true (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\".\n(or true false true) ## => true"])
-
(macro: #export (type: tokens)
{#;doc "## The type-definition macro.
(type: (List a)
@@ -5094,10 +5113,6 @@
(-> Text Nat)
("lux text size" x))
-(def: (text/trim x)
- (-> Text Text)
- ("lux text trim" x))
-
(def: (update-cursor [file line column] code-text)
(-> Cursor Text Cursor)
[file line (n.+ column (text/size code-text))])
@@ -5181,7 +5196,6 @@
(#;Text (~ (|> tokens
(map (. doc-fragment->Text identify-doc-fragment))
text/join
- text/trim
text$)))]))))
(def: (interleave xs ys)
@@ -5746,13 +5760,13 @@
(-> (List Code) (Meta [(Maybe Export-Level') (List Code)]))
(case tokens
(^ (list& [_ (#Tag ["" "export"])] tokens'))
- (:: Monad<Meta> wrap [(#;Some #Export) tokens'])
+ (return [(#;Some #Export) tokens'])
(^ (list& [_ (#Tag ["" "hidden"])] tokens'))
- (:: Monad<Meta> wrap [(#;Some #Hidden) tokens'])
+ (return [(#;Some #Hidden) tokens'])
_
- (:: Monad<Meta> wrap [#;None tokens])
+ (return [#;None tokens])
))
(def: (gen-export-level ?export-level)
@@ -5792,7 +5806,7 @@
(-> (List Code) (Meta [Code (List Code)]))
(case tokens
(^ (list& token tokens'))
- (:: Monad<Meta> wrap [token tokens'])
+ (return [token tokens'])
_
(fail "Could not parse anything.")
@@ -5802,7 +5816,7 @@
(-> (List Code) (Meta Unit))
(case tokens
(^ (list))
- (:: Monad<Meta> wrap [])
+ (return [])
_
(fail "Expected input Codes to be empty.")
@@ -5812,10 +5826,10 @@
(-> (List Code) (Meta [Code (List Code)]))
(case tokens
(^ (list& [_ (#Record _anns)] tokens'))
- (:: Monad<Meta> wrap [(record$ _anns) tokens'])
+ (return [(record$ _anns) tokens'])
_
- (:: Monad<Meta> wrap [(' {}) tokens])
+ (return [(' {}) tokens])
))
(macro: #export (template: tokens)
@@ -5957,7 +5971,7 @@
[ann (#Record (map right =kvs))]]))
_
- (:: Monad<Meta> wrap [(list) code])))
+ (return [(list) code])))
(macro: #export (`` tokens)
(case tokens
@@ -6017,7 +6031,7 @@
(wrap (` [(~ g!meta) (#;Record (~ (untemplate-list =fields)))])))
[_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]
- (:: Monad<Meta> wrap unquoted)
+ (return unquoted)
[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
(fail "Cannot use (~@) inside of ^code unless it is the last element in a form or a tuple.")
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index f2d1eb056..1e705e513 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -140,7 +140,7 @@
(l;Lexer XML)
(|> (p;either cdata^
(l;many xml-char^))
- (p/map (|>. text;trim #Text))))
+ (p/map (|>. #Text))))
(def: xml^
(l;Lexer XML)
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index e9009102b..06a8809e1 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -172,8 +172,8 @@
)
## [Values & Syntax]
-(def: (get-char full idx)
- (-> Text Nat (Maybe Text))
+(def: (get-char idx full)
+ (-> Nat Text Text)
("lux text clip" full idx (n.inc idx)))
(do-template [<struct> <base> <char-set> <error>]
@@ -181,7 +181,7 @@
(def: (encode value)
(loop [input value
output ""]
- (let [digit (maybe;assume (get-char <char-set> (n.% <base> input)))
+ (let [digit (get-char (n.% <base> input) <char-set>)
output' ("lux text concat" digit output)
input' (n./ <base> input)]
(if (n.= +0 input')
@@ -197,7 +197,7 @@
(loop [idx +1
output +0]
(if (n.< input-size idx)
- (let [digit (maybe;assume (get-char input idx))]
+ (let [digit (get-char idx input)]
(case ("lux text index" <char-set> digit +0)
#;None
(#E;Error ("lux text concat" <error> repr))
@@ -226,20 +226,19 @@
"-"
"")]
(loop [input (|> value (i./ <base>) (:: Number<Int> abs))
- output (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat
- (get-char <char-set>)
- maybe;assume)]
+ output (get-char (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat)
+ <char-set>)]
(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 (get-char (int-to-nat (i.% <base> input)) <char-set>)]
(recur (i./ <base> input)
("lux text concat" digit output))))))))
(def: (decode repr)
(let [input-size ("lux text size" repr)]
(if (n.>= +1 input-size)
- (let [sign (case (get-char repr +0)
- (^ (#;Some "-"))
+ (let [sign (case (get-char +0 repr)
+ "-"
-1
_
@@ -248,7 +247,7 @@
(loop [idx (if (i.= -1 sign) +1 +0)
output 0]
(if (n.< input-size idx)
- (let [digit (maybe;assume (get-char input idx))]
+ (let [digit (get-char idx input)]
(case ("lux text index" <char-set> digit +0)
#;None
(#E;Error <error>)
@@ -267,7 +266,7 @@
(def: (de-prefix input)
(-> Text Text)
- (maybe;assume ("lux text clip" input +1 ("lux text size" input))))
+ ("lux text clip" input +1 ("lux text size" input)))
(do-template [<struct> <nat> <char-bit-size> <error>]
[(struct: #export <struct> (Codec Text Deg)
@@ -315,8 +314,8 @@
(if (f.= 0.0 dec-left)
("lux text concat" "." output)
(let [shifted (f.* <base> dec-left)
- digit (|> shifted (f.% <base>) frac-to-int int-to-nat
- (get-char <char-set>) maybe;assume)]
+ digit (get-char (|> shifted (f.% <base>) frac-to-int int-to-nat)
+ <char-set>)]
(recur (f.% 1.0 shifted)
("lux text concat" output digit))))))]
("lux text concat" whole-part decimal-part)))
@@ -324,8 +323,8 @@
(def: (decode repr)
(case ("lux text index" repr "." +0)
(#;Some split-index)
- (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index))
- decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr)))]
+ (let [whole-part ("lux text clip" repr +0 split-index)
+ decimal-part ("lux text clip" repr (n.inc split-index) ("lux text size" repr))]
(case [(:: <int> decode whole-part)
(:: <int> decode decimal-part)]
(^multi [(#;Some whole) (#;Some decimal)]
@@ -369,8 +368,8 @@
(if (n.<= chunk-size num-digits)
(list digits)
(let [boundary (n.- chunk-size num-digits)
- chunk (maybe;assume ("lux text clip" digits boundary num-digits))
- remaining (maybe;assume ("lux text clip" digits +0 boundary))]
+ chunk ("lux text clip" digits boundary num-digits)
+ remaining ("lux text clip" digits +0 boundary)]
(list& chunk (segment-digits chunk-size remaining)))))))
(def: (bin-segment-to-hex input)
@@ -499,10 +498,10 @@
(let [sign (:: Number<Frac> signum value)
raw-bin (:: Binary@Codec<Text,Frac> encode value)
dot-idx (maybe;assume ("lux text index" raw-bin "." +0))
- whole-part (maybe;assume ("lux text clip" raw-bin
- (if (f.= -1.0 sign) +1 +0)
- dot-idx))
- decimal-part (maybe;assume ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin)))
+ whole-part ("lux text clip" raw-bin
+ (if (f.= -1.0 sign) +1 +0)
+ dot-idx)
+ decimal-part ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin))
hex-output (|> (<from> false decimal-part)
("lux text concat" ".")
("lux text concat" (<from> true whole-part))
@@ -518,8 +517,8 @@
1.0)]
(case ("lux text index" repr "." +0)
(#;Some split-index)
- (let [whole-part (maybe;assume ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index))
- decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr)))
+ (let [whole-part ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index)
+ decimal-part ("lux text clip" repr (n.inc split-index) ("lux text size" repr))
as-binary (|> (<to> decimal-part)
("lux text concat" ".")
("lux text concat" (<to> whole-part))
@@ -672,14 +671,13 @@
(loop [idx +0
output (make-digits [])]
(if (n.< length idx)
- (let [char (maybe;assume (get-char input idx))]
- (case ("lux text index" "0123456789" char +0)
- #;None
- #;None
-
- (#;Some digit)
- (recur (n.inc idx)
- (digits-put idx digit output))))
+ (case ("lux text index" "0123456789" (get-char idx input) +0)
+ #;None
+ #;None
+
+ (#;Some digit)
+ (recur (n.inc idx)
+ (digits-put idx digit output)))
(#;Some output)))
#;None)))
@@ -743,9 +741,7 @@
false)]
(if (and dotted?
(n.<= (n.inc bit;width) length))
- (case (|> ("lux text clip" input +1 length)
- maybe;assume
- text-to-digits)
+ (case (text-to-digits ("lux text clip" input +1 length))
(#;Some digits)
(loop [digits digits
idx +0
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index 778b4a1db..870474890 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -307,22 +307,3 @@
(math;sin inner))]
{#real real
#imaginary imaginary})))))))
-
-(struct: #export _ (Codec Text Complex)
- (def: (encode (^slots [#real #imaginary]))
- ($_ text/compose "(" (f/encode real) ", " (f/encode imaginary) ")"))
-
- (def: (decode input)
- (case (do maybe;Monad<Maybe>
- [input' (text;clip +1 (n.- +1 (text;size input)) input)]
- (text;split-with "," input'))
- #;None
- (#;Left (text/compose "Wrong syntax for complex numbers: " input))
-
- (#;Some [r' i'])
- (do E;Monad<Error>
- [r (f/decode (text;trim r'))
- i (f/decode (text;trim i'))]
- (wrap {#real r
- #imaginary i}))
- )))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 812047e35..21a170003 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -29,12 +29,14 @@
[lower-case "lux text lower-case"]
[upper-case "lux text upper-case"]
- [trim "lux text trim"]
)
(def: #export (clip from to input)
(-> Nat Nat Text (Maybe Text))
- ("lux text clip" input from to))
+ (if (and (n.<= ("lux text size" input) to)
+ (n.<= to from))
+ (#;Some ("lux text clip" input from to))
+ #;None))
(def: #export (clip' from input)
(-> Nat Text (Maybe Text))
@@ -44,22 +46,44 @@
(-> Text Text Text Text)
("lux text replace-all" template pattern value))
-(do-template [<general> <common> <proc> <start>]
- [(def: #export (<common> pattern input)
- (-> Text Text (Maybe Nat))
- (<proc> input pattern <start>))
+(def: #export (index-of' pattern from input)
+ (-> Text Nat Text (Maybe Nat))
+ ("lux text index" input pattern from))
- (def: #export (<general> pattern from input)
- (-> Text Nat Text (Maybe Nat))
- (<proc> input pattern from))]
+(def: #export (index-of pattern input)
+ (-> Text Text (Maybe Nat))
+ ("lux text index" input pattern +0))
- [index-of index-of' "lux text index" +0]
- [last-index-of last-index-of' "lux text last-index" (size input)]
- )
+(def: (last-index-of'' part part-size since text)
+ (-> Text Nat Nat Text (Maybe Nat))
+ (case ("lux text index" text part (n.+ part-size since))
+ #;None
+ (#;Some since)
+
+ (#;Some since')
+ (last-index-of'' part part-size since' text)))
+
+(def: #export (last-index-of' part from text)
+ (-> Text Nat Text (Maybe Nat))
+ (case ("lux text index" text part from)
+ (#;Some since)
+ (last-index-of'' part ("lux text size" part) since text)
+
+ #;None
+ #;None))
+
+(def: #export (last-index-of part text)
+ (-> Text Text (Maybe Nat))
+ (case ("lux text index" text part +0)
+ (#;Some since)
+ (last-index-of'' part ("lux text size" part) since text)
+
+ #;None
+ #;None))
(def: #export (starts-with? prefix x)
(-> Text Text Bool)
- (case (index-of' prefix x)
+ (case (index-of prefix x)
(#;Some +0)
true
@@ -68,7 +92,7 @@
(def: #export (ends-with? postfix x)
(-> Text Text Bool)
- (case (last-index-of' postfix x)
+ (case (last-index-of postfix x)
(#;Some n)
(n.= (size x)
(n.+ (size postfix) n))
@@ -88,7 +112,7 @@
(def: #export (split-with token sample)
(-> Text Text (Maybe [Text Text]))
(do maybe;Monad<Maybe>
- [index (index-of' token sample)
+ [index (index-of token sample)
[pre post'] (split index sample)
[_ post] (split (size token) post')]
(wrap [pre post])))
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 45effa773..9ae2bdd8f 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -65,7 +65,7 @@
{#;doc "Lex a text if it matches the given sample."}
(-> Text (Lexer Unit))
(function [[offset tape]]
- (case (text;index-of reference offset tape)
+ (case (text;index-of' reference offset tape)
(#;Some where)
(if (n.= offset where)
(#E;Success [[(n.+ (text;size reference) offset) tape] []])
@@ -78,7 +78,7 @@
{#;doc "Lex a text if it matches the given sample."}
(-> Text (Lexer Bool))
(function [(^@ input [offset tape])]
- (case (text;index-of reference offset tape)
+ (case (text;index-of' reference offset tape)
(^multi (#;Some where) (n.= offset where))
(#E;Success [[(n.+ (text;size reference) offset) tape] true])
diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux
index 5b7e2e1e7..410fa1cb9 100644
--- a/stdlib/test/test/lux/data/number/complex.lux
+++ b/stdlib/test/test/lux/data/number/complex.lux
@@ -117,8 +117,7 @@
quotient (|> x (&;c.- rem) (&;c./ y))
floored (|> quotient
(update@ #&;real math;floor)
- (update@ #&;imaginary math;floor))
- (^open "&/") &;Codec<Text,Complex>]
+ (update@ #&;imaginary math;floor))]
(within? 0.000000000001
x
(|> quotient (&;c.* y) (&;c.+ rem)))))
@@ -195,16 +194,3 @@
(&;nth-roots degree)
(List/map (&;pow' (|> degree nat-to-int int-to-frac)))
(list;every? (within? margin-of-error sample)))))))
-
-(context: "Codec"
- (<| (times +100)
- (do @
- [sample gen-complex
- #let [(^open "c/") &;Codec<Text,Complex>]]
- (test "Can encode/decode complex numbers."
- (|> sample c/encode c/decode
- (case> (#;Right output)
- (&;c.= sample output)
-
- _
- false))))))
diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux
index 92914ba25..10f51708e 100644
--- a/stdlib/test/test/lux/data/text.lux
+++ b/stdlib/test/test/lux/data/text.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux [io]
- (control ["M" monad #+ do Monad]
+ (control [monad #+ do Monad]
pipe)
(data ["&" text]
text/format
@@ -34,10 +34,10 @@
(&;nth idx)
(case> (^multi (#;Some char)
[(&;from-code char) char]
- [[(&;index-of' char sample)
- (&;last-index-of' char sample)
- (&;index-of char idx sample)
- (&;last-index-of char idx sample)]
+ [[(&;index-of char sample)
+ (&;last-index-of char sample)
+ (&;index-of' char idx sample)
+ (&;last-index-of' char idx sample)]
[(#;Some io) (#;Some lio)
(#;Some io') (#;Some lio')]])
(and (n.<= idx io)
@@ -128,8 +128,7 @@
($_ seq
(test "Can transform texts in certain ways."
(and (&/= "abc" (&;lower-case "ABC"))
- (&/= "ABC" (&;upper-case "abc"))
- (&/= "ABC" (&;trim " \tABC\n\r"))))
+ (&/= "ABC" (&;upper-case "abc"))))
)))
(context: "Structures"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 10:40:14 +0000