suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

non-greedy matching

Browse Source 
svn: r17149
This commit is contained in:
Jon Rafkind 2009-12-01 20:39:46 +00:00
parent 53eb309b75
commit 6639a29829
1 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/honu/private/macro.ss
View File

@ -368,12 +368,26 @@
(#%braces (#%braces name pattern ...)) (#%braces (#%braces name pattern ...))
(#%braces (#%braces template ...)) (#%braces (#%braces template ...))
. rest) . rest)
(with-syntax ([pulled (pull #'(template ...))]) (with-syntax ([pulled (pull #'(template ...))]
[(pattern* ...) (map (lambda (stx)
(if (and (identifier? stx)
(not (ormap (lambda (f)
(free-identifier=? stx f))
(syntax->list #'(honu-literal ...))))
(not (free-identifier=? stx #'(... ...))))
(with-syntax ([x stx])
#'(~and x (~not (~or honu-literal ...))))
stx))
(syntax->list #'(pattern ...)))]
)
(values (values
#'(define-honu-syntax name #'(define-honu-syntax name
(lambda (stx ctx) (lambda (stx ctx)
(syntax-case stx (honu-literal ...) ;; (define-literal-set literals (honu-literal ...))
[(name pattern ... . rrest) (syntax-parse stx
;; #:literal-sets (literals)
#:literals (honu-literal ...)
[(name pattern* ... . rrest)
(with-syntax ([(out (... ...)) (unpull #'pulled)]) (with-syntax ([(out (... ...)) (unpull #'pulled)])
(values (values
#'(honu-unparsed-block #'(honu-unparsed-block