From 8848a3f7ec852723f1fc2f10638120aab88dc5aa Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 2 Sep 2005 15:51:49 +0000 Subject: [PATCH] changed set! result and its printing for teaching languages svn: r752 --- collects/drscheme/private/language.ss | 10 +++++----- collects/lang/htdp-langs.ss | 18 ++++++++++++++++-- collects/lang/private/set-result.ss | 10 ++++++++++ collects/lang/private/teach.ss | 5 +++-- 4 files changed, 34 insertions(+), 9 deletions(-) create mode 100644 collects/lang/private/set-result.ss diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index 720116c057..fa30e34767 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -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)) diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss index 411b905dfd..cb77b2e8a8 100644 --- a/collects/lang/htdp-langs.ss +++ b/collects/lang/htdp-langs.ss @@ -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)) diff --git a/collects/lang/private/set-result.ss b/collects/lang/private/set-result.ss new file mode 100644 index 0000000000..8cd83ad0b0 --- /dev/null +++ b/collects/lang/private/set-result.ss @@ -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)))) + diff --git a/collects/lang/private/teach.ss b/collects/lang/private/teach.ss index 9b6e1b9e0e..84476386f6 100644 --- a/collects/lang/private/teach.ss +++ b/collects/lang/private/teach.ss @@ -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