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

stepper mangling

Browse Source 
svn: r8330
This commit is contained in:
John Clements 2008-01-15 06:27:43 +00:00
parent bfdb90e5cb
commit 2d79a5d789
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/stepper/module-elaborator.ss
View File

@ -11,11 +11,12 @@
(let ([new-module-id (gensym "-htdp")])
(with-syntax ([(tp-spec ...) teachpack-specs])
(list (let ([mod (expand #`(module #,new-module-id #,language-module-spec
(require-for-syntax mzscheme)
;; why was this here? (JBC,2007-12-15)
#;(require-for-syntax mzscheme)
(require tp-spec ...)
#,@exps))])
(rewrite-module mod))
#`(require #,new-module-id)
#`(require (quote #,new-module-id))
; #`(let ([done-already? #f])
; (dynamic-wind
; void
@ -31,6 +32,7 @@
;; print out all results.
(define (rewrite-module stx)
(printf "expanded: ~s\n" stx)
(syntax-case stx (module #%plain-module-begin)
[(module name lang (#%plain-module-begin bodies ...))
(with-syntax ([(rewritten-bodies ...)
@ -52,7 +54,7 @@
(syntax (provide ids ...))))]
[else
(let ([body (car bodies)])
(syntax-case body (define-values define-syntaxes require require-for-syntax provide)
(syntax-case body (define-values define-syntaxes #%require require-for-syntax provide)
[(define-values (new-vars ...) e)
(cons body (loop (cdr bodies)
(append
@ -63,7 +65,7 @@
(append
ids
(filter-ids (syntax (new-vars ...))))))]
[(require specs ...)
[(#%require specs ...)
(cons body (loop (cdr bodies) ids))]
[(require-for-syntax specs ...)
(cons body (loop (cdr bodies) ids))]