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

'for' macro certification needs to propagate certs

Browse Source 
svn: r10269
This commit is contained in:
Matthew Flatt 2008-06-15 16:03:14 +00:00
parent e352b41265
commit bba93038ed
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/scheme/private/for.ss
View File

@ -90,13 +90,16 @@
proc1)
proc2
cert))
(define cert-key (gensym 'for-cert))
(define (certify-clause clause certifier introducer)
(define (certify-clause src-stx clause certifier introducer)
;; This is slightly painful. The painsion into `:do-in' involves a lot of pieces
;; that are no treated as sub-expressions. We have to push the certificates
;; down to all the relevant identifiers and expressions:
(define (cert s) (certifier s #f introducer))
(define (map-cert s) (map (lambda (s) (certifier s #f #;introducer))
(define (recert s) (syntax-recertify s src-stx (current-inspector) cert-key))
(define (cert s) (certifier (recert s) cert-key introducer))
(define (map-cert s) (map (lambda (s) (certifier (recert s) cert-key #;introducer))
(syntax->list s)))
(syntax-case clause (:do-in)
@ -167,7 +170,9 @@
[certifier (sequence-transformer-ref m 2)])
(let ([xformed (xformer (introducer (syntax-local-introduce clause)))])
(if xformed
(expand-clause orig-stx (certify-clause (syntax-local-introduce (introducer xformed))
(expand-clause orig-stx (certify-clause (syntax-case clause ()
[(_ rhs) #'rhs])
(syntax-local-introduce (introducer xformed))
certifier
introducer))
(eloop #f)))))]