diff options
-rw-r--r-- | stdlib/source/lux.lux | 20 | ||||
-rw-r--r-- | stdlib/source/lux/data/text.lux | 34 | ||||
-rw-r--r-- | stdlib/source/lux/data/text/lexer.lux | 32 | ||||
-rw-r--r-- | stdlib/source/lux/data/text/regex.lux | 67 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 2 | ||||
-rw-r--r-- | stdlib/test/test/lux/data/text.lux | 2 |
6 files changed, 84 insertions, 73 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 557992ba4..98325ae30 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3962,7 +3962,7 @@ #import-refer {#refer-defs _referrals #refer-open _openings}}))))) -(def: (replace pattern value template) +(def: (replace-all pattern value template) (-> Text Text Text Text) (_lux_proc ["text" "replace-all"] [template pattern value])) @@ -4028,7 +4028,7 @@ openings+extra (parse-short-openings extra) #let [[openings extra] openings+extra]] (wrap (list {#import-name m-name - #import-alias (#;Some (replace ";" m-name alias)) + #import-alias (#;Some (replace-all ";" m-name alias)) #import-refer {#refer-defs referral #refer-open openings}}))) @@ -4922,14 +4922,14 @@ (def: (Text/encode original) (-> Text Text) (let [escaped (|> original - (replace "\t" "\\t") - (replace "\v" "\\v") - (replace "\b" "\\b") - (replace "\n" "\\n") - (replace "\r" "\\r") - (replace "\f" "\\f") - (replace "\"" "\\\"") - (replace "\\" "\\\\") + (replace-all "\t" "\\t") + (replace-all "\v" "\\v") + (replace-all "\b" "\\b") + (replace-all "\n" "\\n") + (replace-all "\r" "\\r") + (replace-all "\f" "\\f") + (replace-all "\"" "\\\"") + (replace-all "\\" "\\\\") )] ($_ Text/append "\"" escaped "\""))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 0f9e79ba6..b3192a56d 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -39,7 +39,7 @@ (-> Nat Text (Maybe Text)) (clip from (size input) input)) -(def: #export (replace pattern value template) +(def: #export (replace-all pattern value template) (-> Text Text Text Text) (_lux_proc ["text" "replace-all"] [template pattern value])) @@ -137,14 +137,14 @@ (struct: #export _ (Codec Text Text) (def: (encode original) (let [escaped (|> original - (replace "\\" "\\\\") - (replace "\t" "\\t") - (replace "\v" "\\v") - (replace "\b" "\\b") - (replace "\n" "\\n") - (replace "\r" "\\r") - (replace "\f" "\\f") - (replace "\"" "\\\"") + (replace-all "\\" "\\\\") + (replace-all "\t" "\\t") + (replace-all "\v" "\\v") + (replace-all "\b" "\\b") + (replace-all "\n" "\\n") + (replace-all "\r" "\\r") + (replace-all "\f" "\\f") + (replace-all "\"" "\\\"") )] ($_ append "\"" escaped "\""))) @@ -154,14 +154,14 @@ (case (clip +1 (n.dec (size input)) input) (#;Some input') (|> input' - (replace "\\\\" "\\") - (replace "\\t" "\t") - (replace "\\v" "\v") - (replace "\\b" "\b") - (replace "\\n" "\n") - (replace "\\r" "\r") - (replace "\\f" "\f") - (replace "\\\"" "\"") + (replace-all "\\\\" "\\") + (replace-all "\\t" "\t") + (replace-all "\\v" "\v") + (replace-all "\\b" "\b") + (replace-all "\\n" "\n") + (replace-all "\\r" "\r") + (replace-all "\\f" "\f") + (replace-all "\\\"" "\"") #;Some) #;None diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index e28cb0a68..5fcbe8e6e 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -398,6 +398,16 @@ (Lexer Char) (satisfies char;space?)) +(def: #export (constrain test lexer) + (All [a] (-> (-> a Bool) (Lexer a) (Lexer a))) + (do Monad<Lexer> + [input get-input + output lexer + _ (assert (Text/append "Input fails the constraint: " + (:: text;Codec<Text,Text> encode input)) + (test output))] + (wrap output))) + (do-template [<name> <base> <doc>] [(def: #export (<name> p) {#;doc <doc>} @@ -436,17 +446,17 @@ (lambda [input] (#E;Success [input (text;empty? input)]))) -(def: #export (_& left right) - (All [a b] (-> (Lexer a) (Lexer b) (Lexer b))) +(def: #export (after param subject) + (All [p s] (-> (Lexer p) (Lexer s) (Lexer s))) (do Monad<Lexer> - [_ left] - right)) + [_ param] + subject)) -(def: #export (&_ left right) - (All [a b] (-> (Lexer a) (Lexer b) (Lexer a))) +(def: #export (before param subject) + (All [p s] (-> (Lexer p) (Lexer s) (Lexer s))) (do Monad<Lexer> - [output left - _ right] + [output subject + _ param] (wrap output))) (def: #export (default value lexer) @@ -478,9 +488,9 @@ (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) - (_& (text start) - (&_ lexer - (text end)))) + (|> lexer + (before (text end)) + (after (text start)))) (def: #export (rec lexer) (All [a] (-> (-> (Lexer a) (Lexer a)) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 21358c9b0..6ed17d8c2 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -77,9 +77,9 @@ (do Monad<Lexer> [] ($_ &;either - (&;seq (wrap current-module) (&;_& (&;text ";;") identifier-part^)) - (&;seq identifier-part^ (&;_& (&;text ";") identifier-part^)) - (&;seq (wrap "lux") (&;_& (&;text ";") identifier-part^)) + (&;seq (wrap current-module) (&;after (&;text ";;") identifier-part^)) + (&;seq identifier-part^ (&;after (&;text ";") identifier-part^)) + (&;seq (wrap "lux") (&;after (&;text ";") identifier-part^)) (&;seq (wrap "") identifier-part^)))) (def: (re-var^ current-module) @@ -130,7 +130,7 @@ (do Monad<Lexer> [_ (wrap []) init re-user-class^' - rest (&;some (&;_& (&;text "&&") (&;enclosed ["[" "]"] re-user-class^')))] + rest (&;some (&;after (&;text "&&") (&;enclosed ["[" "]"] re-user-class^')))] (wrap (fold (lambda [refinement base] (` (refine^ (~ refinement) (~ base)))) init @@ -167,29 +167,29 @@ (do Monad<Lexer> [] ($_ &;either - (&;_& (&;char #".") (wrap (` (->Text &;any)))) - (&;_& (&;text "\\d") (wrap (` (->Text &;digit)))) - (&;_& (&;text "\\D") (wrap (` (->Text (&;not &;digit))))) - (&;_& (&;text "\\s") (wrap (` (->Text &;space)))) - (&;_& (&;text "\\S") (wrap (` (->Text (&;not &;space))))) - (&;_& (&;text "\\w") (wrap (` (->Text word^)))) - (&;_& (&;text "\\W") (wrap (` (->Text (&;not word^))))) - (&;_& (&;text "\\d") (wrap (` (->Text &;digit)))) - - (&;_& (&;text "\\p{Lower}") (wrap (` (->Text &;lower)))) - (&;_& (&;text "\\p{Upper}") (wrap (` (->Text &;upper)))) - (&;_& (&;text "\\p{Alpha}") (wrap (` (->Text &;alpha)))) - (&;_& (&;text "\\p{Digit}") (wrap (` (->Text &;digit)))) - (&;_& (&;text "\\p{Alnum}") (wrap (` (->Text &;alpha-num)))) - (&;_& (&;text "\\p{Space}") (wrap (` (->Text &;space)))) - (&;_& (&;text "\\p{HexDigit}") (wrap (` (->Text &;hex-digit)))) - (&;_& (&;text "\\p{OctDigit}") (wrap (` (->Text &;oct-digit)))) - (&;_& (&;text "\\p{Blank}") (wrap (` (->Text blank^)))) - (&;_& (&;text "\\p{ASCII}") (wrap (` (->Text ascii^)))) - (&;_& (&;text "\\p{Contrl}") (wrap (` (->Text control^)))) - (&;_& (&;text "\\p{Punct}") (wrap (` (->Text punct^)))) - (&;_& (&;text "\\p{Graph}") (wrap (` (->Text graph^)))) - (&;_& (&;text "\\p{Print}") (wrap (` (->Text print^)))) + (&;after (&;char #".") (wrap (` (->Text &;any)))) + (&;after (&;text "\\d") (wrap (` (->Text &;digit)))) + (&;after (&;text "\\D") (wrap (` (->Text (&;not &;digit))))) + (&;after (&;text "\\s") (wrap (` (->Text &;space)))) + (&;after (&;text "\\S") (wrap (` (->Text (&;not &;space))))) + (&;after (&;text "\\w") (wrap (` (->Text word^)))) + (&;after (&;text "\\W") (wrap (` (->Text (&;not word^))))) + (&;after (&;text "\\d") (wrap (` (->Text &;digit)))) + + (&;after (&;text "\\p{Lower}") (wrap (` (->Text &;lower)))) + (&;after (&;text "\\p{Upper}") (wrap (` (->Text &;upper)))) + (&;after (&;text "\\p{Alpha}") (wrap (` (->Text &;alpha)))) + (&;after (&;text "\\p{Digit}") (wrap (` (->Text &;digit)))) + (&;after (&;text "\\p{Alnum}") (wrap (` (->Text &;alpha-num)))) + (&;after (&;text "\\p{Space}") (wrap (` (->Text &;space)))) + (&;after (&;text "\\p{HexDigit}") (wrap (` (->Text &;hex-digit)))) + (&;after (&;text "\\p{OctDigit}") (wrap (` (->Text &;oct-digit)))) + (&;after (&;text "\\p{Blank}") (wrap (` (->Text blank^)))) + (&;after (&;text "\\p{ASCII}") (wrap (` (->Text ascii^)))) + (&;after (&;text "\\p{Contrl}") (wrap (` (->Text control^)))) + (&;after (&;text "\\p{Punct}") (wrap (` (->Text punct^)))) + (&;after (&;text "\\p{Graph}") (wrap (` (->Text graph^)))) + (&;after (&;text "\\p{Print}") (wrap (` (->Text print^)))) ))) (def: re-class^ @@ -245,15 +245,15 @@ (&;enclosed ["{" "}"] ($_ &;either (do @ - [[from to] (&;seq int^ (&;_& (&;char #",") int^))] + [[from to] (&;seq int^ (&;after (&;char #",") int^))] (wrap (` (join-text^ (&;between (~ (ast;nat (int-to-nat from))) (~ (ast;nat (int-to-nat to))) (~ base)))))) (do @ - [limit (&;_& (&;char #",") int^)] + [limit (&;after (&;char #",") int^)] (wrap (` (join-text^ (&;at-most (~ (ast;nat (int-to-nat limit))) (~ base)))))) (do @ - [limit (&;&_ int^ (&;char #","))] + [limit (&;before (&;char #",") int^)] (wrap (` (join-text^ (&;at-least (~ (ast;nat (int-to-nat limit))) (~ base)))))) (do @ [limit int^] @@ -377,7 +377,7 @@ (do Monad<Lexer> [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ - tail (&;some (&;_& (&;char #"|") sub^)) + tail (&;some (&;after (&;char #"|") sub^)) #let [g!op (if capturing? (` |||^) (` |||_^))]] @@ -476,8 +476,9 @@ )} (do @ [current-module compiler;current-module-name] - (case (&;run pattern - (&;&_ (regex^ current-module) &;end)) + (case (|> (regex^ current-module) + (&;before &;end) + (&;run pattern)) (#;Left error) (compiler;fail error) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index a527a7dda..d9f6c0019 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1360,7 +1360,7 @@ )} (do Monad<Lux> [current-module compiler;current-module-name - #let [fully-qualified-class-name (format (text;replace "/" "." current-module) "." full-class-name) + #let [fully-qualified-class-name (format (text;replace-all "/" "." current-module) "." full-class-name) field-parsers (map (field->parser fully-qualified-class-name) fields) method-parsers (map (method->parser (product;right class-decl) fully-qualified-class-name) methods) replacer (parser->replacer (fold s;either diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index f306778ba..d5deef0a4 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -113,7 +113,7 @@ (assert "Can replace occurrences of a piece of text inside a larger text." (&/= sample2 - (&;replace sep1 sep2 sample1))) + (&;replace-all sep1 sep2 sample1))) )) (test: "Other text functions" |