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

10
collects/scheme/package.ss
View File

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