From 47d87c718372a8a0b97056765e218f8e0234bcd4 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 27 Sep 2009 21:45:22 -0700 Subject: [PATCH] Rename REPEAT> to ** and REPEAT< to **? and allow single limit. --- src/runtime/regsexp.scm | 71 ++++++++++++++++++------------- tests/runtime/test-regsexp.scm | 78 ++++++++++++++++++---------------- 2 files changed, 83 insertions(+), 66 deletions(-) diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm index 7f0a3394d..518dbef7f 100644 --- 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))))) -(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 963dc8374..dcd832362 100644 --- 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"))))) (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") -- 2.25.1