*** empty log message ***

original commit: 87ed95d79f3f73a58f95e99e135c9a1d7ab200dc
tokens
Scott Owens 21 years ago
parent 90c30e73c5
commit 4f0bed6a2b

@ -102,7 +102,7 @@
#f #f
"not given an even number of characters" "not given an even number of characters"
stx)) stx))
(syntax (/-only-chars #,@chars)))))) #`(/-only-chars #,@chars)))))
(define-lex-trans /-only-chars (define-lex-trans /-only-chars
(syntax-rules () (syntax-rules ()

@ -18,7 +18,8 @@
position-offset position-line position-col position? position-offset position-line position-col position?
define-tokens define-empty-tokens token-name token-value token? file-path define-tokens define-empty-tokens token-name token-value token? file-path
any-char any-string nothing alphabetic lower-case upper-case title-case 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)) (define file-path (make-parameter #f))
@ -275,7 +276,8 @@
(syntax-case stx () (syntax-case stx ()
((_ ctxt) ((_ ctxt)
(with-syntax (((ranges ...) (map (lambda (range) (with-syntax (((ranges ...) (map (lambda (range)
`(: ,@(map (lambda (x) `(- ,(integer->char (car x)) `(union ,@(map (lambda (x)
`(char-range ,(integer->char (car x))
,(integer->char (cdr x)))) ,(integer->char (cdr x))))
range))) range)))
(list (force alphabetic-ranges) (list (force alphabetic-ranges)
@ -309,5 +311,12 @@
(define-lex-abbrev nothing (union)) (define-lex-abbrev nothing (union))
(create-unicode-abbrevs #'here) (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 ...))))))
) )

@ -50,7 +50,7 @@
;; s-re = char constant ;; s-re = char constant
;; | string constant (sequence of characters) ;; | string constant (sequence of characters)
;; | re a precompiled re ;; | 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 ...) ;; | (union s-re ...)
;; | (intersection s-re ...) ;; | (intersection s-re ...)
;; | (complement s-re) ;; | (complement s-re)
@ -60,7 +60,7 @@
;; low = natural-number ;; low = natural-number
;; high = natural-number or +inf.0 ;; high = natural-number or +inf.0
;; rng = char or string with length 1 ;; 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. ;; (union) matches no strings.
;; (intersection) matches any string. ;; (intersection) matches any string.
@ -75,7 +75,7 @@
((? char?) (build-char-set (loc:make-range (char->integer exp)) cache)) ((? char?) (build-char-set (loc:make-range (char->integer exp)) cache))
((? string?) (->re `(concatenation ,@(string->list exp)) cache)) ((? string?) (->re `(concatenation ,@(string->list exp)) cache))
((? re?) exp) ((? re?) exp)
(`(repeat ,low ,high ,r) (`(repetition ,low ,high ,r)
(build-repeat low high (->re r cache) cache)) (build-repeat low high (->re r cache) cache))
(`(union ,rs ...) (`(union ,rs ...)
(build-or (flatten-res (map (lambda (r) (->re r cache)) rs) (build-or (flatten-res (map (lambda (r) (->re r cache)) rs)
@ -332,19 +332,19 @@
(r (->re #\a c)) (r (->re #\a c))
(rr (->re `(concatenation ,r ,r) c)) (rr (->re `(concatenation ,r ,r) c))
(rrr (->re `(concatenation ,r ,rr) 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)))) ((isc (char-setR-chars r)) (isc (is:make-range (char->integer #\a))))
((->re "" c) e) ((->re "" c) e)
((->re "asdf" c) (->re `(concatenation #\a #\s #\d #\f) c)) ((->re "asdf" c) (->re `(concatenation #\a #\s #\d #\f) c))
((->re r c) r) ((->re r c) r)
((->re `(repeat 0 +inf.0 ,r) c) (build-repeat 0 +inf.0 r c)) ((->re `(repetition 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 `(repetition 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 `(repetition 0 1 ,r) c) (build-repeat 0 1 r c))
((->re `(repeat 0 1 ,rrr*) c) rrr*) ((->re `(repetition 0 1 ,rrr*) c) rrr*)
((->re `(union (union (char-range #\a #\c) ((->re `(union (union (char-range #\a #\c)
(char-complement (char-range #\000 #\110) (char-complement (char-range #\000 #\110)
(char-range #\112 ,(integer->char max-char-num)))) (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) (build-or (list (build-char-set (is:union (is:make-range 73)
(is:make-range 97 99)) (is:make-range 97 99))
c) c)
@ -356,13 +356,13 @@
((->re `(intersection (intersection #\111 ((->re `(intersection (intersection #\111
(char-complement (char-range #\000 #\110) (char-complement (char-range #\000 #\110)
(char-range #\112 ,(integer->char max-char-num)))) (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-and (list (build-char-set (is:make-range 73) c)
(build-repeat 0 +inf.0 (build-char-set (is:make-range 50) c) c)) (build-repeat 0 +inf.0 (build-char-set (is:make-range 50) c) c))
c)) c))
((->re `(intersection (intersection #\000 (char-complement (char-range #\000 #\110) ((->re `(intersection (intersection #\000 (char-complement (char-range #\000 #\110)
(char-range #\112 ,(integer->char max-char-num)))) (char-range #\112 ,(integer->char max-char-num))))
(intersection (repeat 0 +inf.0 #\2))) c) (intersection (repetition 0 +inf.0 #\2))) c)
z) z)
((->re `(intersection ,rr ,rrr) c) (build-and (list rr rrr) c)) ((->re `(intersection ,rr ,rrr) c) (build-and (list rr rrr) c))
((->re `(intersection ,r) c) r) ((->re `(intersection ,r) c) r)

Loading…
Cancel
Save