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

made teachpacks still appear in the REPL even if there is a syntax error

Browse Source 
svn: r7224
This commit is contained in:
Robby Findler 2007-08-30 02:32:27 +00:00
parent 2be282a0be
commit 143faecd33
1 changed files with 45 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
collects/lang/htdp-langs.ss
View File

@ -491,38 +491,51 @@
(define/override (front-end/complete-program port settings) (define/override (front-end/complete-program port settings)
(let ([state 'init] (let ([state 'init]
;; state : 'init => 'require => 'done ;; state : 'init => 'require => 'done-or-exn
[reader (get-reader)]) [reader (get-reader)]
;; in state 'done-or-exn, if this is an exn, we raise it
;; otherwise, we just return eof
[saved-exn #f])
(lambda () (lambda ()
(case state (case state
[(init) [(init)
(set! state 'require) (set! state 'require)
(let ([body-exps (let ([language-module (get-module)])
(let loop () (with-handlers ([exn:fail?
(let ([result (reader (object-name port) port)]) (λ (x)
(if (eof-object? result) (set! saved-exn x)
null (expand
(cons result (loop)))))] (datum->syntax-object
[language-module (get-module)]) #f
(for-each `(,#'module #%htdp ,language-module
(λ (tp) ,@(map (λ (x) `(require ,x))
(with-handlers ((exn:fail? (λ (x) (error 'teachpack (missing-tp-message tp))))) (htdp-lang-settings-teachpacks settings))))))])
(unless (file-exists? (build-path (apply collection-path (cddr tp)) (let ([body-exps
(cadr tp))) (let loop ()
(error)))) (let ([result (reader (object-name port) port)])
(htdp-lang-settings-teachpacks settings)) (if (eof-object? result)
(rewrite-module null
settings (cons result (loop)))))])
(expand (for-each
(datum->syntax-object (λ (tp)
#f (with-handlers ((exn:fail? (λ (x) (error 'teachpack (missing-tp-message tp)))))
`(,#'module #%htdp ,language-module (unless (file-exists? (build-path (apply collection-path (cddr tp))
,@(map (λ (x) `(require ,x)) (cadr tp)))
(htdp-lang-settings-teachpacks settings)) (error))))
,@body-exps)))))] (htdp-lang-settings-teachpacks settings))
(rewrite-module
settings
(expand
(datum->syntax-object
#f
`(,#'module #%htdp ,language-module
,@(map (λ (x) `(require ,x))
(htdp-lang-settings-teachpacks settings))
,@body-exps)))))))]
[(require) [(require)
(set! state 'done) (set! state 'done-or-exn)
(syntax (syntax
(let ([done-already? #f]) (let ([done-already? #f])
(dynamic-wind (dynamic-wind
@ -534,7 +547,12 @@
(unless done-already? (unless done-already?
(set! done-already? #t) (set! done-already? #t)
(current-namespace (module->namespace '#%htdp)))))))] (current-namespace (module->namespace '#%htdp)))))))]
[(done) eof])))) [(done-or-exn)
(cond
[saved-exn
(raise saved-exn)]
[else
eof])]))))
(define/private (missing-tp-message x) (define/private (missing-tp-message x)
(let* ([m (regexp-match #rx"/([^/]*)$" (cadr x))] (let* ([m (regexp-match #rx"/([^/]*)$" (cadr x))]