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.
brag/parser-tools/lex-sre.rkt

104 lines
2.7 KiB
Racket

#lang racket/base
(require (for-syntax racket/base)
yaragg/parser-tools/lex)
(provide (rename-out [sre-* *]
[sre-+ +]
[sre-= =]
[sre->= >=]
[sre-or or]
[sre-- -]
[sre-/ /])
? ** : seq & ~ /-only-chars)
(define-lex-trans (sre-* stx)
(syntax-case stx ()
[(_ RE ...)
#'(repetition 0 +inf.0 (union RE ...))]))
(define-lex-trans (sre-+ stx)
(syntax-case stx ()
[(_ RE ...)
#'(repetition 1 +inf.0 (union RE ...))]))
(define-lex-trans (? stx)
(syntax-case stx ()
[(_ RE ...)
#'(repetition 0 1 (union RE ...))]))
(define-lex-trans (sre-= stx)
(syntax-case stx ()
[(_ N RE ...)
#'(repetition N N (union RE ...))]))
(define-lex-trans (sre->= stx)
(syntax-case stx ()
[(_ N RE ...)
#'(repetition N +inf.0 (union RE ...))]))
(define-lex-trans (** stx)
(syntax-case stx ()
[(_ LOW #f RE ...)
#'(** LOW +inf.0 RE ...)]
[(_ LOW HIGH RE ...)
#'(repetition LOW HIGH (union RE ...))]))
(define-lex-trans (sre-or stx)
(syntax-case stx ()
[(_ RE ...)
#'(union RE ...)]))
(define-lex-trans (: stx)
(syntax-case stx ()
[(_ RE ...)
#'(concatenation RE ...)]))
(define-lex-trans (seq stx)
(syntax-case stx ()
[(_ RE ...)
#'(concatenation RE ...)]))
(define-lex-trans (& stx)
(syntax-case stx ()
[(_ RE ...)
#'(intersection RE ...)]))
(define-lex-trans (~ stx)
(syntax-case stx ()
[(_ RE ...)
#'(char-complement (union RE ...))]))
;; set difference
(define-lex-trans (sre-- stx)
(syntax-case stx ()
[(_)
(raise-syntax-error #f
"must have at least one argument"
stx)]
[(_ BIG-RE RE ...)
#'(& BIG-RE (complement (union RE ...)))]))
(define-lex-trans (sre-/ stx)
(syntax-case stx ()
[(_ RANGE ...)
(let ([chars
(apply append (for/list ([r (in-list (syntax->list #'(RANGE ...)))])
(define 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)])))])
(unless (even? (length chars))
(raise-syntax-error #f "not given an even number of characters" stx))
#`(/-only-chars #,@chars))]))
(define-lex-trans (/-only-chars stx)
(syntax-case stx ()
[(_ C1 C2)
#'(char-range C1 C2)]
[(_ C1 C2 C ...)
#'(union (char-range C1 C2) (/-only-chars C ...))]))