]> gitweb.factorcode.org Git - factor.git/commitdiff
regexp: one R/ syntax to rule them all, simpler this way.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 31 Mar 2016 04:07:43 +0000 (21:07 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 31 Mar 2016 04:09:08 +0000 (21:09 -0700)
basis/globs/globs.factor
basis/regexp/combinators/combinators-tests.factor
basis/regexp/prettyprint/prettyprint.factor
basis/regexp/regexp-tests.factor
basis/regexp/regexp.factor
basis/validators/validators.factor
extra/metar/metar.factor
extra/xkcd/xkcd.factor

index b712332419d8ba7ada0a274a7b5606755b24d334..285578073d88c3842620a41f393b23947cdefae3 100644 (file)
@@ -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: <glob>
 
index 23583bdf26a91907528a039be70679d9a9a6b7bc..cbc1fb389380eb49bb795debd768f35fb7e35cde 100644 (file)
@@ -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.*' } <and> ;
+    { R/ .*a/ R/ b.*/ } <and> ;
 
 { t } [ "bljhasflsda" conj matches? ] unit-test
 { f } [ "bsdfdfs" conj matches? ] unit-test
index 176714be697dd389551ad16fcf10573a53cd82c8..2405677b1f851c8014912a6db389af026309927d 100644 (file)
@@ -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 ;
index 2d981c8c2ca7edc9fc8206d935bdf3a92e9edb12..d03e37b7a6b1801e1b7177a8ffaa8d7bb908543c 100644 (file)
@@ -60,7 +60,7 @@ IN: regexp-tests
 
 { t } [ "/" "\\/" <regexp> matches? ] unit-test
 
-{ t } [ "a" R' a'i matches? ] unit-test
+{ t } [ "a" R/ a/i matches? ] unit-test
 
 { t } [ "" "a|b*|c+|d?" <regexp> matches? ] unit-test
 { t } [ "a" "a|b*|c+|d?" <regexp> matches? ] unit-test
@@ -259,11 +259,11 @@ IN: regexp-tests
 ! Comment inside a regular expression
 { t } [ "ac" "a(?#boo)c" <regexp> 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)?" <regexp> first-match >string ] unit-test
 { "abc" } [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
@@ -349,7 +349,7 @@ unit-test
 { f } [ "foobxr" "foo(?=bar)" <regexp> 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
index 6c7699bce3b54135ba86cccdeacd51b79b727846..96867381ee3e264c2ff8e738f7727d38becdedb1 100644 (file)
@@ -197,42 +197,26 @@ PRIVATE>
 
 <PRIVATE
 
-! The following two should do some caching
-
-: find-regexp-syntax ( string -- prefix suffix )
-    {
-        { "R/ "  "/"  }
-        { "R! "  "!"  }
-        { "R# "  "#"  }
-        { "R' "  "'"  }
-        { "R( "  ")"  }
-        { "R@ "  "@"  }
-        { "R| "  "|"  }
-    } swap [ subseq? not nip ] curry assoc-find drop ;
-
-: take-until ( end lexer -- string )
+: take-until ( lexer -- string )
     dup skip-blank [
-        [ index-from ] 2keep
-        [ swapd subseq ]
-        [ 2drop 1 + ] 3bi
+        dupd [
+            [ CHAR: / -rot index-from ] keep
+            over [ "Unterminated regexp" throw ] unless
+            2dup [ 1 - ] dip nth CHAR: \\ =
+            [ [ [ 1 + ] dip ] when ] keep
+        ] loop over [ subseq ] dip 1 +
     ] change-lexer-column ;
 
 : parse-noblank-token ( lexer -- str/f )
     dup still-parsing-line? [ (parse-token) ] [ drop f ] if ;
 
-: parsing-regexp ( accum end -- accum )
+: parse-regexp ( accum -- accum )
     lexer get [ take-until ] [ parse-noblank-token ] bi
     <optioned-regexp> 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
 
index 2ee6c28c53bdad994497fe0144150b42c551b1f0..2488f87ea70246bd50a35055d309f47d1dfd872e 100644 (file)
@@ -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 ;
index 54c26dfab46320c32613604890cf690b1514529f..d9394cd7e6f41a4dbaece3648c062674556e36b9 100644 (file)
@@ -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 ;
index cafe3399ed999d9bfb744904b66d3c5976dec8b8..162945809ad67d4ced6f9cc6c1ed118b5a7cdbd2 100644 (file)
@@ -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 -- )