You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
br-parser-tools/collects/parser-tools/lex-sre.ss

120 lines
3.0 KiB
Scheme

(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-/ /)
/-only-chars)
(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 ...)
(char-complement (union re ...)))))
;; char-set difference
(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 (~ (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))
#`(/-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 ...)))))
)