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

req-for-syntax repairs

Browse Source 
svn: r1288
This commit is contained in:
Matthew Flatt 2005-11-11 21:28:22 +00:00
parent aa0692e7cd
commit c198298d25
2 changed files with 52 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/compiler/private/driver.ss
View File

@ -638,20 +638,22 @@
[_else (void)]))
;;-----------------------------------------------------------------------
;; ensure that no `module' expression is inside a `begin'
;;
;; ensure that no `module', `require', or `require-for-syntax'
;; expression is inside a `begin'
(letrec ([needs-split?
(lambda (stx saw-begin?)
(syntax-case stx (begin module)
(syntax-case stx (begin module require require-for-syntax)
[(module . _) saw-begin?]
[(require . _) saw-begin?]
[(require-for-syntax . _) saw-begin?]
[(begin . e)
(ormap (lambda (x) (needs-split? x #t))
(syntax->list #'e))]
[_else #f]))]
[split
(lambda (stx)
(syntax-case stx (begin module)
(syntax-case stx (begin)
[(begin . e)
(apply append (map split (syntax->list #'e)))]
[_else (list stx)]))])
@ -674,25 +676,26 @@
(let ([core-thunk
(lambda ()
(let ([sources+bytecodes+magics
(map (lambda (src)
(let-values ([(src bytecode magic-sym)
(top-level-to-core src
#`'#,zodiac:global-lookup-id
#`'#,zodiac:global-assign-id
#`'#,zodiac:safe-vector-ref-id
#`'#,zodiac:global-prepare-id)])
(list (zodiac:syntax->zodiac src)
bytecode magic-sym)))
(block-source s:file-block))])
(set-block-source! s:file-block (map car sources+bytecodes+magics))
(set-block-bytecodes! s:file-block
(parameterize ([current-namespace elaborate-namespace])
(parameterize ([current-namespace elaborate-namespace]
[current-load-relative-directory input-directory])
(let ([sources+bytecodes+magics
(map (lambda (src)
(let-values ([(src bytecode magic-sym)
(top-level-to-core src
#`'#,zodiac:global-lookup-id
#`'#,zodiac:global-assign-id
#`'#,zodiac:safe-vector-ref-id
#`'#,zodiac:global-prepare-id)])
(list (zodiac:syntax->zodiac src)
bytecode magic-sym)))
(block-source s:file-block))])
(set-block-source! s:file-block (map car sources+bytecodes+magics))
(set-block-bytecodes! s:file-block
(map compile
(map cadr sources+bytecodes+magics))))
(set-block-magics! s:file-block (map caddr sources+bytecodes+magics))))])
(map cadr sources+bytecodes+magics)))
(set-block-magics! s:file-block (map caddr sources+bytecodes+magics)))))])
(verbose-time core-thunk))
;;-----------------------------------------------------------------------
;; Run a preprocessing phase on the input
;;

33
collects/compiler/private/to-core.ss
View File

@ -5,7 +5,12 @@
(lib "boundmap.ss" "syntax"))
(provide top-level-to-core)
;; `module', `require', and `require-for-syntax' declarations must
;; not be embedded in a `begin' sequence. For `require' and
;; `require-for-syntax', it's a timing issue. For `module', it's
;; because the transformation can only handle a single `module'
;; declaration.
(define (top-level-to-core stx lookup-stx set-stx safe-vector-ref-stx extract-stx)
(syntax-case stx (module begin)
[(module m lang (plain-module-begin decl ...))
@ -154,7 +159,17 @@
(filter is-run-time? decls))]
[ct-rhs #`((let ([magic (car (cons '#,magic-sym 2))])
(if (symbol? magic)
(lambda (x) (make-vector #,(length decls) void))
(lambda (x) (vector
#,@(map (lambda (stx)
(syntax-case stx ()
[(def (id) . _)
#'void]
[(def (id ...) . _)
(with-syntax ([(v ...) (map (lambda (x) #f)
(syntax->list #'(id ...)))])
#`(lambda () (values v ...)))]))
(filter (lambda (x) (not (is-run-time? x))) decls))))
(car magic)))
(vector #,@(vars-sequence ct-vars)))]
[rt-rhs #`((cdr '#,magic-sym) (vector #,@(vars-sequence rt-vars)))]
@ -184,7 +199,15 @@
(lambda (#,run-time)
#,@(extract-vars rt-vars run-time extract-stx)
(vector #,@rt-converted)))
#`(;; Lift define-for-values binding to front, so they can be referenced
#`(;; Lift require and require-for-syntaxes to the front, so they're ready for
;; variable references
#,@(filter (lambda (decl)
(syntax-case decl (require require-for-syntax)
[(require . _) #t]
[(require-for-syntax . _) #t]
[_else #f]))
decls)
;; Lift define-for-values binding to front, so they can be referenced
;; in compile-time definition
#,@(let ([ids (apply
append
@ -212,9 +235,9 @@
[(provide . _)
(car decls)]
[(require . _)
(car decls)]
#'(void)]
[(require-for-syntax . _)
(car decls)]
#'(void)]
[(require-for-template . _)
(car decls)]
[(define-values (id ...) rhs)