Rename REPEAT> to ** and REPEAT< to **? and allow single limit.

diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm
index 7f0a3394d09592d2028103f000b1c38e56651db6..518dbef7faa1b41a0de0b3bf3977ec8797c86426 100644 (file)
--- a/src/runtime/regsexp.scm
+++ b/src/runtime/regsexp.scm
@@ -142,11 +142,11 @@ USA.
 
 (define-rule '(+ FORM)
   (lambda (regsexp)
-    (%compile-regsexp `(REPEAT> 1 #F ,regsexp))))
+    (%compile-regsexp `(** 1 #F ,regsexp))))
 
 (define-rule '(+? FORM)
   (lambda (regsexp)
-    (%compile-regsexp `(REPEAT< 1 #F ,regsexp))))
+    (%compile-regsexp `(**? 1 #F ,regsexp))))
 
 (define-rule '(CHAR-SET * DATUM)
   (lambda items
@@ -177,28 +177,39 @@ USA.
   (lambda (regsexp)
     (insn:*? (%compile-regsexp regsexp))))
 
-(define-rule '(REPEAT> DATUM DATUM FORM)
+(define-rule '(** DATUM FORM)
+  (lambda (n regsexp)
+    (check-repeat-1-arg n)
+    (insn:** n n (%compile-regsexp regsexp))))
+
+(define-rule '(**? DATUM FORM)
+  (lambda (n regsexp)
+    (check-repeat-1-arg n)
+    (insn:**? n n (%compile-regsexp regsexp))))
+
+(define (check-repeat-1-arg n)
+  (if (not (exact-nonnegative-integer? n))
+      (error "Repeat limit must be non-negative integer:" n)))
+
+(define-rule '(** DATUM DATUM FORM)
   (lambda (n m regsexp)
-    (check-repeat-args n m)
-    (insn:repeat> n m (%compile-regsexp regsexp))))
+    (check-repeat-2-args n m)
+    (insn:** n m (%compile-regsexp regsexp))))
 
-(define-rule '(REPEAT< DATUM DATUM FORM)
+(define-rule '(**? DATUM DATUM FORM)
   (lambda (n m regsexp)
-    (check-repeat-args n m)
-    (insn:repeat< n m (%compile-regsexp regsexp))))
+    (check-repeat-2-args n m)
+    (insn:**? n m (%compile-regsexp regsexp))))
 
-(define (check-repeat-args n m)
-  (if (not n)
-      (error "Repeat lower limit may not be #F"))
+(define (check-repeat-2-args n m)
   (if (not (exact-nonnegative-integer? n))
       (error "Repeat limit must be non-negative integer:" n))
-  (guarantee-exact-nonnegative-integer n 'COMPILE-REGSEXP)
   (if m
       (begin
        (if (not (exact-nonnegative-integer? m))
            (error "Repeat limit must be non-negative integer:" m))
        (if (not (<= n m))
-           (error "Repeat upper limit greater than lower limit:" n m)))))
+           (error "Repeat lower limit greater than upper limit:" n m)))))
 
 (define-rule '(ALT * FORM)
   (lambda regsexps
@@ -385,11 +396,23 @@ USA.
        groups
        (lambda () (s2 position groups fail)))))
 \f
-(define (insn:repeat> n m insn)
-  (%repeat n m insn %repeat>-limited insn:*))
-
-(define (insn:repeat< n m insn)
-  (%repeat n m insn %repeat<-limited insn:*?))
+(define (insn:** n m insn)
+  (%repeat n m insn
+          (lambda (limit insn)
+            (%hybrid-chain limit
+                           (lambda (succeed)
+                             (lambda (continue)
+                               (%failure-chain (insn continue) succeed)))))
+          insn:*))
+
+(define (insn:**? n m insn)
+  (%repeat n m insn
+          (lambda (limit insn)
+            (%hybrid-chain limit
+                           (lambda (succeed)
+                             (lambda (continue)
+                               (%failure-chain succeed (insn continue))))))
+          insn:*?))
 
 (define (%repeat n m insn repeat-limited repeat-unlimited)
   (let ((insn1 (%repeat-exactly n insn))
@@ -406,18 +429,6 @@ USA.
                   succeed
                   insn)))
 
-(define (%repeat>-limited limit insn)
-  (%hybrid-chain limit
-                (lambda (succeed)
-                  (lambda (continue)
-                    (%failure-chain (insn continue) succeed)))))
-
-(define (%repeat<-limited limit insn)
-  (%hybrid-chain limit
-                (lambda (succeed)
-                  (lambda (continue)
-                    (%failure-chain succeed (insn continue))))))
-
 (define (%hybrid-chain limit linker)
   (if (<= limit 8)
       (%immediate-chain limit linker)

diff --git a/tests/runtime/test-regsexp.scm b/tests/runtime/test-regsexp.scm
index 963dc8374d642f78ef5478bc74f494b8f2df26cd..dcd832362b0810b3e9b931c75719f9b19deda04a 100644 (file)
--- a/tests/runtime/test-regsexp.scm
+++ b/tests/runtime/test-regsexp.scm
@@ -84,50 +84,56 @@ USA.
     (list
      (equivalents '(0 0 0 0 0 0)
                  ""
-                 '(repeat> 0 0 "a")
-                 '(repeat< 0 0 "a")
+                 '(** 0 "a")
+                 '(** 0 0 "a")
+                 '(**? 0 "a")
+                 '(**? 0 0 "a")
                  '(seq "" ""))
 
      (equivalents '(#f 1 #f 1 #f 1)
                  "a"
-                 '(repeat> 1 1 "a")
-                 '(repeat< 1 1 "a")
+                 '(** 1 "a")
+                 '(** 1 1 "a")
+                 '(**? 1 "a")
+                 '(**? 1 1 "a")
                  '(seq "a" "")
                  '(seq "" "a"))
 
      (equivalents '(#f #f #f #f #f 2)
                  "aa"
-                 '(repeat> 2 2 "a")
-                 '(repeat< 2 2 "a")
+                 '(** 2 "a")
+                 '(** 2 2 "a")
+                 '(**? 2 "a")
+                 '(**? 2 2 "a")
                  '(seq "a" "a")
                  '(seq "aa" "")
                  '(seq "" "aa"))
 
      (equivalents '(0 1 0 1 0 2)
                  '(* "a")
-                 '(repeat> 0 #f "a"))
+                 '(** 0 #f "a"))
 
      (equivalents '(0 0 0 0 0 0)
                  '(*? "a")
-                 '(repeat< 0 #f "a"))
+                 '(**? 0 #f "a"))
 
      (equivalents '(#f 1 #f 1 #f 2)
                  '(+ "a")
                  '(seq "a" (* "a"))
-                 '(repeat> 1 #f "a"))
+                 '(** 1 #f "a"))
 
      (equivalents '(#f 1 #f 1 #f 1)
                  '(+? "a")
                  '(seq "a" (*? "a"))
-                 '(repeat< 1 #f "a"))
+                 '(**? 1 #f "a"))
 
      (equivalents '(0 1 0 1 0 1)
                  '(? "a")
-                 '(repeat> 0 1 "a"))
+                 '(** 0 1 "a"))
 
      (equivalents '(0 0 0 0 0 0)
                  '(?? "a")
-                 '(repeat< 0 1 "a")))))
+                 '(**? 0 1 "a")))))
 \f
 (define-test 'more-repeat-tests
   (list
@@ -137,17 +143,17 @@ USA.
    (match-string-test '(seq (?? "a") "a") "aab" '(1))
    (match-string-test '(seq (?? "a") "ab") "aab" '(3))
 
-   (match-string-test '(repeat> 1 2 "a") "aab" '(2))
-   (match-string-test '(seq (repeat> 1 2 "a") "b") "aab" '(3))
+   (match-string-test '(** 1 2 "a") "aab" '(2))
+   (match-string-test '(seq (** 1 2 "a") "b") "aab" '(3))
 
-   (match-string-test '(repeat< 1 2 "a") "aab" '(1))
-   (match-string-test '(seq (repeat< 1 2 "a") "b") "aab" '(3))
+   (match-string-test '(**? 1 2 "a") "aab" '(1))
+   (match-string-test '(seq (**? 1 2 "a") "b") "aab" '(3))
 
-   (match-string-test '(repeat> 1 3 "a") "aaab" '(3))
-   (match-string-test '(seq (repeat> 1 3 "a") "b") "aaab" '(4))
+   (match-string-test '(** 1 3 "a") "aaab" '(3))
+   (match-string-test '(seq (** 1 3 "a") "b") "aaab" '(4))
 
-   (match-string-test '(repeat< 1 3 "a") "aaab" '(1))
-   (match-string-test '(seq (repeat< 1 3 "a") "b") "aaab" '(4))
+   (match-string-test '(**? 1 3 "a") "aaab" '(1))
+   (match-string-test '(seq (**? 1 3 "a") "b") "aaab" '(4))
 
    (match-string-test '(seq (group foo (? "a")) "a") "aab" '(2 (foo 0 1)))
    (match-string-test '(seq (group foo (? "a")) "ab") "aab" '(3 (foo 0 1)))
@@ -297,39 +303,39 @@ USA.
               "cd"
               (string-end))
          ("aabcccd" 7 (x 0 1)))
-        ((seq (repeat> 1 1 "a") "b")
+        ((seq (** 1 "a") "b")
          "ab")
-        ((seq (repeat> 1 #f "a") "b")
+        ((seq (** 1 #f "a") "b")
          "ab")
-        ((seq (repeat> 1 2 "a") "b")
+        ((seq (** 1 2 "a") "b")
          "aab")
-        ((seq "a" (repeat> 0 0 "b") "c")
+        ((seq "a" (** 0 "b") "c")
          "ac"
          ("abc" #f))
-        ((seq "a" (repeat> 0 1 "b") "c")
+        ((seq "a" (** 0 1 "b") "c")
          "ac"
          "abc"
          ("abbc" #f))
-        ((seq "a" (repeat> 0 3 "b") "c")
+        ((seq "a" (** 0 3 "b") "c")
          "ac"
          "abc"
          "abbc"
          "abbbc"
          ("abbbbc" #f))
-        ((seq "a" (repeat> 1 0 "b") "c")
+        ((seq "a" (** 1 0 "b") "c")
          ("ac" pattern-error))
-        ((seq "a" (repeat> #f 1 "b") "c")
+        ((seq "a" (** #f 1 "b") "c")
          ("ac" pattern-error))
-        ((seq "a" (repeat> 1 1 "b") "c")
+        ((seq "a" (** 1 "b") "c")
          ("ac" #f)
          "abc")
-        ((seq "a" (repeat> 1 3 "b") "c")
+        ((seq "a" (** 1 3 "b") "c")
          ("ac" #f)
          "abc")
-        ((seq "a" (repeat> 2 2 "b") "c")
+        ((seq "a" (** 2 "b") "c")
          ("abc" #f)
          "abbc")
-        ((seq "a" (repeat> 2 4 "b") "c")
+        ((seq "a" (** 2 4 "b") "c")
          ("abcabbc" #f))
         ((seq "a"
               (? (group x "b"))
@@ -337,7 +343,7 @@ USA.
               (group-ref x)
               "d")
          "acd")
-        ((seq (repeat> 0 1 "-")
+        ((seq (** 0 1 "-")
               (+ (char-set "0123456789"))
               (string-end))
          "-5"))))
@@ -376,7 +382,7 @@ USA.
          "AabC")
         ((seq "a" (+ (char-set ,(char-set->alphabet char-set:upper-case))) "c")
          "aBCc")
-        ((seq "a" (repeat> 20 20 (char-set "ab")))
+        ((seq "a" (** 20 (char-set "ab")))
          "aaaaabaaaabaaaabaaaab")
         ((seq "a"
               (char-set "ab") (char-set "ab") (char-set "ab") (char-set "ab")
@@ -443,13 +449,13 @@ USA.
         ("abcdefghijklmnopqrstuv"
          "abcdefghijklmnopqrstuv")
         ((alt (seq "CC" (char-set "13") "1")
-              (seq (repeat> 21 21 "a")
+              (seq (** 21 "a")
                    (char-set "23")
                    (char-set "EO")
                    (char-set "123")
                    (char-set "Es")
                    (char-set "12")
-                   (repeat> 15 15 "a")
+                   (** 15 "a")
                    "aa"
                    (char-set "34")
                    (char-set "EW")