steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Before character-class

release
Doug Coleman 2007-11-26 12:59:04 -06:00
parent a9c683be10
commit 56039876bc
1 changed files with 21 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
extra/regexp/regexp.factor
View File

@ -1,21 +1,30 @@
USING: combinators kernel lazy-lists math math.parser USING: arrays combinators kernel lazy-lists math math.parser
namespaces parser parser-combinators parser-combinators.simple namespaces parser parser-combinators parser-combinators.simple
promises sequences strings ; promises sequences sequences.lib strings ;
USING: continuations io prettyprint ; USING: continuations io prettyprint ;
IN: regexp IN: regexp
: 'any-char' : 'any-char'
"." token [ drop any-char-parser ] <@ ; "." token [ drop any-char-parser ] <@ ;
: escaped-char
{
{ CHAR: d [ [ digit? ] satisfy ] }
{ CHAR: D [ [ digit? not ] satisfy ] }
{ CHAR: s [ [ blank? ] satisfy ] }
{ CHAR: S [ [ blank? not ] satisfy ] }
[ ]
} case ;
: 'escaped-char' : 'escaped-char'
"\\" token any-char-parser &> ; "\\" token any-char-parser &> [ escaped-char ] <@ ;
: 'ordinary-char' : 'ordinary-char'
[ "*+?|(){}" member? not ] satisfy ; [ "^*+?|(){}[]" member? not ] satisfy [ 1string token ] <@ ;
: 'char' 'escaped-char' 'ordinary-char' <|> ; : 'char' 'escaped-char' 'ordinary-char' <|> ;
: 'string' 'char' <+> [ >string token ] <@ ; : 'string' 'char' <+> [ [ <&> ] reduce* ] <@ ;
: exactly-n ( parser n -- parser' ) : exactly-n ( parser n -- parser' )
swap <repetition> and-parser construct-boa ; swap <repetition> and-parser construct-boa ;
@ -55,41 +64,13 @@ C: <group-result> group-result
] <@ ; ] <@ ;
: 'interval' : 'interval'
'term' 'term' "{" token <& 'integer' <&> "}" token <& [ first2 exactly-n ] <@
"{" token 'term' "{" token <& 'integer' <&> "," token <& "}" token <&
'integer' <?> &> [ first2 at-least-n ] <@ <|>
"," token <?> <:&:> 'term' "{" token <& "," token <& 'integer' <&> "}" token <&
'integer' <?> <:&:> [ first2 at-most-n ] <@ <|>
"}" token <& <&> [ 'term' "{" token <& 'integer' <&> "," token <& 'integer' <:&> "}" token <&
first2 dup length { [ first3 from-m-to-n ] <@ <|> ;
{ 1 [ first exactly-n ] }
{ 2 [ first2 dup integer?
[ nip at-most-n ]
[ drop at-least-n ] if ] }
{ 3 [ first3 nip from-m-to-n ] }
} case
] <@ ;
: 'character-range'
any-char-parser "-" token <& any-char-parser &> ;
: 'character-class-inside'
any-char-parser
'character-range' <|> ;
: 'character-class-inclusive'
"[" token
'character-class-inside'
"]" token ;
: 'character-class-exclusive'
"[^" token
'character-class-inside'
"]" token ;
: 'character-class'
'character-class-inclusive'
'character-class-exclusive' <|> ;
: 'repetition' : 'repetition'
'term' 'term'
@ -113,7 +94,6 @@ LAZY: 'regexp' ( -- parser )
: <regexp> 'regexp' just parse-1 ; : <regexp> 'regexp' just parse-1 ;
GENERIC: >regexp ( obj -- parser ) GENERIC: >regexp ( obj -- parser )
M: string >regexp 'regexp' just parse-1 ; M: string >regexp 'regexp' just parse-1 ;
M: object >regexp ; M: object >regexp ;