diff options
Diffstat (limited to 'stdlib/source/lux/data/text/regex.lux')
| -rw-r--r-- | stdlib/source/lux/data/text/regex.lux | 89 |
1 files changed, 44 insertions, 45 deletions
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index bee56b728..45f1f8f69 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -27,23 +27,23 @@ l.any regex-char^))) -(def: #hidden (refine^ refinement^ base^) +(def: (refine^ refinement^ base^) (All [a] (-> (l.Lexer a) (l.Lexer Text) (l.Lexer Text))) (do p.Monad<Parser> [output base^ _ (l.local output refinement^)] (wrap output))) -(def: #hidden word^ +(def: word^ (l.Lexer Text) (p.either l.alpha-num (l.one-of "_"))) -(def: #hidden (copy reference) +(def: (copy reference) (-> Text (l.Lexer Text)) (p.after (l.this reference) (p/wrap reference))) -(def: #hidden (join-text^ part^) +(def: (join-text^ part^) (-> (l.Lexer (List Text)) (l.Lexer Text)) (do p.Monad<Parser> [parts part^] @@ -87,7 +87,7 @@ (l.Lexer Code) (do p.Monad<Parser> [char escaped-char^] - (wrap (` (..copy (~ (code.text char))))))) + (wrap (` ((~! ..copy) (~ (code.text char))))))) (def: re-options^ (l.Lexer Code) @@ -113,32 +113,32 @@ init re-user-class^' rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))] (wrap (list/fold (function [refinement base] - (` (refine^ (~ refinement) (~ base)))) + (` ((~! refine^) (~ refinement) (~ base)))) init rest)))) -(def: #hidden blank^ +(def: blank^ (l.Lexer Text) (l.one-of " \t")) -(def: #hidden ascii^ +(def: ascii^ (l.Lexer Text) (l.range (char "\u0000") (char "\u007F"))) -(def: #hidden control^ +(def: control^ (l.Lexer Text) (p.either (l.range (char "\u0000") (char "\u001F")) (l.one-of "\u007F"))) -(def: #hidden punct^ +(def: punct^ (l.Lexer Text) (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) -(def: #hidden graph^ +(def: graph^ (l.Lexer Text) (p.either punct^ l.alpha-num)) -(def: #hidden print^ +(def: print^ (l.Lexer Text) (p.either graph^ (l.one-of "\u0020"))) @@ -153,8 +153,8 @@ (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) (p.after (l.this "\\s") (wrap (` l.space))) (p.after (l.this "\\S") (wrap (` (l.not l.space)))) - (p.after (l.this "\\w") (wrap (` word^))) - (p.after (l.this "\\W") (wrap (` (l.not word^)))) + (p.after (l.this "\\w") (wrap (` (~! word^)))) + (p.after (l.this "\\W") (wrap (` (l.not (~! word^))))) (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) @@ -164,12 +164,12 @@ (p.after (l.this "\\p{Space}") (wrap (` l.space))) (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) - (p.after (l.this "\\p{Blank}") (wrap (` blank^))) - (p.after (l.this "\\p{ASCII}") (wrap (` ascii^))) - (p.after (l.this "\\p{Contrl}") (wrap (` control^))) - (p.after (l.this "\\p{Punct}") (wrap (` punct^))) - (p.after (l.this "\\p{Graph}") (wrap (` graph^))) - (p.after (l.this "\\p{Print}") (wrap (` print^))) + (p.after (l.this "\\p{Blank}") (wrap (` (~! blank^)))) + (p.after (l.this "\\p{ASCII}") (wrap (` (~! ascii^)))) + (p.after (l.this "\\p{Contrl}") (wrap (` (~! control^)))) + (p.after (l.this "\\p{Punct}") (wrap (` (~! punct^)))) + (p.after (l.this "\\p{Graph}") (wrap (` (~! graph^)))) + (p.after (l.this "\\p{Print}") (wrap (` (~! print^)))) ))) (def: re-class^ @@ -188,12 +188,12 @@ (p.either (do p.Monad<Parser> [_ (l.this "\\") id number^] - (wrap (` (..copy (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) + (wrap (` ((~! ..copy) (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) (do p.Monad<Parser> [_ (l.this "\\k<") captured-name identifier-part^ _ (l.this ">")] - (wrap (` (..copy (~ (code.symbol ["" captured-name])))))))) + (wrap (` ((~! ..copy) (~ (code.symbol ["" captured-name])))))))) (def: (re-simple^ current-module) (-> Text (l.Lexer Code)) @@ -214,11 +214,11 @@ (wrap (` (p.default "" (~ base)))) "*" - (wrap (` (join-text^ (p.some (~ base))))) + (wrap (` ((~! join-text^) (p.some (~ base))))) ## "+" _ - (wrap (` (join-text^ (p.many (~ base))))) + (wrap (` ((~! join-text^) (p.many (~ base))))) ))) (def: (re-counted-quantified^ current-module) @@ -229,18 +229,18 @@ ($_ p.either (do @ [[from to] (p.seq number^ (p.after (l.this ",") number^))] - (wrap (` (join-text^ (p.between (~ (code.nat from)) - (~ (code.nat to)) - (~ base)))))) + (wrap (` ((~! join-text^) (p.between (~ (code.nat from)) + (~ (code.nat to)) + (~ base)))))) (do @ [limit (p.after (l.this ",") number^)] - (wrap (` (join-text^ (p.at-most (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join-text^) (p.at-most (~ (code.nat limit)) (~ base)))))) (do @ [limit (p.before (l.this ",") number^)] - (wrap (` (join-text^ (p.at-least (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join-text^) (p.at-least (~ (code.nat limit)) (~ base)))))) (do @ [limit number^] - (wrap (` (join-text^ (p.exactly (~ (code.nat limit)) (~ base)))))))))) + (wrap (` ((~! join-text^) (p.exactly (~ (code.nat limit)) (~ base)))))))))) (def: (re-quantified^ current-module) (-> Text (l.Lexer Code)) @@ -253,10 +253,6 @@ (re-quantified^ current-module) (re-simple^ current-module))) -(def: #hidden _text/compose_ - (-> Text Text Text) - (:: text.Monoid<Text> compose)) - (type: Re-Group #Non-Capturing (#Capturing [(Maybe Text) Nat])) @@ -280,7 +276,7 @@ [idx names (list& (list g!temp complex - (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ g!temp))])) + (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))])) steps)] (#e.Success [(#Capturing [?name num-captures]) scoped]) @@ -296,7 +292,7 @@ [idx! (list& name! names) (list& (list name! scoped - (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ access))])) + (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ access))])) steps)]) ))) [0 @@ -312,11 +308,11 @@ ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))]) )) -(def: #hidden (unflatten^ lexer) +(def: (unflatten^ lexer) (-> (l.Lexer Text) (l.Lexer [Text Unit])) (p.seq lexer (:: p.Monad<Parser> wrap []))) -(def: #hidden (|||^ left right) +(def: (|||^ left right) (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer [Text (| l r)]))) (function [input] (case (left input) @@ -331,7 +327,7 @@ (#e.Error error) (#e.Error error))))) -(def: #hidden (|||_^ left right) +(def: (|||_^ left right) (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer Text))) (function [input] (case (left input) @@ -350,7 +346,7 @@ (-> [Nat Code] Code) (if (n/> +0 num-captures) alt - (` (unflatten^ (~ alt))))) + (` ((~! unflatten^) (~ alt))))) (def: (re-alternative^ capturing? re-scoped^ current-module) (-> Bool @@ -361,13 +357,16 @@ [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ tail (p.some (p.after (l.this "|") sub^)) - #let [g!op (if capturing? - (` |||^) - (` |||_^))]] + #let [g!op ["" " alt "]]] (if (list.empty? tail) (wrap head) (wrap [(list/fold n/max (product.left head) (list/map product.left tail)) - (` ($_ (~ g!op) (~ (prep-alternative head)) (~+ (list/map prep-alternative tail))))])))) + (` (let [(~@ g!op) (~ (if capturing? + (` (~! |||^)) + (` (~! |||_^))))] + ($_ (~@ g!op) + (~ (prep-alternative head)) + (~+ (list/map prep-alternative tail)))))])))) (def: (re-scoped^ current-module) (-> Text (l.Lexer [Re-Group Code])) @@ -486,7 +485,7 @@ do-something-else))} (with-gensyms [g!temp] (wrap (list& (` (^multi (~@ g!temp) - [(l.run (~@ g!temp) (regex (~ (code.text pattern)))) + [((~! l.run) (~@ g!temp) (regex (~ (code.text pattern)))) (#e.Success (~ (maybe.default (code.symbol g!temp) bindings)))])) body |