diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/data/text/regex.lux | 230 |
1 files changed, 115 insertions, 115 deletions
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index bd2d8133a..050e55475 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -14,24 +14,24 @@ ["n" nat ("#\." decimal)]] [collection ["." list ("#\." fold monad)]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]] ["." // ["%" format (#+ format)]]) -(def: regex-char^ +(def: regex_char^ (Parser Text) - (<t>.none-of "\.|&()[]{}")) + (<t>.none_of "\.|&()[]{}")) -(def: escaped-char^ +(def: escaped_char^ (Parser Text) (do <>.monad [? (<>.parses? (<t>.this "\"))] (if ? <t>.any - regex-char^))) + regex_char^))) (def: (refine^ refinement^ base^) (All [a] (-> (Parser a) (Parser Text) (Parser Text))) @@ -42,82 +42,82 @@ (def: word^ (Parser Text) - (<>.either <t>.alpha-num - (<t>.one-of "_"))) + (<>.either <t>.alpha_num + (<t>.one_of "_"))) (def: (copy reference) (-> Text (Parser Text)) (<>.after (<t>.this reference) (<>\wrap reference))) -(def: (join-text^ part^) +(def: (join_text^ part^) (-> (Parser (List Text)) (Parser Text)) (do <>.monad [parts part^] - (wrap (//.join-with "" parts)))) + (wrap (//.join_with "" parts)))) -(def: name-char^ +(def: name_char^ (Parser Text) - (<t>.none-of (format "[]{}()s#.<>" //.double-quote))) + (<t>.none_of (format "[]{}()s#.<>" //.double_quote))) -(def: name-part^ +(def: name_part^ (Parser Text) (do <>.monad [head (refine^ (<t>.not <t>.decimal) - name-char^) - tail (<t>.some name-char^)] + name_char^) + tail (<t>.some name_char^)] (wrap (format head tail)))) -(def: (name^ current-module) +(def: (name^ current_module) (-> Text (Parser Name)) ($_ <>.either - (<>.and (<>\wrap current-module) (<>.after (<t>.this "..") name-part^)) - (<>.and name-part^ (<>.after (<t>.this ".") name-part^)) - (<>.and (<>\wrap "lux") (<>.after (<t>.this ".") name-part^)) - (<>.and (<>\wrap "") name-part^))) + (<>.and (<>\wrap current_module) (<>.after (<t>.this "..") name_part^)) + (<>.and name_part^ (<>.after (<t>.this ".") name_part^)) + (<>.and (<>\wrap "lux") (<>.after (<t>.this ".") name_part^)) + (<>.and (<>\wrap "") name_part^))) -(def: (re-var^ current-module) +(def: (re_var^ current_module) (-> Text (Parser Code)) (do <>.monad - [name (<t>.enclosed ["\@<" ">"] (name^ current-module))] + [name (<t>.enclosed ["\@<" ">"] (name^ current_module))] (wrap (` (: (Parser Text) (~ (code.identifier name))))))) -(def: re-range^ +(def: re_range^ (Parser Code) (do {! <>.monad} - [from (|> regex-char^ (\ ! map (|>> (//.nth 0) maybe.assume))) + [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume))) _ (<t>.this "-") - to (|> regex-char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] + to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] (wrap (` (<t>.range (~ (code.nat from)) (~ (code.nat to))))))) -(def: re-char^ +(def: re_char^ (Parser Code) (do <>.monad - [char escaped-char^] + [char escaped_char^] (wrap (` ((~! ..copy) (~ (code.text char))))))) -(def: re-options^ +(def: re_options^ (Parser Code) (do <>.monad - [options (<t>.many escaped-char^)] - (wrap (` (<t>.one-of (~ (code.text options))))))) + [options (<t>.many escaped_char^)] + (wrap (` (<t>.one_of (~ (code.text options))))))) -(def: re-user-class^' +(def: re_user_class^' (Parser Code) (do <>.monad [negate? (<>.maybe (<t>.this "^")) parts (<>.many ($_ <>.either - re-range^ - re-options^))] + re_range^ + re_options^))] (wrap (case negate? (#.Some _) (` (<t>.not ($_ <>.either (~+ parts)))) #.None (` ($_ <>.either (~+ parts))))))) -(def: re-user-class^ +(def: re_user_class^ (Parser Code) (do <>.monad [_ (wrap []) - init re-user-class^' - rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re-user-class^')))] + init re_user_class^' + rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re_user_class^')))] (wrap (list\fold (function (_ refinement base) (` ((~! refine^) (~ refinement) (~ base)))) init @@ -125,7 +125,7 @@ (def: blank^ (Parser Text) - (<t>.one-of (format " " //.tab))) + (<t>.one_of (format " " //.tab))) (def: ascii^ (Parser Text) @@ -134,23 +134,23 @@ (def: control^ (Parser Text) (<>.either (<t>.range (hex "0") (hex "1F")) - (<t>.one-of (//.from-code (hex "7F"))))) + (<t>.one_of (//.from_code (hex "7F"))))) (def: punct^ (Parser Text) - (<t>.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" - //.double-quote))) + (<t>.one_of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" + //.double_quote))) (def: graph^ (Parser Text) - (<>.either punct^ <t>.alpha-num)) + (<>.either punct^ <t>.alpha_num)) (def: print^ (Parser Text) (<>.either graph^ - (<t>.one-of (//.from-code (hex "20"))))) + (<t>.one_of (//.from_code (hex "20"))))) -(def: re-system-class^ +(def: re_system_class^ (Parser Code) (do <>.monad [] @@ -167,7 +167,7 @@ (<>.after (<t>.this "\p{Upper}") (wrap (` <t>.upper))) (<>.after (<t>.this "\p{Alpha}") (wrap (` <t>.alpha))) (<>.after (<t>.this "\p{Digit}") (wrap (` <t>.decimal))) - (<>.after (<t>.this "\p{Alnum}") (wrap (` <t>.alpha-num))) + (<>.after (<t>.this "\p{Alnum}") (wrap (` <t>.alpha_num))) (<>.after (<t>.this "\p{Space}") (wrap (` <t>.space))) (<>.after (<t>.this "\p{HexDigit}") (wrap (` <t>.hexadecimal))) (<>.after (<t>.this "\p{OctDigit}") (wrap (` <t>.octal))) @@ -179,17 +179,17 @@ (<>.after (<t>.this "\p{Print}") (wrap (` (~! print^)))) ))) -(def: re-class^ +(def: re_class^ (Parser Code) - (<>.either re-system-class^ - (<t>.enclosed ["[" "]"] re-user-class^))) + (<>.either re_system_class^ + (<t>.enclosed ["[" "]"] re_user_class^))) (def: number^ (Parser Nat) (|> (<t>.many <t>.decimal) (<>.codec n.decimal))) -(def: re-back-reference^ +(def: re_back_reference^ (Parser Code) (<>.either (do <>.monad [_ (<t>.this "\") @@ -197,102 +197,102 @@ (wrap (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)])))))) (do <>.monad [_ (<t>.this "\k<") - captured-name name-part^ + captured_name name_part^ _ (<t>.this ">")] - (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name])))))))) + (wrap (` ((~! ..copy) (~ (code.identifier ["" captured_name])))))))) -(def: (re-simple^ current-module) +(def: (re_simple^ current_module) (-> Text (Parser Code)) ($_ <>.either - re-class^ - (re-var^ current-module) - re-back-reference^ - re-char^ + re_class^ + (re_var^ current_module) + re_back_reference^ + re_char^ )) -(def: (re-simple-quantified^ current-module) +(def: (re_simple_quantified^ current_module) (-> Text (Parser Code)) (do <>.monad - [base (re-simple^ current-module) - quantifier (<t>.one-of "?*+")] + [base (re_simple^ current_module) + quantifier (<t>.one_of "?*+")] (case quantifier "?" (wrap (` (<>.default "" (~ base)))) "*" - (wrap (` ((~! join-text^) (<>.some (~ base))))) + (wrap (` ((~! join_text^) (<>.some (~ base))))) ## "+" _ - (wrap (` ((~! join-text^) (<>.many (~ base))))) + (wrap (` ((~! join_text^) (<>.many (~ base))))) ))) -(def: (re-counted-quantified^ current-module) +(def: (re_counted_quantified^ current_module) (-> Text (Parser Code)) (do {! <>.monad} - [base (re-simple^ current-module)] + [base (re_simple^ current_module)] (<t>.enclosed ["{" "}"] ($_ <>.either (do ! [[from to] (<>.and number^ (<>.after (<t>.this ",") number^))] - (wrap (` ((~! join-text^) (<>.between (~ (code.nat from)) + (wrap (` ((~! join_text^) (<>.between (~ (code.nat from)) (~ (code.nat to)) (~ base)))))) (do ! [limit (<>.after (<t>.this ",") number^)] - (wrap (` ((~! join-text^) (<>.at-most (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base)))))) (do ! [limit (<>.before (<t>.this ",") number^)] - (wrap (` ((~! join-text^) (<>.at-least (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base)))))) (do ! [limit number^] - (wrap (` ((~! join-text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) + (wrap (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) -(def: (re-quantified^ current-module) +(def: (re_quantified^ current_module) (-> Text (Parser Code)) - (<>.either (re-simple-quantified^ current-module) - (re-counted-quantified^ current-module))) + (<>.either (re_simple_quantified^ current_module) + (re_counted_quantified^ current_module))) -(def: (re-complex^ current-module) +(def: (re_complex^ current_module) (-> Text (Parser Code)) ($_ <>.either - (re-quantified^ current-module) - (re-simple^ current-module))) + (re_quantified^ current_module) + (re_simple^ current_module))) -(type: Re-Group - #Non-Capturing +(type: Re_Group + #Non_Capturing (#Capturing [(Maybe Text) Nat])) -(def: (re-sequential^ capturing? re-scoped^ current-module) +(def: (re_sequential^ capturing? re_scoped^ current_module) (-> Bit - (-> Text (Parser [Re-Group Code])) + (-> Text (Parser [Re_Group Code])) Text (Parser [Nat Code])) (do <>.monad - [parts (<>.many (<>.or (re-complex^ current-module) - (re-scoped^ current-module))) + [parts (<>.many (<>.or (re_complex^ current_module) + (re_scoped^ current_module))) #let [g!total (code.identifier ["" "0total"]) g!temp (code.identifier ["" "0temp"]) - [_ names steps] (list\fold (: (-> (Either Code [Re-Group Code]) + [_ names steps] (list\fold (: (-> (Either Code [Re_Group Code]) [Nat (List Code) (List (List Code))] [Nat (List Code) (List (List Code))]) (function (_ part [idx names steps]) (case part - (^or (#.Left complex) (#.Right [#Non-Capturing complex])) + (^or (#.Left complex) (#.Right [#Non_Capturing complex])) [idx names (list& (list g!temp complex (' #let) (` [(~ g!total) (\ (~! //.monoid) (~' compose) (~ g!total) (~ g!temp))])) steps)] - (#.Right [(#Capturing [?name num-captures]) scoped]) + (#.Right [(#Capturing [?name num_captures]) scoped]) (let [[idx! name!] (case ?name (#.Some _name) [idx (code.identifier ["" _name])] #.None [(inc idx) (code.identifier ["" (n\encode idx)])]) - access (if (n.> 0 num-captures) + access (if (n.> 0 num_captures) (` ((~! product.left) (~ name!))) name!)] [idx! @@ -348,19 +348,19 @@ (#try.Failure error) (#try.Failure error))))) -(def: (prep-alternative [num-captures alt]) +(def: (prep_alternative [num_captures alt]) (-> [Nat Code] Code) - (if (n.> 0 num-captures) + (if (n.> 0 num_captures) alt (` ((~! unflatten^) (~ alt))))) -(def: (re-alternative^ capturing? re-scoped^ current-module) +(def: (re_alternative^ capturing? re_scoped^ current_module) (-> Bit - (-> Text (Parser [Re-Group Code])) + (-> Text (Parser [Re_Group Code])) Text (Parser [Nat Code])) (do <>.monad - [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] + [#let [sub^ (re_sequential^ capturing? re_scoped^ current_module)] head sub^ tail (<>.some (<>.after (<t>.this "|") sub^))] (if (list.empty? tail) @@ -369,36 +369,36 @@ (` ($_ ((~ (if capturing? (` (~! |||^)) (` (~! |||_^))))) - (~ (prep-alternative head)) - (~+ (list\map prep-alternative tail))))])))) + (~ (prep_alternative head)) + (~+ (list\map prep_alternative tail))))])))) -(def: (re-scoped^ current-module) - (-> Text (Parser [Re-Group Code])) +(def: (re_scoped^ current_module) + (-> Text (Parser [Re_Group Code])) ($_ <>.either (do <>.monad [_ (<t>.this "(?:") - [_ scoped] (re-alternative^ #0 re-scoped^ current-module) + [_ scoped] (re_alternative^ #0 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [#Non-Capturing scoped])) + (wrap [#Non_Capturing scoped])) (do <>.monad - [complex (re-complex^ current-module)] - (wrap [#Non-Capturing complex])) + [complex (re_complex^ current_module)] + (wrap [#Non_Capturing complex])) (do <>.monad [_ (<t>.this "(?<") - captured-name name-part^ + captured_name name_part^ _ (<t>.this ">") - [num-captures pattern] (re-alternative^ #1 re-scoped^ current-module) + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern])) + (wrap [(#Capturing [(#.Some captured_name) num_captures]) pattern])) (do <>.monad [_ (<t>.this "(") - [num-captures pattern] (re-alternative^ #1 re-scoped^ current-module) + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [(#Capturing [#.None num-captures]) pattern])))) + (wrap [(#Capturing [#.None num_captures]) pattern])))) -(def: (regex^ current-module) +(def: (regex^ current_module) (-> Text (Parser Code)) - (\ <>.monad map product.right (re-alternative^ #1 re-scoped^ current-module))) + (\ <>.monad map product.right (re_alternative^ #1 re_scoped^ current_module))) (syntax: #export (regex {pattern <c>.text}) {#.doc (doc "Create lexers using regular-expression syntax." @@ -460,11 +460,11 @@ (regex "a(.)(.)|b(.)(.)") )} (do meta.monad - [current-module meta.current-module-name] - (case (<t>.run (regex^ current-module) + [current_module meta.current_module_name] + (case (<t>.run (regex^ current_module) pattern) (#try.Failure error) - (meta.fail (format "Error while parsing regular-expression:" //.new-line + (meta.fail (format "Error while parsing regular-expression:" //.new_line error)) (#try.Success regex) @@ -475,19 +475,19 @@ body {branches (<>.many <c>.any)}) {#.doc (doc "Allows you to test text against regular expressions." - (case some-text + (case some_text (^regex "(\d{3})-(\d{3})-(\d{4})" - [_ country-code area-code place-code]) - do-some-thing-when-number + [_ country_code area_code place_code]) + do_some_thing_when_number (^regex "\w+") - do-some-thing-when-word + do_some_thing_when_word _ - do-something-else))} - (with-gensyms [g!temp] - (wrap (list& (` (^multi (~ g!temp) - [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) - (#try.Success (~ (maybe.default g!temp bindings)))])) - body - branches)))) + do_something_else))} + (with_gensyms [g!temp] + (wrap (list& (` (^multi (~ g!temp) + [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) + (#try.Success (~ (maybe.default g!temp bindings)))])) + body + branches)))) |