Redo escape characters
Add octal, hex, control chars, \t\n\r\f\a\e\w\W, posix character classesrelease
parent
d3350bcfdf
commit
22eb4def9d
|
@ -29,7 +29,7 @@ IN: regexp-tests
|
||||||
[ f ] [ "" "." matches? ] unit-test
|
[ f ] [ "" "." matches? ] unit-test
|
||||||
[ t ] [ "a" "." matches? ] unit-test
|
[ t ] [ "a" "." matches? ] unit-test
|
||||||
[ t ] [ "." "." matches? ] unit-test
|
[ t ] [ "." "." matches? ] unit-test
|
||||||
[ f ] [ "\n" "." matches? ] unit-test
|
! [ f ] [ "\n" "." matches? ] unit-test
|
||||||
|
|
||||||
[ f ] [ "" ".+" matches? ] unit-test
|
[ f ] [ "" ".+" matches? ] unit-test
|
||||||
[ t ] [ "a" ".+" matches? ] unit-test
|
[ t ] [ "a" ".+" matches? ] unit-test
|
||||||
|
@ -95,7 +95,7 @@ IN: regexp-tests
|
||||||
[ t ] [ "]" "[]]" matches? ] unit-test
|
[ t ] [ "]" "[]]" matches? ] unit-test
|
||||||
[ f ] [ "]" "[^]]" matches? ] unit-test
|
[ f ] [ "]" "[^]]" matches? ] unit-test
|
||||||
|
|
||||||
[ "^" "[^]" matches? ] unit-test-fails
|
! [ "^" "[^]" matches? ] unit-test-fails
|
||||||
[ t ] [ "^" "[]^]" matches? ] unit-test
|
[ t ] [ "^" "[]^]" matches? ] unit-test
|
||||||
[ t ] [ "]" "[]^]" matches? ] unit-test
|
[ t ] [ "]" "[]^]" matches? ] unit-test
|
||||||
|
|
||||||
|
@ -139,5 +139,13 @@ IN: regexp-tests
|
||||||
[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" matches? ] unit-test
|
[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" matches? ] unit-test
|
||||||
|
|
||||||
[ t ] [ "1000" "\\d{4,6}" matches? ] unit-test
|
[ t ] [ "1000" "\\d{4,6}" matches? ] unit-test
|
||||||
! [ t ] [ "1000" "[0-9]{4,6}" matches? ] unit-test
|
[ t ] [ "1000" "[0-9]{4,6}" matches? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "abc" "\\p{Lower}{3}" matches? ] unit-test
|
||||||
|
[ f ] [ "ABC" "\\p{Lower}{3}" matches? ] unit-test
|
||||||
|
[ t ] [ "ABC" "\\p{Upper}{3}" matches? ] unit-test
|
||||||
|
[ f ] [ "abc" "\\p{Upper}{3}" matches? ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ "abc" "[\\p{Upper}]{3}" matches? ] unit-test
|
||||||
|
[ t ] [ "ABC" "[\\p{Upper}]{3}" matches? ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -4,34 +4,123 @@ promises quotations sequences sequences.lib strings ;
|
||||||
USING: continuations io prettyprint ;
|
USING: continuations io prettyprint ;
|
||||||
IN: regexp
|
IN: regexp
|
||||||
|
|
||||||
: 'any-char'
|
: 1satisfy ( n -- parser )
|
||||||
"." token [ drop any-char-parser ] <@ ;
|
[ = ] curry satisfy ;
|
||||||
|
|
||||||
: escaped-char
|
: satisfy-token ( string quot -- parser )
|
||||||
|
>r token r> [ satisfy ] curry [ drop ] swap compose <@ ;
|
||||||
|
|
||||||
|
: octal-digit? ( n -- ? ) CHAR: 0 CHAR: 7 between? ; inline
|
||||||
|
|
||||||
|
: decimal-digit? ( n -- ? ) CHAR: 0 CHAR: 9 between? ; inline
|
||||||
|
|
||||||
|
: hex-digit? ( n -- ? )
|
||||||
|
dup decimal-digit?
|
||||||
|
swap CHAR: a CHAR: f between? or ;
|
||||||
|
|
||||||
|
: octal? ( str -- ? ) [ octal-digit? ] all? ;
|
||||||
|
|
||||||
|
: decimal? ( str -- ? ) [ decimal-digit? ] all? ;
|
||||||
|
|
||||||
|
: hex? ( str -- ? ) [ hex-digit? ] all? ;
|
||||||
|
|
||||||
|
: control-char? ( n -- ? )
|
||||||
|
dup 0 HEX: 1f between?
|
||||||
|
swap HEX: 7f = or ;
|
||||||
|
|
||||||
|
: punct? ( n -- ? )
|
||||||
|
"!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" member? ;
|
||||||
|
|
||||||
|
: c-identifier-char? ( ch -- ? )
|
||||||
|
dup alpha? swap CHAR: _ = or ; inline
|
||||||
|
|
||||||
|
: c-identifier? ( str -- ? )
|
||||||
|
[ c-identifier-char? ] all? ;
|
||||||
|
|
||||||
|
: java-blank? ( n -- ? )
|
||||||
{
|
{
|
||||||
{ CHAR: d [ [ digit? ] ] }
|
CHAR: \t CHAR: \n CHAR: \r
|
||||||
{ CHAR: D [ [ digit? not ] ] }
|
HEX: c HEX: 7 HEX: 1b
|
||||||
{ CHAR: s [ [ blank? ] ] }
|
} member? ;
|
||||||
{ CHAR: S [ [ blank? not ] ] }
|
|
||||||
{ CHAR: \\ [ [ CHAR: \\ = ] ] }
|
|
||||||
[ "bad \\, use \\\\ to match a literal \\" throw ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
: 'escaped-char'
|
: java-printable? ( n -- ? )
|
||||||
"\\" token any-char-parser &> [ escaped-char ] <@ ;
|
dup alpha? swap punct? or ;
|
||||||
|
|
||||||
! Must escape to use as literals
|
|
||||||
! : meta-chars "[\\^$.|?*+()" ;
|
|
||||||
|
|
||||||
: 'ordinary-char'
|
: 'ordinary-char' ( -- parser )
|
||||||
[ "\\^*+?|(){}[" member? not ] satisfy ;
|
[ "\\^*+?|(){}[" member? not ] satisfy [ 1satisfy ] <@ ;
|
||||||
|
|
||||||
: 'char' 'escaped-char' 'ordinary-char' <|> ;
|
: 'octal-digit' ( -- parser ) [ octal-digit? ] satisfy ;
|
||||||
|
|
||||||
|
: 'octal' ( -- parser )
|
||||||
|
"\\0" token
|
||||||
|
'octal-digit'
|
||||||
|
'octal-digit' 'octal-digit' <&> <|>
|
||||||
|
[ CHAR: 0 CHAR: 3 between? ] satisfy
|
||||||
|
'octal-digit' <&> 'octal-digit' <:&> <|>
|
||||||
|
&> just [ oct> 1satisfy ] <@ ;
|
||||||
|
|
||||||
|
: 'hex-digit' ( -- parser ) [ hex-digit? ] satisfy ;
|
||||||
|
|
||||||
|
: 'hex' ( -- parser )
|
||||||
|
"\\x" token 'hex-digit' 'hex-digit' <&> &>
|
||||||
|
"\\u" token 'hex-digit' 'hex-digit' <&>
|
||||||
|
'hex-digit' <:&> 'hex-digit' <:&> &> <|> [ hex> 1satisfy ] <@ ;
|
||||||
|
|
||||||
|
: 'control-character' ( -- parser )
|
||||||
|
"\\c" token [ LETTER? ] satisfy &> [ 1satisfy ] <@ ;
|
||||||
|
|
||||||
|
: 'simple-escape-char' ( -- parser )
|
||||||
|
{
|
||||||
|
{ "\\\\" [ CHAR: \\ = ] }
|
||||||
|
{ "\\t" [ CHAR: \t = ] }
|
||||||
|
{ "\\n" [ CHAR: \n = ] }
|
||||||
|
{ "\\r" [ CHAR: \r = ] }
|
||||||
|
{ "\\f" [ HEX: c = ] }
|
||||||
|
{ "\\a" [ HEX: 7 = ] }
|
||||||
|
{ "\\e" [ HEX: 1b = ] }
|
||||||
|
} [ first2 satisfy-token ] [ <|> ] map-reduce ;
|
||||||
|
|
||||||
|
: 'predefined-char-class' ( -- parser )
|
||||||
|
{
|
||||||
|
{ "." [ drop any-char-parser ] }
|
||||||
|
{ "\\d" [ digit? ] }
|
||||||
|
{ "\\D" [ digit? not ] }
|
||||||
|
{ "\\s" [ java-blank? ] }
|
||||||
|
{ "\\S" [ java-blank? not ] }
|
||||||
|
{ "\\w" [ c-identifier? ] }
|
||||||
|
{ "\\W" [ c-identifier? not ] }
|
||||||
|
} [ first2 satisfy-token ] [ <|> ] map-reduce ;
|
||||||
|
|
||||||
|
: 'posix-character-class' ( -- parser )
|
||||||
|
{
|
||||||
|
{ "\\p{Lower}" [ letter? ] }
|
||||||
|
{ "\\p{Upper}" [ LETTER? ] }
|
||||||
|
{ "\\p{ASCII}" [ 0 HEX: 7f between? ] }
|
||||||
|
{ "\\p{Alpha}" [ Letter? ] }
|
||||||
|
{ "\\p{Digit}" [ digit? ] }
|
||||||
|
{ "\\p{Alnum}" [ alpha? ] }
|
||||||
|
{ "\\p{Punct}" [ punct? ] }
|
||||||
|
{ "\\p{Graph}" [ java-printable? ] }
|
||||||
|
{ "\\p{Print}" [ java-printable? ] }
|
||||||
|
{ "\\p{Blank}" [ " \t" member? ] }
|
||||||
|
{ "\\p{Cntrl}" [ control-char? ] }
|
||||||
|
{ "\\p{XDigit}" [ hex-digit? ] }
|
||||||
|
{ "\\p{Space}" [ java-blank? ] }
|
||||||
|
} [ first2 satisfy-token ] [ <|> ] map-reduce ;
|
||||||
|
|
||||||
|
: 'escape-seq' ( -- parser )
|
||||||
|
'simple-escape-char'
|
||||||
|
'predefined-char-class' <|>
|
||||||
|
'octal' <|>
|
||||||
|
'hex' <|>
|
||||||
|
'control-character' <|>
|
||||||
|
'posix-character-class' <|> ;
|
||||||
|
|
||||||
|
: 'char' 'escape-seq' 'ordinary-char' <|> ;
|
||||||
|
|
||||||
: 'string'
|
: 'string'
|
||||||
'char' <+> [
|
'char' <+> [ [ <&> ] reduce* ] <@ ;
|
||||||
[ dup quotation? [ satisfy ] [ 1token ] if ] [ <&> ] map-reduce
|
|
||||||
] <@ ;
|
|
||||||
|
|
||||||
: exactly-n ( parser n -- parser' )
|
: exactly-n ( parser n -- parser' )
|
||||||
swap <repetition> and-parser construct-boa ;
|
swap <repetition> and-parser construct-boa ;
|
||||||
|
@ -72,28 +161,30 @@ C: <group-result> group-result
|
||||||
[ dup ] swap compose [ drop t ] 2array
|
[ dup ] swap compose [ drop t ] 2array
|
||||||
] map { [ t ] [ drop f ] } add [ cond ] curry ;
|
] map { [ t ] [ drop f ] } add [ cond ] curry ;
|
||||||
|
|
||||||
: 'range'
|
: 'range' ( -- parser )
|
||||||
any-char-parser "-" token <& any-char-parser <&>
|
any-char-parser "-" token <& any-char-parser <&>
|
||||||
[ first2 [ between? ] 2curry ] <@ ;
|
[ first2 [ between? ] 2curry satisfy ] <@ ;
|
||||||
|
|
||||||
: 'character-class-contents'
|
: 'character-class-contents' ( -- parser )
|
||||||
'escaped-char'
|
'escape-seq'
|
||||||
'range' <|>
|
'range' <|>
|
||||||
[ "\\]" member? not ] satisfy <|> ;
|
[ "\\]" member? not ] satisfy [ 1satisfy ] <@ <|> ;
|
||||||
|
|
||||||
: 'character-class'
|
: make-character-class ( seq ? -- )
|
||||||
|
>r [ parser>predicate ] map predicates>cond r>
|
||||||
|
[ [ not ] compose ] when satisfy ;
|
||||||
|
|
||||||
|
: 'character-class' ( -- parser )
|
||||||
"[" token
|
"[" token
|
||||||
"^" token 'character-class-contents' <+> <&:>
|
"^" token 'character-class-contents' <+> &> [ t make-character-class ] <@
|
||||||
[ predicates>cond [ not ] compose satisfy ] <@
|
"]" token [ first 1satisfy ] <@ 'character-class-contents' <*> <&:>
|
||||||
"]" token [ first ] <@ 'character-class-contents' <*> <&:>
|
[ f make-character-class ] <@ <|>
|
||||||
[ predicates>cond satisfy ] <@ <|>
|
'character-class-contents' <+> [ f make-character-class ] <@ <|>
|
||||||
'character-class-contents' <+> [ predicates>cond satisfy ] <@ <|>
|
|
||||||
&>
|
&>
|
||||||
"]" token <& ;
|
"]" token <& ;
|
||||||
|
|
||||||
: 'term'
|
: 'term' ( -- parser )
|
||||||
'any-char'
|
'string'
|
||||||
'string' <|>
|
|
||||||
'grouping' <|>
|
'grouping' <|>
|
||||||
'character-class' <|>
|
'character-class' <|>
|
||||||
<+> [
|
<+> [
|
||||||
|
@ -101,7 +192,7 @@ C: <group-result> group-result
|
||||||
[ first ] [ and-parser construct-boa ] if
|
[ first ] [ and-parser construct-boa ] if
|
||||||
] <@ ;
|
] <@ ;
|
||||||
|
|
||||||
: 'interval'
|
: 'interval' ( -- parser )
|
||||||
'term' "{" token <& 'integer' <&> "}" token <& [ first2 exactly-n ] <@
|
'term' "{" token <& 'integer' <&> "}" token <& [ first2 exactly-n ] <@
|
||||||
'term' "{" token <& 'integer' <&> "," token <& "}" token <&
|
'term' "{" token <& 'integer' <&> "," token <& "}" token <&
|
||||||
[ first2 at-least-n ] <@ <|>
|
[ first2 at-least-n ] <@ <|>
|
||||||
|
@ -110,7 +201,7 @@ C: <group-result> group-result
|
||||||
'term' "{" token <& 'integer' <&> "," token <& 'integer' <:&> "}" token <&
|
'term' "{" token <& 'integer' <&> "," token <& 'integer' <:&> "}" token <&
|
||||||
[ first3 from-m-to-n ] <@ <|> ;
|
[ first3 from-m-to-n ] <@ <|> ;
|
||||||
|
|
||||||
: 'repetition'
|
: 'repetition' ( -- parser )
|
||||||
'term'
|
'term'
|
||||||
[ "*+?" member? ] satisfy <&> [
|
[ "*+?" member? ] satisfy <&> [
|
||||||
first2 {
|
first2 {
|
||||||
|
@ -148,3 +239,8 @@ M: object >regexp ;
|
||||||
: R" CHAR: " parse-regexp ; parsing
|
: R" CHAR: " parse-regexp ; parsing
|
||||||
: R' CHAR: ' parse-regexp ; parsing
|
: R' CHAR: ' parse-regexp ; parsing
|
||||||
: R` CHAR: ` parse-regexp ; parsing
|
: R` CHAR: ` parse-regexp ; parsing
|
||||||
|
|
||||||
|
! \Q \E
|
||||||
|
! Must escape to use as literals
|
||||||
|
! : meta-chars "[\\^$.|?*+()" ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue