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

.

Browse Source 
original commit: a16909585b74beb2e6e8aaa812a224d4bcde38e5
This commit is contained in:
Matthew Flatt 2005-05-19 21:05:16 +00:00
parent 01ff14079f
commit 4f9da45651
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mzlib/foreign.ss
View File

@ -363,6 +363,8 @@
(list (syntax-recertify #'id orig #f fun-cert-key)
(syntax-recertify #'body orig #f fun-cert-key))]
[_else x]))
(define (cert-id id)
(syntax-recertify id orig #f fun-cert-key))
(let ([keys '()])
(define (setkey! key val . id?)
(cond
@ -377,9 +379,9 @@
(syntax-case* t (type: expr: bind: 1st-arg: prev-arg: pre: post:) id=?
[(type: t x ...) (next #'(x ...) 'type #'t)]
[(expr: e x ...) (next #'(x ...) 'expr #'e)]
[(bind: id x ...) (next #'(x ...) 'bind #'id #t)]
[(1st-arg: id x ...) (next #'(x ...) '1st #'id #t)]
[(prev-arg: id x ...) (next #'(x ...) 'prev #'id #t)]
[(bind: id x ...) (next #'(x ...) 'bind (cert-id #'id) #t)]
[(1st-arg: id x ...) (next #'(x ...) '1st (cert-id #'id) #t)]
[(prev-arg: id x ...) (next #'(x ...) 'prev (cert-id #'id) #t)]
;; in the following two cases pass along orig for recertifying
[(pre: p x ...) (next #'(x ...) 'pre (with-arg #'p))]
[(post: p x ...) (next #'(x ...) 'post (with-arg #'p))]