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

.

Browse Source 
original commit: 01bf1a42af2e50662c1a792959dfc063df876cc9
This commit is contained in:
Matthew Flatt 2004-11-25 16:21:18 +00:00
parent dc69f0b229
commit 6d0d143b23
2 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mzlib/contract.ss
View File

@ -462,21 +462,23 @@ add struct contracts for immutable structs?
(syntax _))] (syntax _))]
[(_ arg (... ...)) [(_ arg (... ...))
(syntax (syntax
((-contract contract-id ((begin-lifted
id (-contract contract-id
pos-module-source id
(module-source-as-symbol #'neg-stx) pos-module-source
(quote-syntax _)) (module-source-as-symbol #'neg-stx)
(quote-syntax _)))
arg arg
(... ...)))] (... ...)))]
[_ [_
(identifier? (syntax _)) (identifier? (syntax _))
(syntax (syntax
(-contract contract-id (begin-lifted
id (-contract contract-id
pos-module-source id
(module-source-as-symbol #'neg-stx) pos-module-source
(quote-syntax _)))])))))))))) (module-source-as-symbol #'neg-stx)
(quote-syntax _))))]))))))))))
(with-syntax ([(bodies ...) (code-for-each-clause (syntax->list (syntax (p/c-ele ...))))]) (with-syntax ([(bodies ...) (code-for-each-clause (syntax->list (syntax (p/c-ele ...))))])
(syntax (syntax

3
collects/mzlib/etc.ss
View File

@ -560,4 +560,5 @@
(define-syntax (begin-lifted stx) (define-syntax (begin-lifted stx)
(syntax-case stx () (syntax-case stx ()
[(_ expr0 expr ...) [(_ expr0 expr ...)
(syntax-local-lift-expression #'(begin expr0 expr ...))]))) (syntax-local-lift-expression
#'(begin expr0 expr ...))])))