More regexp changes
parent
7f625f9836
commit
1fbfc88b90
|
@ -156,3 +156,7 @@ IN: regexp-tests
|
||||||
|
|
||||||
[ t ] [ "S" "\\0123" matches? ] unit-test
|
[ t ] [ "S" "\\0123" matches? ] unit-test
|
||||||
[ t ] [ "SXY" "\\0123XY" matches? ] unit-test
|
[ t ] [ "SXY" "\\0123XY" matches? ] unit-test
|
||||||
|
[ t ] [ "x" "\\x78" matches? ] unit-test
|
||||||
|
[ f ] [ "y" "\\x78" matches? ] unit-test
|
||||||
|
[ t ] [ "x" "\\u0078" matches? ] unit-test
|
||||||
|
[ f ] [ "y" "\\u0078" matches? ] unit-test
|
||||||
|
|
|
@ -7,23 +7,6 @@ IN: regexp
|
||||||
: or-predicates ( quots -- quot )
|
: or-predicates ( quots -- quot )
|
||||||
[ \ dup add* ] map [ [ t ] ] f short-circuit \ nip add ;
|
[ \ dup add* ] map [ [ t ] ] f short-circuit \ nip add ;
|
||||||
|
|
||||||
: exactly-n ( parser n -- parser' )
|
|
||||||
swap <repetition> <and-parser> ;
|
|
||||||
|
|
||||||
: at-most-n ( parser n -- parser' )
|
|
||||||
dup zero? [
|
|
||||||
2drop epsilon
|
|
||||||
] [
|
|
||||||
2dup exactly-n
|
|
||||||
-rot 1- at-most-n <|>
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: at-least-n ( parser n -- parser' )
|
|
||||||
dupd exactly-n swap <*> <&> ;
|
|
||||||
|
|
||||||
: from-m-to-n ( parser m n -- parser' )
|
|
||||||
>r [ exactly-n ] 2keep r> swap - at-most-n <&> ;
|
|
||||||
|
|
||||||
: octal-digit? ( n -- ? ) CHAR: 0 CHAR: 7 between? ;
|
: octal-digit? ( n -- ? ) CHAR: 0 CHAR: 7 between? ;
|
||||||
|
|
||||||
: decimal-digit? ( n -- ? ) CHAR: 0 CHAR: 9 between? ;
|
: decimal-digit? ( n -- ? ) CHAR: 0 CHAR: 9 between? ;
|
||||||
|
@ -58,24 +41,25 @@ MACRO: fast-member? ( str -- quot )
|
||||||
[ "\\^*+?|(){}[" fast-member? not ] satisfy
|
[ "\\^*+?|(){}[" fast-member? not ] satisfy
|
||||||
[ [ = ] curry ] <@ ;
|
[ [ = ] curry ] <@ ;
|
||||||
|
|
||||||
: 'octal-digit' ( -- parser )
|
: 'octal-digit' ( -- parser ) [ octal-digit? ] satisfy ;
|
||||||
[ octal-digit? ] satisfy ;
|
|
||||||
|
|
||||||
: 'octal' ( -- parser )
|
: 'octal' ( -- parser )
|
||||||
"0" token
|
"0" token 'octal-digit' 1 3 from-m-to-n &>
|
||||||
'octal-digit' 3 exactly-n
|
[ oct> ] <@ ;
|
||||||
'octal-digit' 1 2 from-m-to-n <|>
|
|
||||||
&> [ oct> [ = ] curry ] <@ ;
|
|
||||||
|
|
||||||
: 'hex-digit' ( -- parser ) [ hex-digit? ] satisfy ;
|
: 'hex-digit' ( -- parser ) [ hex-digit? ] satisfy ;
|
||||||
|
|
||||||
: 'hex' ( -- parser )
|
: 'hex' ( -- parser )
|
||||||
"x" token 'hex-digit' 2 exactly-n &>
|
"x" token 'hex-digit' 2 exactly-n &>
|
||||||
"u" token 'hex-digit' 4 exactly-n &> <|>
|
"u" token 'hex-digit' 4 exactly-n &> <|>
|
||||||
[ hex> [ = ] curry ] <@ ;
|
[ hex> ] <@ ;
|
||||||
|
|
||||||
: 'control-character' ( -- parser )
|
: 'control-character' ( -- parser )
|
||||||
"c" token [ LETTER? ] satisfy [ [ = ] curry ] <@ &> ;
|
"c" token [ LETTER? ] satisfy &> ;
|
||||||
|
|
||||||
|
: 'simple-escape' ( -- parser )
|
||||||
|
'octal' 'hex' 'control-character' <|> <|>
|
||||||
|
[ [ = ] curry ] <@ ;
|
||||||
|
|
||||||
: satisfy-tokens ( assoc -- parser )
|
: satisfy-tokens ( assoc -- parser )
|
||||||
[ >r token r> [ nip ] curry <@ ] { } assoc>map <or-parser> ;
|
[ >r token r> [ nip ] curry <@ ] { } assoc>map <or-parser> ;
|
||||||
|
@ -120,11 +104,9 @@ MACRO: fast-member? ( str -- quot )
|
||||||
|
|
||||||
: 'escape' ( -- parser )
|
: 'escape' ( -- parser )
|
||||||
"\\" token
|
"\\" token
|
||||||
'simple-escape-char'
|
'simple-escape'
|
||||||
|
'simple-escape-char' <|>
|
||||||
'predefined-char-class' <|>
|
'predefined-char-class' <|>
|
||||||
'octal' <|>
|
|
||||||
'hex' <|>
|
|
||||||
'control-character' <|>
|
|
||||||
'posix-character-class' <|> &> ;
|
'posix-character-class' <|> &> ;
|
||||||
|
|
||||||
: 'any-char' "." token [ drop [ drop t ] ] <@ ;
|
: 'any-char' "." token [ drop [ drop t ] ] <@ ;
|
||||||
|
@ -132,7 +114,8 @@ MACRO: fast-member? ( str -- quot )
|
||||||
: 'char'
|
: 'char'
|
||||||
'any-char' 'escape' 'ordinary-char' <|> <|> [ satisfy ] <@ ;
|
'any-char' 'escape' 'ordinary-char' <|> <|> [ satisfy ] <@ ;
|
||||||
|
|
||||||
: 'string' 'char' <+> [ <and-parser> ] <@ ;
|
: 'string'
|
||||||
|
'char' <+> [ <and-parser> ] <@ ;
|
||||||
|
|
||||||
DEFER: 'regexp'
|
DEFER: 'regexp'
|
||||||
|
|
||||||
|
@ -183,16 +166,11 @@ C: <group-result> group-result
|
||||||
'term' 'integer' "," token <& 'integer' <&> "{" "}" surrounded-by <&> [ first2 first2 from-m-to-n ] <@ <|> ;
|
'term' 'integer' "," token <& 'integer' <&> "{" "}" surrounded-by <&> [ first2 first2 from-m-to-n ] <@ <|> ;
|
||||||
|
|
||||||
: 'repetition' ( -- parser )
|
: 'repetition' ( -- parser )
|
||||||
'term'
|
'term' "*" token <& [ <*> ] <@
|
||||||
[ "*+?" member? ] satisfy <&> [
|
'term' "+" token <& [ <+> ] <@ <|>
|
||||||
first2 {
|
'term' "?" token <& [ <?> ] <@ <|> ;
|
||||||
{ CHAR: * [ <*> ] }
|
|
||||||
{ CHAR: + [ <+> ] }
|
|
||||||
{ CHAR: ? [ <?> ] }
|
|
||||||
} case
|
|
||||||
] <@ ;
|
|
||||||
|
|
||||||
: 'simple' 'term' 'repetition' <|> 'interval' <|> ;
|
: 'simple' 'term' 'repetition' 'interval' <|> <|> ;
|
||||||
|
|
||||||
LAZY: 'union' ( -- parser )
|
LAZY: 'union' ( -- parser )
|
||||||
'simple'
|
'simple'
|
||||||
|
|
Loading…
Reference in New Issue