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

fix inverted argument default for editor<%> read-from-file method; better Check Sytax results on packages; added syntax/flatten-begin library

Browse Source 
svn: r14548

original commit: 4b3626c1560658fe3937019e001911c2a44aaff3
This commit is contained in:
Matthew Flatt 2009-04-17 22:50:19 +00:00
parent b14a088754
commit 2b7e5a9642
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/scheme/package.ss
View File

@ -2,7 +2,8 @@
(require (for-syntax scheme/base
syntax/kerncase
syntax/boundmap
syntax/define))
syntax/define
syntax/flatten-begin))
(provide define-package
package-begin
@ -93,6 +94,12 @@
hidden)
id)))
(define-for-syntax (move-props orig new)
(datum->syntax new
(syntax-e new)
orig
orig))
(define-for-syntax (do-define-package stx exp-stx)
(syntax-case exp-stx ()
[(_ pack-id mode exports form ...)
@ -293,7 +300,7 @@
(car def-ctxes)))])
(syntax-case expr (begin)
[(begin . rest)
(loop (append (syntax->list #'rest) (cdr exprs))
(loop (append (flatten-begin expr) (cdr exprs))
rev-forms
def-ctxes)]
[(def (id ...) rhs)
@ -315,7 +322,7 @@
(syntax-local-bind-syntaxes ids #'rhs def-ctx)
(register-bindings! ids)
(loop (cdr exprs)
(cons #`(define-syntaxes #,ids rhs)
(cons (move-props expr #`(define-syntaxes #,ids rhs))
rev-forms)
(if star? (cons def-ctx def-ctxes) def-ctxes)))))]
[(def (id ...) rhs)
@ -333,7 +340,7 @@
(syntax-local-bind-syntaxes ids #f def-ctx)
(register-bindings! ids)
(loop (cdr exprs)
(cons #`(define-values #,ids rhs) rev-forms)
(cons (move-props expr #`(define-values #,ids rhs)) rev-forms)
(if star? (cons def-ctx def-ctxes) def-ctxes))))]
[else
(loop (cdr exprs)