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

racket/package: fix package-begin

Browse Source
This commit is contained in:
Matthew Flatt 2015-07-21 13:07:53 -06:00
parent 78f2ab8fa1
commit 328c3d3276
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compatibility-lib/compatibility/package.rkt
View File

@ -201,9 +201,13 @@
(find-ids #'(id ...) values)] (find-ids #'(id ...) values)]
[(#:all-defined-except (id ...)) [(#:all-defined-except (id ...))
(find-ids #'(id ...) not)])) (find-ids #'(id ...) not)]))
#`(define-syntax id (package (quote-syntax star-id) (cond
(quote-syntax #,(map car mapping)) [(not (syntax-e #'id))
(quote-syntax #,(map cdr mapping)))))])) #'(begin)]
[else
#`(define-syntax id (package (quote-syntax star-id)
(quote-syntax #,(map car mapping))
(quote-syntax #,(map cdr mapping))))]))]))
(define-for-syntax (do-open-package stx def-stxes) (define-for-syntax (do-open-package stx def-stxes)
(check-definition-context stx) (check-definition-context stx)
@ -244,11 +248,11 @@
(syntax-case stx () (syntax-case stx ()
[(_ form ...) [(_ form ...)
#`(drive-top-level #`(drive-top-level
(accumulate-package #f #f #f #,stx (accumulate-package #f id id #f #,stx
#f (#:only ())
() ()
#,((make-syntax-introducer) #,((make-syntax-introducer)
#'(form ...))))]))) #'(form ...))))])))
(define-for-syntax (check-definition-context stx) (define-for-syntax (check-definition-context stx)
(when (eq? 'expression (syntax-local-context)) (when (eq? 'expression (syntax-local-context))