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

added optional arg to expand-teaching-program

Browse Source 
svn: r8766
This commit is contained in:
John Clements 2008-02-22 20:53:39 +00:00
parent 46f6deeae9
commit cc2e1464e8
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/lang/run-teaching-program.ss
View File

@ -7,14 +7,15 @@
scheme/contract)
(provide/contract
[expand-teaching-program (-> input-port?
[expand-teaching-program (->* (input-port?
(-> any/c input-port? any/c)
any/c
(listof any/c)
(or/c false/c (object-contract [display-results/void (-> (listof any/c) any)]))
(or/c false/c (object-contract [display-results/void (-> (listof any/c) any)])))
(symbol?)
any)])
(define (expand-teaching-program port reader language-module teachpacks rep)
(define (expand-teaching-program port reader language-module teachpacks rep [module-name '#%htdp])
(let ([state 'init]
;; state : 'init => 'require => 'done-or-exn
@ -32,7 +33,7 @@
(expand
(datum->syntax
#f
`(,#'module #%htdp ,language-module
`(,#'module ,module-name ,language-module
,@(map (λ (x)
`(require ,x))
teachpacks)))))])
@ -53,23 +54,23 @@
(expand
(datum->syntax
#f
`(,#'module #%htdp ,language-module
`(,#'module ,module-name ,language-module
,@(map (λ (x) `(require ,x)) teachpacks)
,@body-exps)))
rep)))]
[(require)
(set! state 'done-or-exn)
(stepper-syntax-property
(syntax
(quasisyntax
(let ([done-already? #f])
(dynamic-wind
void
(lambda ()
(dynamic-require ''#%htdp #f)) ;; work around a bug in dynamic-require
(dynamic-require ''#,module-name #f)) ;; work around a bug in dynamic-require
(lambda ()
(unless done-already?
(set! done-already? #t)
(current-namespace (module->namespace ''#%htdp)))))))
(current-namespace (module->namespace ''#,module-name)))))))
'stepper-skip-completely
#t)]
[(done-or-exn)