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

changed set! result and its printing for teaching languages

Browse Source 
svn: r752
This commit is contained in:
Robby Findler 2005-09-02 15:51:49 +00:00
parent 828a942f58
commit 8848a3f7ec
4 changed files with 34 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/drscheme/private/language.ss
View File

@ -392,19 +392,19 @@
[(constructor)
(parameterize ([constructor-style-printing #t]
[show-sharing (simple-settings-show-sharing settings)]
[current-print-convert-hook leave-snips-alone-hook])
[current-print-convert-hook (leave-snips-alone-hook (current-print-convert-hook))])
(print-convert value))]
[(quasiquote)
(parameterize ([constructor-style-printing #f]
[show-sharing (simple-settings-show-sharing settings)]
[current-print-convert-hook leave-snips-alone-hook])
[current-print-convert-hook (leave-snips-alone-hook (current-print-convert-hook))])
(print-convert value))]))
;; leave-snips-alone-hook : any? (any? -> printable) any? -> printable
(define (leave-snips-alone-hook expr basic-convert sub-convert)
(define ((leave-snips-alone-hook sh) expr basic-convert sub-convert)
(if (is-a? expr snip%)
expr
(basic-convert expr)))
(sh expr basic-convert sub-convert)))
;; initialize-simple-module-based-language : setting ((-> void) -> void)
(define (initialize-simple-module-based-language setting run-in-user-thread)
@ -501,7 +501,7 @@
(mixin (module-based-language<%>) (language<%>)
(inherit get-module get-transformer-module use-namespace-require/copy?
get-init-code use-mred-launcher get-reader)
(define/public (get-comment-character) (values "; " #\;))
(define/public (order-manuals x) (values x #t))

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

@ -24,7 +24,11 @@ tracing todo:
(lib "mred.ss" "mred")
(lib "bday.ss" "framework" "private")
(lib "moddep.ss" "syntax")
(lib "cache-image-snip.ss" "mrlib"))
(lib "cache-image-snip.ss" "mrlib")
;; this module is shared between the drscheme's namespace (so loaded here)
;; and the user's namespace in the teaching languages
"private/set-result.ss")
(provide tool@)
@ -122,11 +126,14 @@ tracing todo:
(sharing/not-config-panel (get-allow-sharing?) parent))
(define/override (on-execute settings run-in-user-thread)
(let ([drs-namespace (current-namespace)])
(let ([drs-namespace (current-namespace)]
[set-result-module-name
((current-module-name-resolver) '(lib "set-result.ss" "lang" "private") #f #f)])
(run-in-user-thread
(lambda ()
(read-accept-quasiquote (get-accept-quasiquote?))
(namespace-attach-module drs-namespace 'drscheme-secrets)
(namespace-attach-module drs-namespace set-result-module-name)
(error-display-handler teaching-languages-error-display-handler)
(current-eval (add-annotation (htdp-lang-settings-tracing? settings) (current-eval)))
(error-print-source-location #f)
@ -139,6 +146,12 @@ tracing todo:
(define/public (set-printing-parameters settings thunk)
(parameterize ([pc:booleans-as-true/false #t]
[pc:abbreviate-cons-as-list (get-abbreviate-cons-as-list)]
[pc:current-print-convert-hook
(let ([ph (pc:current-print-convert-hook)])
(lambda (val basic sub)
(cond
[(equal? val set!-result) '(void)]
[else (ph val basic sub)])))]
[pretty-print-show-inexactness #t]
[pretty-print-exact-as-decimal #t]
[pc:use-named/undefined-handler
@ -280,6 +293,7 @@ tracing todo:
(define (language-extension %)
(class %
(inherit get-manual)
(define/override (order-manuals x)
(values (list (get-manual) #"teachpack" #"drscheme" #"help") #f))

10
collects/lang/private/set-result.ss Normal file
View File

@ -0,0 +1,10 @@
;; this module is shared between drscheme's and the user's namespace
;; the printer uses it, printing it as (void), so that ordinary
;; (void) results can still be ignored by the printer.
(module set-result mzscheme
(provide set!-result)
(define set!-result
(let ()
(define-struct set!-result ())
(make-set!-result))))

5
collects/lang/private/teach.ss
View File

@ -26,7 +26,8 @@
(module teach mzscheme
(require (lib "etc.ss")
(lib "list.ss")
(lib "math.ss"))
(lib "math.ss")
"set-result.ss")
(require-for-syntax "teachhelp.ss"
(lib "kerncase.ss" "syntax")
(lib "stx.ss" "syntax")
@ -1762,7 +1763,7 @@
exprs
null)
(if continuing?
(syntax/loc stx (set! id expr ...))
(syntax/loc stx (begin (set! id expr ...) set!-result))
(syntax-property
(syntax/loc stx (#%app values (advanced-set!-continue id expr ...)))
'stepper-skipto