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

splicing-let, etc.

Browse Source 
svn: r14165
This commit is contained in:
Matthew Flatt 2009-03-17 23:09:38 +00:00
parent 4cd11d7f64
commit e8cbe7ff81
3 changed files with 93 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
collects/scheme/splicing.ss
View File

@ -8,9 +8,13 @@
splicing-let-syntaxes
splicing-letrec-syntax
splicing-letrec-syntaxes
splicing-let
splicing-let-values
splicing-letrec
splicing-letrec-values
splicing-syntax-parameterize)
(define-for-syntax (do-let-syntax stx rec? multi? let-stx-id)
(define-for-syntax (do-let-syntax stx rec? multi? let-id def-id need-top-decl?)
(syntax-case stx ()
[(_ ([ids expr] ...) body ...)
(let ([all-ids (map (lambda (ids-stx)
@ -42,11 +46,11 @@
stx
dup-id)))
(if (eq? 'expression (syntax-local-context))
(with-syntax ([let-stx let-stx-id])
(with-syntax ([LET let-id])
(syntax/loc stx
(let-stx ([ids expr] ...)
(#%expression body)
...)))
(LET ([ids expr] ...)
(#%expression body)
...)))
(let ([def-ctx (syntax-local-make-definition-context)]
[ctx (list (gensym 'intdef))])
(syntax-local-bind-syntaxes (apply append all-ids) #f def-ctx)
@ -69,23 +73,41 @@
(map add-context exprs)
exprs))]
[(body ...)
(map add-context (syntax->list #'(body ...)))])
#'(begin
(define-syntaxes (id ...) expr)
...
body ...))))))]))
(map add-context (syntax->list #'(body ...)))]
[DEF def-id])
(with-syntax ([(top-decl ...)
(if (and need-top-decl? (equal? 'top-level (syntax-local-context)))
#'((define-syntaxes (id ... ...) (values)))
null)])
#'(begin
top-decl ...
(DEF (id ...) expr)
...
body ...)))))))]))
(define-syntax (splicing-let-syntax stx)
(do-let-syntax stx #f #f #'let-syntax))
(do-let-syntax stx #f #f #'let-syntax #'define-syntaxes #f))
(define-syntax (splicing-let-syntaxes stx)
(do-let-syntax stx #f #t #'let-syntaxes))
(do-let-syntax stx #f #t #'let-syntaxes #'define-syntaxes #f))
(define-syntax (splicing-letrec-syntax stx)
(do-let-syntax stx #t #f #'letrec-syntax))
(do-let-syntax stx #t #f #'letrec-syntax #'define-syntaxes #f))
(define-syntax (splicing-letrec-syntaxes stx)
(do-let-syntax stx #t #t #'letrec-syntaxes))
(do-let-syntax stx #t #t #'letrec-syntaxes #'define-syntaxes #f))
(define-syntax (splicing-let stx)
(do-let-syntax stx #f #f #'let #'define-values #f))
(define-syntax (splicing-let-values stx)
(do-let-syntax stx #f #t #'let-values #'define-values #f))
(define-syntax (splicing-letrec stx)
(do-let-syntax stx #t #f #'letrec #'define-values #t))
(define-syntax (splicing-letrec-values stx)
(do-let-syntax stx #t #t #'letrec-values #'define-values #t))
;; ----------------------------------------

13
collects/scribblings/reference/splicing.scrbl
View File

@ -13,16 +13,25 @@
@note-lib-only[scheme/splicing]
@deftogether[(
@defidform[splicing-let]
@defidform[splicing-letrec]
@defidform[splicing-let-values]
@defidform[splicing-letrec-values]
@defidform[splicing-let-syntax]
@defidform[splicing-letrec-syntax]
@defidform[splicing-let-syntaxes]
@defidform[splicing-letrec-syntaxes]
)]{
Like @scheme[let-syntax], @scheme[letrec-syntax],
Like @scheme[let], @scheme[letrec], @scheme[let-values],
@scheme[letrec-values], @scheme[let-syntax], @scheme[letrec-syntax],
@scheme[let-syntaxes], and @scheme[letrec-syntaxes], except that in a
definition context, the body forms are spliced into the enclosing
definition context (in the same as as for @scheme[begin]).
definition context (in the same as as for @scheme[begin]). Also, for
@scheme[splicing-letrec] and @scheme[splicing-letrec-values], a
reference to a bound identifiers before is initialized is treated in
the same way as definition in the enclosing context, which may be
different than for @scheme[letrec] and @scheme[letrec-values].
@examples[
#:eval splice-eval

46
collects/tests/mzscheme/syntax.ss
View File

@ -1203,6 +1203,52 @@
(define x 10))
(abcdefg)))
;; ----------------------------------------
(test 79 'splicing-let (let ()
(splicing-let ([x 79])
(define (y) x))
(y)))
(test 77 'splicing-let (let ()
(define q 77)
(splicing-let ([q 8]
[x q])
(define (z) x))
(z)))
(test 81 'splicing-letrec (let ()
(define q 77)
(splicing-letrec ([q 81]
[x q])
(define (z) x))
(z)))
(test 82 'splicing-letrec (let ()
(define q 77)
(splicing-letrec ([x (lambda () (q))]
[q (lambda () 82)])
(define (z) x))
((z))))
(test 81 'splicing-letrec (eval
'(begin
(define q 77)
(splicing-letrec ([q 81]
[x q])
(define (z) x))
(z))))
(test 82 'splicing-letrec (eval
'(begin
(define q 77)
(splicing-letrec ([x (lambda () (q))]
[q (lambda () 82)])
(define (z) x))
((z)))))
(err/rt-test (eval
'(begin
(splicing-letrec ([x q]
[q 81])
x)))
exn:fail:contract:variable?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)