*** empty log message ***

original commit: 59781cb267177f1b452e9fea0b325fb5d7405074

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 ...)))))
+  
+  )
+                           
+   

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-char (char-complement (union)))
-  (define-lex-abbrev any-string (&))
+  (define-lex-abbrev any-string (intersection))
-  (define-lex-abbrev nothing (:))
+  (define-lex-abbrev nothing (union))
   (create-unicode-abbrevs #'here)