fix `regexp-match' performance for short matches on long strings

More specifically, for a string of length N and a match that
only looks at the first M characters, the complexity of
`regexp-match' is now O(M) instead of O(N). This allows
`regexp-split' to be O(N) for a string instead of O(N^2).

Also, fixed a bug in non-greedy matching that could affect
both long strings and input ports.

Author: mflatt

collects/tests/racket/rx.rktl

@@ -256,13 +256,36 @@
 ;; CL-PPCRE, which probably is from Perl originally. 
 ;; The tests have been modified to avoid various incompatibilities.
 
+(define (make-reluctant-port bstr)
+  ;; Handing out a single character at a time stresses
+  ;; the regexp matcher's lazy reading of a port:
+  (define pos 0)
+  (define len (bytes-length bstr))
+  (make-input-port
+   'reluctant-bytes
+   (lambda (s)
+     (if (pos . >= . len)
+         eof
+         (begin
+           (bytes-set! s 0 (bytes-ref bstr pos))
+           (set! pos (add1 pos))
+           1)))
+   (lambda (s skip evt)
+     (if ((+ pos skip) . >= . len)
+         eof
+         (begin
+           (bytes-set! s 0 (bytes-ref bstr (+ pos skip)))
+           1)))
+   void))
+
 (map (lambda (t)
        (if (pair? t)
 	   (begin
 	     (test (caddr t) regexp-match (byte-pregexp (car t)) (cadr t))
 	     (test (caddr t) regexp-match (byte-pregexp (car t)) (bytes-append #"xxxxxxxxxx" (cadr t)) 10)
 	     (test (caddr t) regexp-match (byte-pregexp (car t)) (bytes-append (cadr t) #"xxxxxxxxxx") 0 (bytes-length (cadr t)))
 	     (test (caddr t) regexp-match (byte-pregexp (car t)) (open-input-bytes (cadr t)))
+	     (test (caddr t) regexp-match (byte-pregexp (car t)) (make-reluctant-port (cadr t)))
 	     (test (and (caddr t)
 			(map (lambda (v)
 			       (and v (bytes->string/latin-1 v)))

collects/tests/racket/string.rktl

@@ -289,4 +289,22 @@
   (test "x y" string-join '("x" "y") " ")
   (test "x"   string-join '("x") " "))
 
+;; String splitting can take longer than byte-string splitting,
+;;  but it should have the same computational complexity.
+(let ()
+  (define N 100000)
+  (define-values (b bcpu breal bgc) 
+    (time-apply
+     (lambda () (regexp-split #rx#"." (make-bytes N)))
+     null))
+  (define-values (s scpu sreal sgc) 
+    (time-apply
+     (lambda () (regexp-split #rx"." (make-string N)))
+     null))
+  (test #f
+        'split
+        (and ((* 100 (- bcpu bgc)) . < . (- scpu sgc))
+             "suspiciously long time for regexp string split")))
+
+
 (report-errs)

src/racket/src/mzmark_regexp.inc

@@ -43,6 +43,7 @@ static int mark_regwork_MARK(void *p, struct NewGC *gc) {
   gcMARK2(r->counters, gc);
   gcMARK2(r->peekskip, gc);
   gcMARK2(r->prefix, gc);
+  gcMARK2(r->lazy_string, gc);
   gcMARK2(r->rewind_stack, gc);
   return
   gcBYTES_TO_WORDS(sizeof(Regwork));
@@ -60,6 +61,7 @@ static int mark_regwork_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(r->counters, gc);
   gcFIXUP2(r->peekskip, gc);
   gcFIXUP2(r->prefix, gc);
+  gcFIXUP2(r->lazy_string, gc);
   gcFIXUP2(r->rewind_stack, gc);
   return
   gcBYTES_TO_WORDS(sizeof(Regwork));
@@ -69,3 +71,28 @@ static int mark_regwork_FIXUP(void *p, struct NewGC *gc) {
 #define mark_regwork_IS_CONST_SIZE 1
 
 
+static int mark_lazy_string_SIZE(void *p, struct NewGC *gc) {
+  return
+  gcBYTES_TO_WORDS(sizeof(rx_lazy_str_t));
+}
+
+static int mark_lazy_string_MARK(void *p, struct NewGC *gc) {
+  rx_lazy_str_t *ls = (rx_lazy_str_t *)p;
+  gcMARK2(ls->s, gc);
+  gcMARK2(ls->chars, gc);
+  return
+  gcBYTES_TO_WORDS(sizeof(rx_lazy_str_t));
+}
+
+static int mark_lazy_string_FIXUP(void *p, struct NewGC *gc) {
+  rx_lazy_str_t *ls = (rx_lazy_str_t *)p;
+  gcFIXUP2(ls->s, gc);
+  gcFIXUP2(ls->chars, gc);
+  return
+  gcBYTES_TO_WORDS(sizeof(rx_lazy_str_t));
+}
+
+#define mark_lazy_string_IS_ATOMIC 0
+#define mark_lazy_string_IS_CONST_SIZE 1
+
+

src/racket/src/mzmarksrc.c

@@ -2177,11 +2177,21 @@ mark_regwork {
   gcMARK2(r->counters, gc);
   gcMARK2(r->peekskip, gc);
   gcMARK2(r->prefix, gc);
+  gcMARK2(r->lazy_string, gc);
   gcMARK2(r->rewind_stack, gc);
  size:
   gcBYTES_TO_WORDS(sizeof(Regwork));
 }
 
+mark_lazy_string {
+ mark:
+  rx_lazy_str_t *ls = (rx_lazy_str_t *)p;
+  gcMARK2(ls->s, gc);
+  gcMARK2(ls->chars, gc);
+ size:
+  gcBYTES_TO_WORDS(sizeof(rx_lazy_str_t));
+}
+
 END regexp;
 
 /**********************************************************************/