From a019a64407a0d294f3311be99deab187dfe8e370 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 25 Nov 2007 03:51:30 -0600 Subject: [PATCH] initial checkin of regexps --- extra/regexp/regexp-tests.factor | 77 ++++++++++++++++++ extra/regexp/regexp.factor | 134 +++++++++++++++++++++++++++++++ 2 files changed, 211 insertions(+) create mode 100644 extra/regexp/regexp-tests.factor create mode 100644 extra/regexp/regexp.factor diff --git a/extra/regexp/regexp-tests.factor b/extra/regexp/regexp-tests.factor new file mode 100644 index 0000000000..597a4f5143 --- /dev/null +++ b/extra/regexp/regexp-tests.factor @@ -0,0 +1,77 @@ +USING: regexp tools.test ; +IN: regexp-tests + +[ f ] [ "b" "a*" matches? ] unit-test +[ t ] [ "" "a*" matches? ] unit-test +[ t ] [ "a" "a*" matches? ] unit-test +[ t ] [ "aaaaaaa" "a*" matches? ] unit-test +[ f ] [ "ab" "a*" matches? ] unit-test + +[ t ] [ "abc" "abc" matches? ] unit-test +[ t ] [ "a" "a|b|c" matches? ] unit-test +[ t ] [ "b" "a|b|c" matches? ] unit-test +[ t ] [ "c" "a|b|c" matches? ] unit-test +[ f ] [ "c" "d|e|f" matches? ] unit-test + +[ f ] [ "aa" "a|b|c" matches? ] unit-test +[ f ] [ "bb" "a|b|c" matches? ] unit-test +[ f ] [ "cc" "a|b|c" matches? ] unit-test +[ f ] [ "cc" "d|e|f" matches? ] unit-test + +[ f ] [ "" "a+" matches? ] unit-test +[ t ] [ "a" "a+" matches? ] unit-test +[ t ] [ "aa" "a+" matches? ] unit-test + +[ t ] [ "" "a?" matches? ] unit-test +[ t ] [ "a" "a?" matches? ] unit-test +[ f ] [ "aa" "a?" matches? ] unit-test + +[ f ] [ "" "." matches? ] unit-test +[ t ] [ "a" "." matches? ] unit-test +[ t ] [ "." "." matches? ] unit-test + +[ f ] [ "" ".+" matches? ] unit-test +[ t ] [ "a" ".+" matches? ] unit-test +[ t ] [ "ab" ".+" matches? ] unit-test + +[ t ] [ "" "a|b*|c+|d?" matches? ] unit-test +[ t ] [ "a" "a|b*|c+|d?" matches? ] unit-test +[ t ] [ "c" "a|b*|c+|d?" matches? ] unit-test +[ t ] [ "cc" "a|b*|c+|d?" matches? ] unit-test +[ f ] [ "ccd" "a|b*|c+|d?" matches? ] unit-test +[ t ] [ "d" "a|b*|c+|d?" matches? ] unit-test + +[ t ] [ "foo" "foo|bar" matches? ] unit-test +[ t ] [ "bar" "foo|bar" matches? ] unit-test +[ f ] [ "foobar" "foo|bar" matches? ] unit-test + +[ f ] [ "" "(a)" matches? ] unit-test +[ t ] [ "a" "(a)" matches? ] unit-test +[ f ] [ "aa" "(a)" matches? ] unit-test +[ t ] [ "aa" "(a*)" matches? ] unit-test + +[ f ] [ "aababaaabbac" "(a|b)+" matches? ] unit-test +[ t ] [ "ababaaabba" "(a|b)+" matches? ] unit-test + +[ f ] [ "" "a{1}" matches? ] unit-test +[ t ] [ "a" "a{1}" matches? ] unit-test +[ f ] [ "aa" "a{1}" matches? ] unit-test + +[ f ] [ "a" "a{2,}" matches? ] unit-test +[ t ] [ "aaa" "a{2,}" matches? ] unit-test +[ t ] [ "aaaa" "a{2,}" matches? ] unit-test +[ t ] [ "aaaaa" "a{2,}" matches? ] unit-test + +[ t ] [ "" "a{,2}" matches? ] unit-test +[ t ] [ "a" "a{,2}" matches? ] unit-test +[ t ] [ "aa" "a{,2}" matches? ] unit-test +[ f ] [ "aaa" "a{,2}" matches? ] unit-test +[ f ] [ "aaaa" "a{,2}" matches? ] unit-test +[ f ] [ "aaaaa" "a{,2}" matches? ] unit-test + +[ f ] [ "" "a{1,3}" matches? ] unit-test +[ t ] [ "a" "a{1,3}" matches? ] unit-test +[ t ] [ "aa" "a{1,3}" matches? ] unit-test +[ t ] [ "aaa" "a{1,3}" matches? ] unit-test +[ f ] [ "aaaa" "a{1,3}" matches? ] unit-test + diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor new file mode 100644 index 0000000000..c7abaada26 --- /dev/null +++ b/extra/regexp/regexp.factor @@ -0,0 +1,134 @@ +USING: combinators kernel lazy-lists math math.parser +namespaces parser parser-combinators promises sequences +strings ; +USING: continuations io prettyprint ; +IN: regexp + +: 'any-char' + "." token [ drop any-char-parser ] <@ ; + +: 'escaped-char' + "\\" token any-char-parser &> ; + +: 'ordinary-char' + [ "*+?|(){}" member? not ] satisfy ; + +: 'char' 'escaped-char' 'ordinary-char' <|> ; + +: 'string' 'char' <+> [ >string token ] <@ ; + +: 'integer' [ digit? ] satisfy <+> [ string>number ] <@ ; + +: exactly-n ( parser n -- parser' ) + swap and-parser construct-boa ; + +: 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 <&> ; + +DEFER: 'regexp' + +TUPLE: group-result str ; + +C: group-result + +: 'grouping' + "(" token + 'regexp' [ [ ] <@ ] <@ + ")" token <& &> ; + +: 'term' + 'any-char' + 'string' <|> + 'grouping' <|> + <+> [ + dup length 1 = + [ first ] [ and-parser construct-boa ] if + ] <@ ; + +: 'interval' + 'term' + "{" token + 'integer' &> + "," token <:&:> + 'integer' <:&:> + "}" token <& <&> [ + first2 dup length { + { 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' + 'term' + [ "*+?" member? ] satisfy <&> [ + first2 { + { CHAR: * [ <*> ] } + { CHAR: + [ <+> ] } + { CHAR: ? [ ] } + } case + ] <@ ; + +: 'simple' 'term' 'repetition' <|> 'interval' <|> ; + +LAZY: 'union' ( -- parser ) + 'simple' + 'simple' "|" token 'union' &> <&> [ first2 <|> ] <@ + <|> ; + +LAZY: 'regexp' ( -- parser ) + 'repetition' 'union' <|> ; + +: 'regexp' just parse-1 ; + + +GENERIC: >regexp ( obj -- parser ) +M: string >regexp 'regexp' just parse-1 ; +M: object >regexp ; + +: matches? ( string regexp -- ? ) >regexp just parse nil? not ; + +: parse-regexp ( accum end -- accum ) + lexer get dup skip-blank [ + [ index* dup 1+ swap ] 2keep swapd subseq swap + ] change-column parsed ; + +: 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