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

scheme/package simplifications from Chongkai

Browse Source 
svn: r14448

original commit: de1e2fac233b1c1916943bb946b77224455619d5
This commit is contained in:
Matthew Flatt 2009-04-07 20:36:08 +00:00
parent 7a326a7ee9
commit 7e81aaeb65
1 changed files with 11 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/scheme/package.ss
View File

@ -222,7 +222,6 @@
[(_ stx) #'stx])))))])
(let loop ([exprs init-exprs]
[rev-forms null]
[defined null]
[def-ctxes (list def-ctx)])
(cond
[(null? exprs)
@ -296,7 +295,6 @@
[(begin . rest)
(loop (append (syntax->list #'rest) (cdr exprs))
rev-forms
defined
def-ctxes)]
[(def (id ...) rhs)
(and (or (free-identifier=? #'def #'define-syntaxes)
@ -319,7 +317,6 @@
(loop (cdr exprs)
(cons #`(define-syntaxes #,ids rhs)
rev-forms)
(cons ids defined)
(if star? (cons def-ctx def-ctxes) def-ctxes)))))]
[(def (id ...) rhs)
(and (or (free-identifier=? #'def #'define-values)
@ -337,7 +334,6 @@
(register-bindings! ids)
(loop (cdr exprs)
(cons #`(define-values #,ids rhs) rev-forms)
(cons ids defined)
(if star? (cons def-ctx def-ctxes) def-ctxes))))]
[else
(loop (cdr exprs)
@ -346,7 +342,6 @@
expr
#`(define-values () (begin #,expr (values))))
rev-forms)
defined
def-ctxes)]))]))))))]))
(define-syntax (define-package stx)
@ -396,18 +391,17 @@
(syntax-local-introduce (cdr p))))
((package-exports v)))]
[(h ...) (map syntax-local-introduce ((package-hidden v)))])
#`(begin
(#,define-syntaxes-id (intro ...)
(let ([rev-map (lambda (x)
(reverse-mapping
'pack-id
x
(list (cons (quote-syntax a)
(quote-syntax b))
...)
(list (quote-syntax h) ...)))])
(values (make-rename-transformer #'defined rev-map)
...))))))))]))
#`(#,define-syntaxes-id (intro ...)
(let ([rev-map (lambda (x)
(reverse-mapping
'pack-id
x
(list (cons (quote-syntax a)
(quote-syntax b))
...)
(list (quote-syntax h) ...)))])
(values (make-rename-transformer #'defined rev-map)
...)))))))]))
(define-syntax (open-package stx)
(do-open stx #'define-syntaxes))