diff --git a/collects/parser-tools/lex-sre.ss b/collects/parser-tools/lex-sre.ss new file mode 100644 index 0000000..8951acb --- /dev/null +++ b/collects/parser-tools/lex-sre.ss @@ -0,0 +1,117 @@ +(module lex-sre mzscheme + (require (lib "lex.ss" "parser-tools")) + + (provide (rename sre-* *) + (rename sre-+ +) + ? + (rename sre-= =) + (rename sre->= >=) + ** + (rename sre-or or) + : + seq + & + ~ + (rename sre-- -) + (rename sre-/ /)) + + (define-lex-trans sre-* + (syntax-rules () + ((_ re ...) + (repetition 0 +inf.0 (union re ...))))) + + (define-lex-trans sre-+ + (syntax-rules () + ((_ re ...) + (repetition 1 +inf.0 (union re ...))))) + + (define-lex-trans ? + (syntax-rules () + ((_ re ...) + (repetition 0 1 (union re ...))))) + + (define-lex-trans sre-= + (syntax-rules () + ((_ n re ...) + (repetition n n (union re ...))))) + + (define-lex-trans sre->= + (syntax-rules () + ((_ n re ...) + (repetition n +inf.0 (union re ...))))) + + (define-lex-trans ** + (syntax-rules () + ((_ low #f re ...) + (** low +inf.0 re ...)) + ((_ low high re ...) + (repetition low high (union re ...))))) + + (define-lex-trans sre-or + (syntax-rules () + ((_ re ...) + (union re ...)))) + + (define-lex-trans : + (syntax-rules () + ((_ re ...) + (concatenation re ...)))) + + (define-lex-trans seq + (syntax-rules () + ((_ re ...) + (concatenation re ...)))) + + (define-lex-trans & + (syntax-rules () + ((_ re ...) + (intersection re ...)))) + + (define-lex-trans ~ + (syntax-rules () + ((_ re ...) + (complement (union re ...))))) + + (define-lex-trans (sre-- stx) + (syntax-case stx () + ((_) + (raise-syntax-error #f + "must have at least one argument" + stx)) + ((_ big-re re ...) + (syntax (intersect big-re (complement (union re) ...)))))) + + (define-lex-trans (sre-/ stx) + (syntax-case stx () + ((_ range ...) + (let ((chars + (apply append (map (lambda (r) + (let ((x (syntax-e r))) + (cond + ((char? x) (list x)) + ((string? x) (string->list x)) + (else + (raise-syntax-error + #f + "not a char or string" + stx + r))))) + (syntax->list (syntax (range ...))))))) + (unless (even? (length chars)) + (raise-syntax-error + #f + "not given an even number of characters" + stx)) + (syntax (/-only-chars #,@chars)))))) + + (define-lex-trans /-only-chars + (syntax-rules () + ((_ c1 c2) + (char-range c1 c2)) + ((_ c1 c2 c ...) + (union (char-range c1 c2) + (/-only-chars c ...))))) + + ) + + \ No newline at end of file diff --git a/collects/parser-tools/lex.ss b/collects/parser-tools/lex.ss index 1c80b1f..20f94b8 100644 --- a/collects/parser-tools/lex.ss +++ b/collects/parser-tools/lex.ss @@ -304,9 +304,9 @@ iso-control)))) (syntax (define-lex-abbrevs (names ranges) ...)))))) - (define-lex-abbrev any-char (^)) - (define-lex-abbrev any-string (&)) - (define-lex-abbrev nothing (:)) + (define-lex-abbrev any-char (char-complement (union))) + (define-lex-abbrev any-string (intersection)) + (define-lex-abbrev nothing (union)) (create-unicode-abbrevs #'here)