X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Fregexp%2Fregexp.factor;h=42138d5c66e7792b109f2b1651837fa6e02e496f;hp=6ad6060dcf38dcf1dab23b344357c9c42e012ded;hb=2f59f72ed58809c266ad1d2a777be7285d246a06;hpb=80e1c8e3f27a6e928d740292dcfed008a0455571

diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index 6ad6060dcf..42138d5c66 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel kernel.private math sequences
-sequences.private strings sets assocs make lexer namespaces parser
-arrays fry locals regexp.parser splitting sorting regexp.ast
-regexp.negation regexp.compiler compiler.units words math.ranges ;
+USING: accessors arrays classes compiler.units kernel
+kernel.private lexer make math ranges namespaces quotations
+regexp.ast regexp.compiler regexp.negation regexp.parser
+sequences sequences.private splitting strings vocabs.loader
+words ;
 IN: regexp
 
 TUPLE: regexp
@@ -16,20 +17,18 @@ TUPLE: reverse-regexp < regexp ;
 
 <PRIVATE
 
-M: lookahead question>quot ! Returns ( index string -- ? )
-    term>> ast>dfa dfa>shortest-word '[ f _ execute ] ;
+M: lookahead question>quot
+    ! Returns ( index string -- ? )
+    term>> ast>dfa dfa>shortest-word 1quotation [ f ] prepose ;
 
 : <reversed-option> ( ast -- reversed )
     "r" string>options <with-options> ;
 
-M: lookbehind question>quot ! Returns ( index string -- ? )
+M: lookbehind question>quot
+    ! Returns ( index string -- ? )
     term>> <reversed-option>
     ast>dfa dfa>reverse-shortest-word
-    '[ [ 1 - ] dip f _ execute ] ;
-
-: check-string ( string -- string )
-    ! Make this configurable
-    dup string? [ "String required" throw ] unless ;
+    1quotation [ [ 1 - ] dip f ] prepose ;
 
 : match-index-from ( i string regexp -- index/f )
     ! This word is unsafe. It assumes that i is a fixnum
@@ -43,7 +42,7 @@ M: reverse-regexp end/start drop length 1 - -1 swap ;
 PRIVATE>
 
 : matches? ( string regexp -- ? )
-    [ check-string ] dip
+    [ string check-instance ] dip
     [ end/start ] 2keep
     match-index-from
     [ = ] [ drop f ] if* ;
@@ -51,7 +50,7 @@ PRIVATE>
 <PRIVATE
 
 : search-range ( i string reverse? -- seq )
-    [ drop -1 ] [ length ] if [a,b] ; inline
+    [ drop -1 ] [ length ] if [a..b] ; inline
 
 :: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
     i string regexp quot call dup
@@ -60,7 +59,7 @@ PRIVATE>
 :: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
     f f f
     i string reverse? search-range
-    [ [ 3drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
+    [ 3nip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
 
 : do-next-match ( i string regexp -- start end ? )
     dup next-match>>
@@ -92,7 +91,7 @@ M: regexp match-iterator-start 2drop 0 ;
 M: reverse-regexp match-iterator-start drop length ;
 
 : prepare-match-iterator ( string regexp -- i string regexp )
-    [ check-string ] dip [ match-iterator-start ] 2keep ; inline
+    [ string check-instance ] dip [ match-iterator-start ] 2keep ; inline
 
 PRIVATE>
 
@@ -103,7 +102,7 @@ PRIVATE>
     collector [ each-match ] dip >array ; inline
 
 : all-matching-slices ( string regexp -- seq )
-    [ slice boa ] map-matches ;
+    [ <slice-unsafe> ] map-matches ;
 
 : all-matching-subseqs ( string regexp -- seq )
     [ subseq ] map-matches ;
@@ -113,7 +112,7 @@ PRIVATE>
 
 <PRIVATE
 
-:: (re-split) ( string regexp quot -- new-slices )
+:: (re-split) ( string regexp quot: ( from to seq -- slice ) -- new-slices )
     0 string regexp [| end start end' string |
         end' ! leave it on the stack for the next iteration
         end start string quot call
@@ -126,18 +125,26 @@ PRIVATE>
 :: first-match ( string regexp -- slice/f )
     string regexp prepare-match-iterator do-next-match [
         regexp reverse-regexp? [ [ 1 + ] bi@ ] when
-        string slice boa
+        string <slice-unsafe>
     ] [ 2drop f ] if ;
 
 : re-contains? ( string regexp -- ? )
-    prepare-match-iterator do-next-match [ 2drop ] dip >boolean ;
+    prepare-match-iterator do-next-match 2nip >boolean ;
 
 : re-split ( string regexp -- seq )
-    [ slice boa ] (re-split) ;
+    [ <slice-unsafe> ] (re-split) ;
 
 : re-replace ( string regexp replacement -- result )
     [ [ subseq ] (re-split) ] dip join ;
 
+:: re-replace-with ( string regexp quot: ( slice -- replacement ) -- result )
+    [
+        0 string regexp [
+            drop [ [ string <slice-unsafe> , ] keep ] dip
+            [ string <slice-unsafe> quot call( x -- x ) , ] keep
+        ] each-match string [ length ] [ <slice-unsafe> ] bi ,
+    ] { } make concat ;
+
 <PRIVATE
 
 : get-ast ( regexp -- ast )
@@ -148,13 +155,13 @@ GENERIC: compile-regexp ( regex -- regexp )
 : regexp-initial-word ( i string regexp -- i/f )
     [ compile-regexp ] with-compilation-unit match-index-from ;
 
-M: regexp compile-regexp ( regexp -- regexp )
+M: regexp compile-regexp
     dup '[
         dup \ regexp-initial-word =
         [ drop _ get-ast ast>dfa dfa>word ] when
     ] change-dfa ;
 
-M: reverse-regexp compile-regexp ( regexp -- regexp )
+M: reverse-regexp compile-regexp
     t backwards? [ call-next-method ] with-variable ;
 
 DEFER: compile-next-match
@@ -189,51 +196,27 @@ PRIVATE>
 
 <PRIVATE
 
-! The following two should do some caching
-
-: find-regexp-syntax ( string -- prefix suffix )
-    {
-        { "R/ "  "/"  }
-        { "R! "  "!"  }
-        { "R\" " "\"" }
-        { "R# "  "#"  }
-        { "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 [
+            [ [ "\\/" member? ] find-from ] keep swap [
+                CHAR: \ = [ [ 2 + ] dip t ] [ f ] if
+            ] [
+                "Unterminated regexp" throw
+            ] if*
+        ] loop over [ subseq ] dip 1 +
     ] change-lexer-column ;
 
 : parse-noblank-token ( lexer -- str/f )
-    dup still-parsing-line? [ (parse-token) ] [ drop f ] if ;
+    dup still-parsing-line? [ (parse-raw) ] [ drop f ] if ;
 
-: parsing-regexp ( accum end -- accum )
-    lexer get [ take-until ] [ parse-noblank-token ] bi
+: parse-regexp ( accum -- accum )
+    lexer get [ take-until "\\/" "/" replace ] [ 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[ CHAR: ] parsing-regexp ;
-SYNTAX: R` CHAR: ` parsing-regexp ;
-SYNTAX: R{ CHAR: } parsing-regexp ;
-SYNTAX: R| CHAR: | parsing-regexp ;
-
-USE: vocabs.loader
+SYNTAX: R/ parse-regexp ;
+
 
 { "prettyprint" "regexp" } "regexp.prettyprint" require-when