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

remove syntax certificates; add syntax taints

Browse Source 
original commit: 1160d3df629ce65eb8fe9ebea2c33b8d4000ea50
This commit is contained in:
Matthew Flatt 2011-06-24 13:41:55 -06:00
parent 8317296e8d
commit 51afe5c7ad
2 changed files with 8 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mzlib/private/package-helper.rkt
View File

@ -50,10 +50,7 @@
(define (rebuild ctxt val) (define (rebuild ctxt val)
(if (syntax? ctxt) (if (syntax? ctxt)
(syntax-recertify (datum->syntax-object ctxt val ctxt ctxt) (datum->syntax-object ctxt val ctxt ctxt)
ctxt
insp
#f)
val)) val))
(define (rebuild-cons car cdr stx) (define (rebuild-cons car cdr stx)

18
collects/mzlib/unit.rkt
View File

@ -693,26 +693,22 @@
(make-set!-transformer (make-set!-transformer
(make-signature (make-signature
(make-siginfo (list #'#,sigid #'super-name ...) (make-siginfo (list #'#,sigid #'super-name ...)
(list ((syntax-local-certifier) (quote-syntax signature-tag)) (list (quote-syntax signature-tag)
#'super-rtime #'super-rtime
...)) ...))
(list (quote-syntax var) ...) (list (quote-syntax var) ...)
(list (cons (list (quote-syntax vid) ...) (list (cons (list (quote-syntax vid) ...)
((syntax-local-certifier) (quote-syntax vbody))
(quote-syntax vbody)))
...) ...)
(list (cons (list (quote-syntax sid) ...) (list (cons (list (quote-syntax sid) ...)
((syntax-local-certifier) (quote-syntax sbody))
(quote-syntax sbody)))
...) ...)
(list (cons (list (quote-syntax pvid) ...) (list (cons (list (quote-syntax pvid) ...)
((syntax-local-certifier) (quote-syntax pvbody))
(quote-syntax pvbody)))
...) ...)
(list #,@(map (lambda (c) (list #,@(map (lambda (c)
(if c (if c
#`((syntax-local-certifier) #`(quote-syntax #,c)
(quote-syntax #,c))
#'#f)) #'#f))
all-ctcs)) all-ctcs))
(quote-syntax #,sigid)))) (quote-syntax #,sigid))))
@ -1117,7 +1113,7 @@
(var-info-id defid))))) (var-info-id defid)))))
(syntax->list (localify #'ivars def-ctx))) (syntax->list (localify #'ivars def-ctx)))
(let ([marker (make-syntax-introducer)]) (let ([marker (lambda (id) ((make-syntax-introducer) (datum->syntax #f (syntax-e id))))])
(with-syntax ([(defn-or-expr ...) (with-syntax ([(defn-or-expr ...)
(apply append (apply append
(map (λ (defn-or-expr) (map (λ (defn-or-expr)
@ -1787,7 +1783,7 @@
(define u #,exp) (define u #,exp)
(define-syntax name (define-syntax name
(make-set!-transformer (make-set!-transformer
(make-unit-info ((syntax-local-certifier) (quote-syntax u)) (make-unit-info (quote-syntax u)
(list (cons 'itag (quote-syntax isig)) ...) (list (cons 'itag (quote-syntax isig)) ...)
(list (cons 'etag (quote-syntax esig)) ...) (list (cons 'etag (quote-syntax esig)) ...)
(list (cons 'deptag (quote-syntax deptag)) ...) (list (cons 'deptag (quote-syntax deptag)) ...)