From 4f0bed6a2bbf1b56ffd59e01ccd10f205b39ad8d Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Tue, 15 Jun 2004 20:51:10 +0000 Subject: [PATCH] *** empty log message *** original commit: 87ed95d79f3f73a58f95e99e135c9a1d7ab200dc --- collects/parser-tools/lex-sre.ss | 2 +- collects/parser-tools/lex.ss | 17 +++++++++++++---- collects/parser-tools/private-lex/re.ss | 22 +++++++++++----------- 3 files changed, 25 insertions(+), 16 deletions(-) diff --git a/collects/parser-tools/lex-sre.ss b/collects/parser-tools/lex-sre.ss index 8951acb..84f7aa0 100644 --- a/collects/parser-tools/lex-sre.ss +++ b/collects/parser-tools/lex-sre.ss @@ -102,7 +102,7 @@ #f "not given an even number of characters" stx)) - (syntax (/-only-chars #,@chars)))))) + #`(/-only-chars #,@chars))))) (define-lex-trans /-only-chars (syntax-rules () diff --git a/collects/parser-tools/lex.ss b/collects/parser-tools/lex.ss index 20f94b8..271eada 100644 --- a/collects/parser-tools/lex.ss +++ b/collects/parser-tools/lex.ss @@ -18,7 +18,8 @@ position-offset position-line position-col position? define-tokens define-empty-tokens token-name token-value token? file-path any-char any-string nothing alphabetic lower-case upper-case title-case - numeric symbolic punctuation graphic whitespace blank iso-control) + numeric symbolic punctuation graphic whitespace blank iso-control + char-set) (define file-path (make-parameter #f)) @@ -275,9 +276,10 @@ (syntax-case stx () ((_ ctxt) (with-syntax (((ranges ...) (map (lambda (range) - `(: ,@(map (lambda (x) `(- ,(integer->char (car x)) - ,(integer->char (cdr x)))) - range))) + `(union ,@(map (lambda (x) + `(char-range ,(integer->char (car x)) + ,(integer->char (cdr x)))) + range))) (list (force alphabetic-ranges) (force lower-case-ranges) (force upper-case-ranges) @@ -309,5 +311,12 @@ (define-lex-abbrev nothing (union)) (create-unicode-abbrevs #'here) + (define-lex-trans (char-set stx) + (syntax-case stx () + ((_ str) + (string? (syntax-e (syntax str))) + (with-syntax (((char ...) (string->list (syntax-e (syntax str))))) + (syntax (union char ...)))))) + ) diff --git a/collects/parser-tools/private-lex/re.ss b/collects/parser-tools/private-lex/re.ss index 6d403f0..eccce9a 100644 --- a/collects/parser-tools/private-lex/re.ss +++ b/collects/parser-tools/private-lex/re.ss @@ -50,7 +50,7 @@ ;; s-re = char constant ;; | string constant (sequence of characters) ;; | re a precompiled re - ;; | (repeat low high s-re) repetition between low and high times (inclusive) + ;; | (repetition low high s-re) repetition between low and high times (inclusive) ;; | (union s-re ...) ;; | (intersection s-re ...) ;; | (complement s-re) @@ -60,7 +60,7 @@ ;; low = natural-number ;; high = natural-number or +inf.0 ;; rng = char or string with length 1 - ;; (concatenation) (repeat 0 0 x), and "" match the empty string. + ;; (concatenation) (repetition 0 0 x), and "" match the empty string. ;; (union) matches no strings. ;; (intersection) matches any string. @@ -75,7 +75,7 @@ ((? char?) (build-char-set (loc:make-range (char->integer exp)) cache)) ((? string?) (->re `(concatenation ,@(string->list exp)) cache)) ((? re?) exp) - (`(repeat ,low ,high ,r) + (`(repetition ,low ,high ,r) (build-repeat low high (->re r cache) cache)) (`(union ,rs ...) (build-or (flatten-res (map (lambda (r) (->re r cache)) rs) @@ -332,19 +332,19 @@ (r (->re #\a c)) (rr (->re `(concatenation ,r ,r) c)) (rrr (->re `(concatenation ,r ,rr) c)) - (rrr* (->re `(repeat 0 +inf.0 ,rrr) c))) + (rrr* (->re `(repetition 0 +inf.0 ,rrr) c))) ((isc (char-setR-chars r)) (isc (is:make-range (char->integer #\a)))) ((->re "" c) e) ((->re "asdf" c) (->re `(concatenation #\a #\s #\d #\f) c)) ((->re r c) r) - ((->re `(repeat 0 +inf.0 ,r) c) (build-repeat 0 +inf.0 r c)) - ((->re `(repeat 1 +inf.0 ,r) c) (build-repeat 1 +inf.0 r c)) - ((->re `(repeat 0 1 ,r) c) (build-repeat 0 1 r c)) - ((->re `(repeat 0 1 ,rrr*) c) rrr*) + ((->re `(repetition 0 +inf.0 ,r) c) (build-repeat 0 +inf.0 r c)) + ((->re `(repetition 1 +inf.0 ,r) c) (build-repeat 1 +inf.0 r c)) + ((->re `(repetition 0 1 ,r) c) (build-repeat 0 1 r c)) + ((->re `(repetition 0 1 ,rrr*) c) rrr*) ((->re `(union (union (char-range #\a #\c) (char-complement (char-range #\000 #\110) (char-range #\112 ,(integer->char max-char-num)))) - (union (repeat 0 +inf.0 #\2))) c) + (union (repetition 0 +inf.0 #\2))) c) (build-or (list (build-char-set (is:union (is:make-range 73) (is:make-range 97 99)) c) @@ -356,13 +356,13 @@ ((->re `(intersection (intersection #\111 (char-complement (char-range #\000 #\110) (char-range #\112 ,(integer->char max-char-num)))) - (intersection (repeat 0 +inf.0 #\2))) c) + (intersection (repetition 0 +inf.0 #\2))) c) (build-and (list (build-char-set (is:make-range 73) c) (build-repeat 0 +inf.0 (build-char-set (is:make-range 50) c) c)) c)) ((->re `(intersection (intersection #\000 (char-complement (char-range #\000 #\110) (char-range #\112 ,(integer->char max-char-num)))) - (intersection (repeat 0 +inf.0 #\2))) c) + (intersection (repetition 0 +inf.0 #\2))) c) z) ((->re `(intersection ,rr ,rrr) c) (build-and (list rr rrr) c)) ((->re `(intersection ,r) c) r)