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

added stx-map to syntax/stx from unstable/syntax

Browse Source
This commit is contained in:
Ryan Culpepper 2011-04-07 07:25:43 -06:00
parent 86f65468d7
commit 76c75d5a87
2 changed files with 15 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/syntax/scribblings/stx.scrbl
View File

@ -37,6 +37,13 @@ Takes the car of a @techlink[#:doc refman]{syntax pair}.}
Takes the cdr of a @techlink[#:doc refman]{syntax pair}.} Takes the cdr of a @techlink[#:doc refman]{syntax pair}.}
@defproc[(stx-map [proc procedure?]
[stxl stx-list?] ...)
list?]{
Equivalent to @racket[(map proc (stx->list stxl) ...)].
}
@defproc[(module-or-top-identifier=? [a-id identifier?] @defproc[(module-or-top-identifier=? [a-id identifier?]
[b-id identifier?]) [b-id identifier?])
boolean?]{ boolean?]{

8
collects/syntax/stx.rkt
View File

@ -7,6 +7,7 @@
(provide stx-null? stx-pair? stx-list? (provide stx-null? stx-pair? stx-list?
stx-car stx-cdr stx->list stx-car stx-cdr stx->list
stx-map
module-or-top-identifier=?) module-or-top-identifier=?)
;; a syntax null? ;; a syntax null?
@ -70,6 +71,13 @@
#f)))) #f))))
e)))) e))))
(define (stx-map f . stxls)
(for ([stxl (in-list stxls)]
[i (in-naturals)])
(unless (stx-list? stxl)
(apply raise-type-error 'stx-map "stx-list" i stxls)))
(apply map f (map stx->list stxls)))
(define (module-or-top-identifier=? a b) (define (module-or-top-identifier=? a b)
(or (free-identifier=? a b) (or (free-identifier=? a b)
(and (eq? (syntax-e a) (syntax-e b)) (and (eq? (syntax-e a) (syntax-e b))