aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/text/regex.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/text/regex.lux230
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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-23 00:09:33 +0000