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

generalized `begin-for-syntax'

Browse Source 
original commit: d3c56c9f13327d07513f8b6bf7ea0230acb7f489
This commit is contained in:
Matthew Flatt 2011-09-05 16:08:16 -06:00
parent c69253c388
commit 2b861d3e67
2 changed files with 27 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mzlib/include.rkt
View File

@ -20,7 +20,10 @@
fn))
(string->path s))]
[(-build-path elem ...)
(module-or-top-identifier=? #'-build-path build-path-stx)
(begin
(collect-garbage)
(module-identifier=? #'-build-path build-path-stx)
(module-or-top-identifier=? #'-build-path build-path-stx))
(let ([l (syntax-object->datum (syntax (elem ...)))])
(when (null? l)
(raise-syntax-error

45
collects/racket/private/old-rp.rkt
View File

@ -5,28 +5,29 @@
(#%provide require require-for-syntax require-for-template require-for-label
provide provide-for-syntax provide-for-label)
(define-values-for-syntax (rebuild-elem)
(lambda (stx elem sub pos loop ids)
;; For sub-forms, we loop and reconstruct:
(for-each (lambda (id)
(unless (identifier? id)
(raise-syntax-error
#f
"expected an identifier"
stx
id)))
(syntax->list ids))
(let rloop ([elem elem][pos pos])
(if (syntax? elem)
(datum->syntax elem
(rloop (syntax-e elem) pos)
elem
elem)
(if (zero? pos)
(cons (loop (car elem))
(cdr elem))
(cons (car elem)
(rloop (cdr elem) (sub1 pos))))))))
(begin-for-syntax
(define-values (rebuild-elem)
(lambda (stx elem sub pos loop ids)
;; For sub-forms, we loop and reconstruct:
(for-each (lambda (id)
(unless (identifier? id)
(raise-syntax-error
#f
"expected an identifier"
stx
id)))
(syntax->list ids))
(let rloop ([elem elem][pos pos])
(if (syntax? elem)
(datum->syntax elem
(rloop (syntax-e elem) pos)
elem
elem)
(if (zero? pos)
(cons (loop (car elem))
(cdr elem))
(cons (car elem)
(rloop (cdr elem) (sub1 pos)))))))))
(define-syntaxes (require require-for-syntax require-for-template require-for-label)