From cba0a96c10acee02ea173330bead43a33db1a21f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 30 Mar 2016 21:07:43 -0700 Subject: [PATCH] regexp: one R/ syntax to rule them all, simpler this way. --- basis/globs/globs.factor | 2 +- .../combinators/combinators-tests.factor | 2 +- basis/regexp/prettyprint/prettyprint.factor | 4 +- basis/regexp/regexp-tests.factor | 10 +-- basis/regexp/regexp.factor | 34 +++------- basis/validators/validators.factor | 4 +- extra/metar/metar.factor | 68 +++++++++---------- extra/xkcd/xkcd.factor | 2 +- 8 files changed, 55 insertions(+), 71 deletions(-) diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index b712332419..285578073d 100644 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -7,7 +7,7 @@ strings system unicode.case ; IN: globs : not-path-separator ( -- sep ) - os windows? R! [^/\\]! R! [^/]! ? ; foldable + os windows? R/ [^\\/\\]/ R/ [^\\/]/ ? ; foldable EBNF: diff --git a/basis/regexp/combinators/combinators-tests.factor b/basis/regexp/combinators/combinators-tests.factor index 23583bdf26..cbc1fb3893 100644 --- a/basis/regexp/combinators/combinators-tests.factor +++ b/basis/regexp/combinators/combinators-tests.factor @@ -10,7 +10,7 @@ IN: regexp.combinators.tests { f f f } [ "food" "ibar" "ba" [ strings matches? ] tri@ ] unit-test : conj ( -- regexp ) - { R' .*a' R' b.*' } ; + { R/ .*a/ R/ b.*/ } ; { t } [ "bljhasflsda" conj matches? ] unit-test { f } [ "bsdfdfs" conj matches? ] unit-test diff --git a/basis/regexp/prettyprint/prettyprint.factor b/basis/regexp/prettyprint/prettyprint.factor index 176714be69..2405677b1f 100644 --- a/basis/regexp/prettyprint/prettyprint.factor +++ b/basis/regexp/prettyprint/prettyprint.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel make prettyprint.backend -prettyprint.custom regexp regexp.parser regexp.private ; +prettyprint.custom regexp regexp.parser splitting ; IN: regexp.prettyprint M: regexp pprint* [ [ - [ raw>> dup find-regexp-syntax swap % swap % % ] + [ raw>> "R/ " % % "/" % ] [ options>> options>string % ] bi ] "" make ] keep present-text ; diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2d981c8c2c..d03e37b7a6 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -60,7 +60,7 @@ IN: regexp-tests { t } [ "/" "\\/" matches? ] unit-test -{ t } [ "a" R' a'i matches? ] unit-test +{ t } [ "a" R/ a/i matches? ] unit-test { t } [ "" "a|b*|c+|d?" matches? ] unit-test { t } [ "a" "a|b*|c+|d?" matches? ] unit-test @@ -259,11 +259,11 @@ IN: regexp-tests ! Comment inside a regular expression { t } [ "ac" "a(?#boo)c" matches? ] unit-test -{ } [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval( -- ) ] unit-test +{ } [ "USING: regexp kernel ; R/ -{3}[+]{1,6}(?:!!)?\\s/ drop" eval( -- ) ] unit-test -{ } [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval( -- ) ] unit-test +{ } [ "USING: regexp kernel ; R/ (ftp|http|https):\\/\\/(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(\\/\\|\\/([\\w#!:.?+=&%@!\\-\\/]))?/ drop" eval( -- ) ] unit-test -{ } [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval( -- ) ] unit-test +{ } [ "USING: regexp kernel ; R/ \\*[^\s*][^*]*\\*/ drop" eval( -- ) ] unit-test { "ab" } [ "ab" "(a|ab)(bc)?" first-match >string ] unit-test { "abc" } [ "abc" "(a|ab)(bc)?" first-match >string ] unit-test @@ -349,7 +349,7 @@ unit-test { f } [ "foobxr" "foo(?=bar)" first-match ] unit-test ! Bug in parsing word -{ t } [ "a" R' a' matches? ] unit-test +{ t } [ "a" R/ a/ matches? ] unit-test ! Testing negation { f } [ "a" R/ (?~a)/ matches? ] unit-test diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 6c7699bce3..96867381ee 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -197,42 +197,26 @@ PRIVATE> compile-next-match suffix! ; PRIVATE> -SYNTAX: R! CHAR: ! parsing-regexp ; -SYNTAX: R# CHAR: # parsing-regexp ; -SYNTAX: R' CHAR: ' parsing-regexp ; -SYNTAX: R( CHAR: ) parsing-regexp ; -SYNTAX: R/ CHAR: / parsing-regexp ; -SYNTAX: R@ CHAR: @ parsing-regexp ; -SYNTAX: R| CHAR: | parsing-regexp ; +SYNTAX: R/ parse-regexp ; USE: vocabs.loader diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index 2ee6c28c53..2488f87ea7 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -62,11 +62,11 @@ IN: validators ! From http://www.regular-expressions.info/email.html 320 v-max-length "e-mail" - R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i + R/ [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}/i v-regexp ; : v-url ( str -- str ) - "URL" R' (?:ftp|http|https)://\S+' v-regexp ; + "URL" R/ (?:ftp|http|https):\\/\\/\S+/ v-regexp ; : v-captcha ( str -- str ) dup empty? [ "must remain blank" throw ] unless ; diff --git a/extra/metar/metar.factor b/extra/metar/metar.factor index 54c26dfab4..d9394cd7e6 100644 --- a/extra/metar/metar.factor +++ b/extra/metar/metar.factor @@ -277,16 +277,16 @@ CONSTANT: sky H{ unclip [ string>number ] [ CHAR: A = ] bi* [ 100 /f "%.2f Hg" sprintf ] [ "%s hPa" sprintf ] if ; -CONSTANT: re-timestamp R! \d{6}Z! -CONSTANT: re-station R! \w{4}! -CONSTANT: re-temperature R! [M]?\d{2}/([M]?\d{2})?! -CONSTANT: re-wind R! (VRB|\d{3})\d{2,3}(G\d{2,3})?KT! -CONSTANT: re-wind-variable R! \d{3}V\d{3}! -CONSTANT: re-visibility R! [MP]?\d+(/\d+)?SM! -CONSTANT: re-rvr R! R\d{2}[RLC]?/\d{4}(V\d{4})?FT! -CONSTANT: re-weather R! [+-]?(VC)?(\w{2}|\w{4})! -CONSTANT: re-sky-condition R! (\w{2,3}\d{3}(\w+)?|\w{3}|CAVOK)! -CONSTANT: re-altimeter R! [AQ]\d{4}! +CONSTANT: re-timestamp R/ \d{6}Z/ +CONSTANT: re-station R/ \w{4}/ +CONSTANT: re-temperature R/ [M]?\d{2}\\/([M]?\d{2})?/ +CONSTANT: re-wind R/ (VRB|\d{3})\d{2,3}(G\d{2,3})?KT/ +CONSTANT: re-wind-variable R/ \d{3}V\d{3}/ +CONSTANT: re-visibility R/ [MP]?\d+(\\/\d+)?SM/ +CONSTANT: re-rvr R/ R\d{2}[RLC]?\\/\d{4}(V\d{4})?FT/ +CONSTANT: re-weather R/ [+-]?(VC)?(\w{2}|\w{4})/ +CONSTANT: re-sky-condition R/ (\w{2,3}\d{3}(\w+)?|\w{3}|CAVOK)/ +CONSTANT: re-altimeter R/ [AQ]\d{4}/ : find-one ( seq quot: ( elt -- ? ) -- seq elt/f ) dupd find drop [ tail unclip ] [ f ] if* ; inline @@ -462,7 +462,7 @@ CONSTANT: high-clouds H{ : parse-lightning ( str -- str' ) "LTG" ?head drop 2 group [ lightning at ] map " " join ; -CONSTANT: re-recent-weather R! ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+! +CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/ : parse-began/ended ( str -- str' ) unclip swap @@ -512,27 +512,27 @@ CONSTANT: re-recent-weather R! ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+! : parse-remark ( str -- str' ) { { [ dup glossary key? ] [ glossary at ] } - { [ dup R! 1\d{4}! matches? ] [ parse-6hr-max-temp ] } - { [ dup R! 2\d{4}! matches? ] [ parse-6hr-min-temp ] } - { [ dup R! 4\d{8}! matches? ] [ parse-24hr-temp ] } - { [ dup R! 4/\d{3}! matches? ] [ parse-snow-depth ] } - { [ dup R! 5\d{4}! matches? ] [ parse-1hr-pressure ] } - { [ dup R! 6[\d/]{4}! matches? ] [ parse-6hr-precipitation ] } - { [ dup R! 7\d{4}! matches? ] [ parse-24hr-precipitation ] } - { [ dup R! 8/\d{3}! matches? ] [ parse-cloud-cover ] } - { [ dup R! 931\d{3}! matches? ] [ parse-6hr-snowfall ] } - { [ dup R! 933\d{3}! matches? ] [ parse-water-equivalent-snow ] } - { [ dup R! 98\d{3}! matches? ] [ parse-duration-of-sunshine ] } - { [ dup R! T\d{4,8}! matches? ] [ parse-1hr-temp ] } - { [ dup R! \d{3}\d{2,3}/\d{2,4}! matches? ] [ parse-peak-wind ] } - { [ dup R! P\d{4}! matches? ] [ parse-1hr-precipitation ] } - { [ dup R! SLP\d{3}! matches? ] [ parse-sea-level-pressure ] } - { [ dup R! LTG\w+! matches? ] [ parse-lightning ] } - { [ dup R! PROB\d+! matches? ] [ parse-probability ] } - { [ dup R! \d{3}V\d{3}! matches? ] [ parse-varying ] } - { [ dup R! [^-]+(-[^-]+)+! matches? ] [ parse-from-to ] } - { [ dup R! [^/]+(/[^/]+)+! matches? ] [ ] } - { [ dup R! \d+.\d+! matches? ] [ ] } + { [ dup R/ 1\d{4}/ matches? ] [ parse-6hr-max-temp ] } + { [ dup R/ 2\d{4}/ matches? ] [ parse-6hr-min-temp ] } + { [ dup R/ 4\d{8}/ matches? ] [ parse-24hr-temp ] } + { [ dup R/ 4\\/\d{3}/ matches? ] [ parse-snow-depth ] } + { [ dup R/ 5\d{4}/ matches? ] [ parse-1hr-pressure ] } + { [ dup R/ 6[\d\\/]{4}/ matches? ] [ parse-6hr-precipitation ] } + { [ dup R/ 7\d{4}/ matches? ] [ parse-24hr-precipitation ] } + { [ dup R/ 8\\/\d{3}/ matches? ] [ parse-cloud-cover ] } + { [ dup R/ 931\d{3}/ matches? ] [ parse-6hr-snowfall ] } + { [ dup R/ 933\d{3}/ matches? ] [ parse-water-equivalent-snow ] } + { [ dup R/ 98\d{3}/ matches? ] [ parse-duration-of-sunshine ] } + { [ dup R/ T\d{4,8}/ matches? ] [ parse-1hr-temp ] } + { [ dup R/ \d{3}\d{2,3}\\/\d{2,4}/ matches? ] [ parse-peak-wind ] } + { [ dup R/ P\d{4}/ matches? ] [ parse-1hr-precipitation ] } + { [ dup R/ SLP\d{3}/ matches? ] [ parse-sea-level-pressure ] } + { [ dup R/ LTG\w+/ matches? ] [ parse-lightning ] } + { [ dup R/ PROB\d+/ matches? ] [ parse-probability ] } + { [ dup R/ \d{3}V\d{3}/ matches? ] [ parse-varying ] } + { [ dup R/ [^-]+(-[^-]+)+/ matches? ] [ parse-from-to ] } + { [ dup R/ [^\\/]+(\\/[^\\/]+)+/ matches? ] [ ] } + { [ dup R/ \d+.\d+/ matches? ] [ ] } { [ dup re-recent-weather matches? ] [ parse-recent-weather ] } { [ dup re-weather matches? ] [ parse-weather ] } { [ dup re-sky-condition matches? ] [ parse-sky-condition ] } @@ -596,12 +596,12 @@ M: string metar. [ parse-altitude ] [ parse-wind ] bi* prepend "wind shear " prepend ; -CONSTANT: re-from-timestamp R! FM\d{6}! +CONSTANT: re-from-timestamp R/ FM\d{6}/ : parse-from-timestamp ( str -- str' ) "FM" ?head drop parse-timestamp ; -CONSTANT: re-valid-timestamp R! \d{4}\/\d{4}! +CONSTANT: re-valid-timestamp R/ \d{4}\/\d{4}/ : parse-valid-timestamp ( str -- str' ) "/" split1 [ "00" append parse-timestamp ] bi@ " to " glue ; diff --git a/extra/xkcd/xkcd.factor b/extra/xkcd/xkcd.factor index cafe3399ed..162945809a 100644 --- a/extra/xkcd/xkcd.factor +++ b/extra/xkcd/xkcd.factor @@ -13,7 +13,7 @@ IN: xkcd : comic-image ( url -- image ) http-get nip - R@ http://imgs\.xkcd\.com/comics/[^\.]+\.(png|jpg)@ + R/ http:\\/\\/imgs\.xkcd\.com\\/comics\\/[^\.]+\.(png|jpg)/ first-match >string load-http-image ; : comic-image. ( url -- )