From b26bf5e2253341f4cb0510a6f243ea5ef81bf05d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 8 May 2010 09:48:35 -0600 Subject: [PATCH] fix DrRacket printing styles and distinguish 'print' vs. 'write' --- .../private/language-configuration.rkt | 18 +-- collects/drscheme/private/language.rkt | 107 ++++++++++-------- collects/drscheme/private/module-language.rkt | 12 +- collects/drscheme/private/tools-drs.rkt | 8 +- collects/drscheme/private/tools.rkt | 9 +- collects/drscheme/tool-lib.rkt | 28 +++-- collects/eopl/eopl-tool.rkt | 9 +- collects/eopl/lang/reader.rkt | 1 + collects/lang/htdp-langs.rkt | 35 +++--- collects/scribblings/drracket/printing.scrbl | 48 ++++---- 10 files changed, 170 insertions(+), 105 deletions(-) diff --git a/collects/drscheme/private/language-configuration.rkt b/collects/drscheme/private/language-configuration.rkt index 453157ecc8..df1f1dce5a 100644 --- a/collects/drscheme/private/language-configuration.rkt +++ b/collects/drscheme/private/language-configuration.rkt @@ -1433,21 +1433,25 @@ (read-curly-brace-as-paren #f) (read-accept-infix-dot #f) (print-mpair-curly-braces #f) - (print-vector-length #f) - (print-as-expression #f)))) + (print-vector-length #f)))) (define/override (get-transformer-module) #f) (define/override (default-settings) - (make-simple-settings+assume #f 'write 'mixed-fraction-e #f #t 'debug #t)) + (make-simple-settings+assume #f 'trad-write 'mixed-fraction-e #f #t 'debug #t)) (super-new))) (define (pretty-big-mixin %) (class % - (define/override (on-execute setting run-in-user-thread) - (super on-execute setting run-in-user-thread) - (run-in-user-thread - (λ () (print-as-expression #f)))) + (define/override (default-settings) + (let ([s (super default-settings)]) + (make-simple-settings+assume (drracket:language:simple-settings-case-sensitive s) + 'trad-write + (drracket:language:simple-settings-fraction-style s) + (drracket:language:simple-settings-show-sharing s) + (drracket:language:simple-settings-insert-newlines s) + (drracket:language:simple-settings-annotations s) + (simple-settings+assume-no-redef? s)))) (super-new))) (define get-all-scheme-manual-keywords diff --git a/collects/drscheme/private/language.rkt b/collects/drscheme/private/language.rkt index 147ced6521..e18a965980 100644 --- a/collects/drscheme/private/language.rkt +++ b/collects/drscheme/private/language.rkt @@ -161,7 +161,7 @@ (= (vector-length printable) (procedure-arity make-simple-settings)) (boolean? (vector-ref printable 0)) - (memq (vector-ref printable 1) '(constructor quasiquote write)) + (memq (vector-ref printable 1) '(constructor quasiquote write trad-write print)) (memq (vector-ref printable 2) '(mixed-fraction mixed-fraction-e @@ -172,7 +172,7 @@ (memq (vector-ref printable 5) '(none debug debug/profile test-coverage)) (apply make-simple-settings (vector->list printable)))) (define/public (default-settings) - (make-simple-settings #t 'write 'mixed-fraction-e #f #t 'debug)) + (make-simple-settings #t 'print 'mixed-fraction-e #f #t 'debug)) (define/public (default-settings? x) (equal? (simple-settings->vector x) (simple-settings->vector (default-settings)))) @@ -198,7 +198,7 @@ insert-newlines annotations)) ;; case-sensitive : boolean - ;; printing-style : (union 'write 'constructor 'quasiquote) + ;; printing-style : (union 'print 'write 'trad-write 'constructor 'quasiquote) ;; fraction-style : (union 'mixed-fraction 'mixed-fraction-e 'repeating-decimal 'repeating-decimal-e) ;; show-sharing : boolean ;; insert-newlines : boolean @@ -267,18 +267,21 @@ (string-constant output-style-label) (list (string-constant constructor-printing-style) (string-constant quasiquote-printing-style) + (string-constant write-printing-style) (string-constant print-printing-style)) output-panel - (λ (rb evt) - (let ([on? (not (= (send rb get-selection) 3))]) - (send fraction-style enable on?) - (send show-sharing enable on?) - (send insert-newlines enable on?))) + (λ (rb evt) (enable-fraction-style)) '(horizontal vertical-label))] [fraction-style (make-object check-box% (string-constant decimal-notation-for-rationals) output-panel void)] + [enable-fraction-style + (lambda () + (let ([on? (member (send output-style get-selection) '(0 1))]) + (send fraction-style enable on?) + (send show-sharing enable on?) + (send insert-newlines enable on?)))] [show-sharing (make-object check-box% (string-constant sharing-printing-label) output-panel @@ -299,7 +302,8 @@ (case (send output-style get-selection) [(0) 'constructor] [(1) 'quasiquote] - [(2) 'write]) + [(2) 'trad-write] + [(3) 'print]) (if (send fraction-style get-value) 'repeating-decimal-e 'mixed-fraction-e) @@ -320,7 +324,9 @@ (case (simple-settings-printing-style settings) [(constructor) 0] [(quasiquote) 1] - [(write) 2])) + [(write trad-write) 2] + [(print) 3])) + (enable-fraction-style) (send fraction-style set-value (eq? (simple-settings-fraction-style settings) 'repeating-decimal-e)) (send show-sharing set-value (simple-settings-show-sharing settings)) @@ -333,21 +339,28 @@ ;; simple-module-based-language-render-value/format : TST settings port (union #f (snip% -> void)) (union 'infinity number) -> void (define (simple-module-based-language-render-value/format value settings port width) - (let ([converted-value (simple-module-based-language-convert-value value settings)]) - (setup-printing-parameters - (λ () - (cond - [(simple-settings-insert-newlines settings) - (if (number? width) - (parameterize ([pretty-print-columns width]) - (pretty-print converted-value port)) - (pretty-print converted-value port))] - [else - (parameterize ([pretty-print-columns 'infinity]) - (pretty-print converted-value port)) - (newline port)])) - settings - width))) + (let-values ([(converted-value write?) + (call-with-values + (lambda () + (simple-module-based-language-convert-value value settings)) + (case-lambda + [(converted-value) (values converted-value #t)] + [(converted-value write?) (values converted-value write?)]))]) + (let ([pretty-out (if write? pretty-write pretty-print)]) + (setup-printing-parameters + (λ () + (cond + [(simple-settings-insert-newlines settings) + (if (number? width) + (parameterize ([pretty-print-columns width]) + (pretty-out converted-value port)) + (pretty-out converted-value port))] + [else + (parameterize ([pretty-print-columns 'infinity]) + (pretty-out converted-value port)) + (newline port)])) + settings + width)))) (define default-pretty-print-current-style-table (pretty-print-current-style-table)) @@ -415,11 +428,11 @@ (write-special (render-syntax/snip value) port)] [else (write-special (value->snip value) port)]))] [print-graph - ;; only turn on print-graph when using `write' printing - ;; style because the sharing is being taken care of + ;; only turn on print-graph when using `write' or `print' printing + ;; style, because the sharing is being taken care of ;; by the print-convert sexp construction when using ;; other printing styles. - (and (eq? (simple-settings-printing-style settings) 'write) + (and (memq (simple-settings-printing-style settings) '(write print)) (simple-settings-show-sharing settings))]) (thunk)))) @@ -429,7 +442,8 @@ ;; simple-module-based-language-convert-value : TST settings -> TST (define (simple-module-based-language-convert-value value settings) (case (simple-settings-printing-style settings) - [(write) value] + [(print) (values value #f)] + [(write trad-write) value] [(constructor) (parameterize ([constructor-style-printing #t] [show-sharing (simple-settings-show-sharing settings)] @@ -477,11 +491,16 @@ (global-port-print-handler (λ (value port) - (let ([converted-value (simple-module-based-language-convert-value value setting)]) + (let-values ([(converted-value write?) + (call-with-values + (lambda () (simple-module-based-language-convert-value value setting)) + (case-lambda + [(converted-value) (values converted-value #t)] + [(converted-value write?) (values converted-value write?)]))]) (setup-printing-parameters (λ () (parameterize ([pretty-print-columns 'infinity]) - (pretty-print converted-value port))) + ((if write? pretty-write pretty-print) converted-value port))) setting 'infinity)))) (current-inspector (make-inspector)) @@ -507,20 +526,18 @@ (define (render-value value port) (parameterize ([pretty-print-columns 'infinity]) - (pretty-print (convert-value value) port))) - - (define (convert-value value) - ,(case (simple-settings-printing-style setting) - [(write) `value] - [(constructor) - `(parameterize ([constructor-style-printing #t] - [show-sharing ,(simple-settings-show-sharing setting)]) - (print-convert value))] - [(quasiquote) - `(parameterize ([constructor-style-printing #f] - [show-sharing ,(simple-settings-show-sharing setting)]) - (print-convert value))])) - + ,(case (simple-settings-printing-style setting) + [(print) `(pretty-print value port)] + [(write trad-write) `(pretty-write value port)] + [(constructor) + `(parameterize ([constructor-style-printing #t] + [show-sharing ,(simple-settings-show-sharing setting)]) + (pretty-write (print-convert value) port))] + [(quasiquote) + `(parameterize ([constructor-style-printing #f] + [show-sharing ,(simple-settings-show-sharing setting)]) + (pretty-write (print-convert value) port))]))) + ,(if (memq (simple-settings-annotations setting) '(debug debug/profile test-coverage)) `(require errortrace) `(void)) diff --git a/collects/drscheme/private/module-language.rkt b/collects/drscheme/private/module-language.rkt index 97fdf4a723..ddc2d646e0 100644 --- a/collects/drscheme/private/module-language.rkt +++ b/collects/drscheme/private/module-language.rkt @@ -106,7 +106,7 @@ (define/override (default-settings) (let ([super-defaults (super default-settings)]) (make-module-language-settings - #t 'write 'mixed-fraction-e #f #t 'debug;; simple settings defaults + #t 'print 'mixed-fraction-e #f #t 'debug;; simple settings defaults '(default) #() @@ -163,7 +163,15 @@ (andmap string? (vector->list command-line-args)) (string? auto-text) (boolean? compilation-on?) - (let ([super (super unmarshall-settings (car marshalled))]) + (let ([super (super unmarshall-settings + (let ([p (car marshalled)]) + ;; Convert 'write to 'print: + (if (eq? (vector-ref p 1) 'write) + (list->vector + (list* (vector-ref p 0) + 'print + (cddr (vector->list p)))) + p)))]) (and super (apply make-module-language-settings (append diff --git a/collects/drscheme/private/tools-drs.rkt b/collects/drscheme/private/tools-drs.rkt index e31551b0a4..131ec04260 100644 --- a/collects/drscheme/private/tools-drs.rkt +++ b/collects/drscheme/private/tools-drs.rkt @@ -19,7 +19,8 @@ This file sets up the right lexical environment to invoke the tools that want to mrlib/switchable-button string-constants) -(require (for-syntax racket/base racket/match)) +(require (for-syntax racket/base racket/match + compiler/cm-accomplice)) (import [prefix drscheme:frame: drracket:frame^] [prefix drscheme:unit: drracket:unit^] @@ -41,12 +42,15 @@ This file sets up the right lexical environment to invoke the tools that want to (syntax-case stx () [(_ body tool-name) (let () + (define tool-lib-src (build-path (collection-path "drscheme") "tool-lib.rkt")) (define full-sexp - (call-with-input-file (build-path (collection-path "drscheme") "tool-lib.rkt") + (call-with-input-file tool-lib-src (λ (port) (parameterize ([read-accept-reader #t]) (read port))))) + (register-external-file tool-lib-src) + (let loop ([sexp full-sexp]) (match sexp [`((#%module-begin ,body ...)) diff --git a/collects/drscheme/private/tools.rkt b/collects/drscheme/private/tools.rkt index 340441e47f..4d195a30a8 100644 --- a/collects/drscheme/private/tools.rkt +++ b/collects/drscheme/private/tools.rkt @@ -13,7 +13,8 @@ mrlib/switchable-button string-constants) -(require (for-syntax racket/base racket/match)) +(require (for-syntax racket/base racket/match + compiler/cm-accomplice)) (import [prefix drracket:frame: drracket:frame^] [prefix drracket:unit: drracket:unit^] @@ -322,11 +323,15 @@ string-constants) (syntax-case stx () [(_ body tool-name) (let () + (define tool-lib-src (build-path (collection-path "drscheme") "tool-lib.rkt")) + (define full-sexp - (call-with-input-file (build-path (collection-path "drscheme") "tool-lib.rkt") + (call-with-input-file tool-lib-src (λ (port) (parameterize ([read-accept-reader #t]) (read port))))) + + (register-external-file tool-lib-src) (let loop ([sexp full-sexp]) (match sexp diff --git a/collects/drscheme/tool-lib.rkt b/collects/drscheme/tool-lib.rkt index d2827718a1..df3c9a132f 100644 --- a/collects/drscheme/tool-lib.rkt +++ b/collects/drscheme/tool-lib.rkt @@ -1433,15 +1433,23 @@ all of the names in the tools library, for use defining keybindings (proc-doc/names drracket:language:simple-module-based-language-convert-value - (-> any/c drracket:language:simple-settings? any/c) + (-> any/c drracket:language:simple-settings? any) (value settings) - @{Sets the @racket[constructor-style-printing] and @racket[show-sharing] - parameters based on @racket[settings] and sets @racket[current-print-convert-hook] - to ignore snips and then uses @racket[print-convert] on @racket[value]. - - Unless, of course, the @racket[settings] argument has @racket['write] in - the @racket[simple-settings-printing-style] field, in which case it simply - returns @racket[value].}) + @{The result can be either one or two values. The first result is + the converted value. The second result is @racket[#t] if the converted + value should be printed with @racket[write] (or @racket[pretty-write]), + @racket[#f] if the converted result should be printed with + @racket[print] (or @racket[pretty-print]); the default second + result is @racket[#t]. + + The default implementation of this method depends on the + @racket[simple-settings-printing-style] field of @racket[settings]. + If it is @racket['print], the + result is @racket[(values value #f)]. If it is @racket['write] or @racket['trad-write], + the result is just @racket[value]. Otherwise, the result is produce by + adjusting the @racket[constructor-style-printing] and @racket[show-sharing] + parameters based on @racket[settings], setting @racket[current-print-convert-hook] + to ignore snips, and then applying @racket[print-convert] to @racket[value].}) (proc-doc/names drracket:language:setup-printing-parameters @@ -1500,7 +1508,7 @@ all of the names in the tools library, for use defining keybindings drracket:language:simple-settings-printing-style (drracket:language:simple-settings? . -> . - (symbols 'constructor 'quasiquote 'write)) + (symbols 'constructor 'quasiquote 'write 'print)) (simple-settings) @{Extracts the printing-style setting from a simple-settings.}) @@ -1554,7 +1562,7 @@ all of the names in the tools library, for use defining keybindings (proc-doc/names drracket:language:make-simple-settings (-> boolean? - (symbols 'constructor 'quasiquote 'write) + (symbols 'constructor 'quasiquote 'write 'trad-write 'print) (symbols 'mixed-fraction 'mixed-fraction-e 'repeating-decimal 'repeating-decimal-e) boolean? boolean? diff --git a/collects/eopl/eopl-tool.rkt b/collects/eopl/eopl-tool.rkt index 7d1a11925c..87384f8333 100644 --- a/collects/eopl/eopl-tool.rkt +++ b/collects/eopl/eopl-tool.rkt @@ -46,12 +46,19 @@ wraps the load of the module.) (drscheme:language:simple-module-based-language->module-based-language-mixin language-base%)) (define/override (use-namespace-require/copy?) #t) + (define/override (default-settings) + (let ([s (super default-settings)]) + (drscheme:language:make-simple-settings (drscheme:language:simple-settings-case-sensitive s) + 'trad-write + (drscheme:language:simple-settings-fraction-style s) + (drscheme:language:simple-settings-show-sharing s) + (drscheme:language:simple-settings-insert-newlines s) + (drscheme:language:simple-settings-annotations s)))) (define/override (on-execute settings run-in-user-thread) (super on-execute settings run-in-user-thread) (print-mpair-curly-braces #f) (run-in-user-thread (lambda () - (print-as-expression #f) ((namespace-variable-value 'install-eopl-exception-handler))))) (super-instantiate ()))) diff --git a/collects/eopl/lang/reader.rkt b/collects/eopl/lang/reader.rkt index 8bc9b08724..b8b5aa123e 100644 --- a/collects/eopl/lang/reader.rkt +++ b/collects/eopl/lang/reader.rkt @@ -1,2 +1,3 @@ #lang s-exp syntax/module-reader eopl +#:language-info '#(scheme/language-info get-info #f) diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index 0396a1a496..9be1b078b5 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -196,17 +196,24 @@ (set-printing-parameters settings (λ () - (let ([converted-value (drscheme:language:simple-module-based-language-convert-value value settings)]) - (cond - [(drscheme:language:simple-settings-insert-newlines settings) - (if (number? width) - (parameterize ([pretty-print-columns width]) - (pretty-write converted-value port)) - (pretty-write converted-value port))] - [else - (parameterize ([pretty-print-columns 'infinity]) - (pretty-write converted-value port)) - (newline port)]))))) + (let-values ([(converted-value write?) + (call-with-values + (lambda () + (drscheme:language:simple-module-based-language-convert-value value settings)) + (case-lambda + [(converted-value) (values converted-value #t)] + [(converted-value write?) (values converted-value write?)]))]) + (let ([pretty-out (if write? pretty-write pretty-print)]) + (cond + [(drscheme:language:simple-settings-insert-newlines settings) + (if (number? width) + (parameterize ([pretty-print-columns width]) + (pretty-out converted-value port)) + (pretty-out converted-value port))] + [else + (parameterize ([pretty-print-columns 'infinity]) + (pretty-out converted-value port)) + (newline port)])))))) settings width)) @@ -309,13 +316,11 @@ (case (drscheme:language:simple-settings-printing-style settings) [(constructor) 0] [(quasiquote) 1] - [(write) 2] - [(print) 2]) + [(print trad-write write) 2]) (case (drscheme:language:simple-settings-printing-style settings) [(constructor) 0] [(quasiquote) 0] - [(write) 1] - [(print) 1]))) + [(print trad-write write) 1]))) (send fraction-style set-selection (case (drscheme:language:simple-settings-fraction-style settings) [(mixed-fraction) 0] diff --git a/collects/scribblings/drracket/printing.scrbl b/collects/scribblings/drracket/printing.scrbl index 105e2f570a..44fb00eb7f 100644 --- a/collects/scribblings/drracket/printing.scrbl +++ b/collects/scribblings/drracket/printing.scrbl @@ -34,8 +34,8 @@ determines how evaluation results are printed in the @tech{interactions window}. This setting also applies to output generated by calling @racket[print] explicitly. -The following table illustrates the difference between the different -output styles: +The @onscreen{print} style is the normal Racket output style. The +following table illustrates the other output styles: @print-table[ [(cons 1 2) (cons 1 2) `(1 . 2) (1 . 2)] @@ -54,30 +54,36 @@ output styles: [(regexp "a") (regexp "a") (regexp "a") #rx"a"] ] -The @as-index{@onscreen{Constructor} output} mode treats -@racket[cons], @racket[vector], and similar primitives as value -constructors, rather than functions. It also treats @racket[list] as -shorthand for multiple @racket[cons]'s ending with the empty list. -@onscreen{Constructor} output is especially valuable for beginning -programmers, because output values look the same as input values. +The @as-index{@onscreen{Constructor} output} mode is similar to +Rackets normal print mode, except that even quotable are still printed +with constructors, constructor functions and forms are used to +approximate some otherwise unprintable values. For example, +@onscreen{Constructor} output prints a procedure in a +@racketresult[lambda] form. For output to a graphical context, +rational numbers are printed using a special @racket[snip%] object +that lets the user choose between improper fractions, mixed fractions, +and repeating decimals. The @as-index{@onscreen{Quasiquote} output} mode is like @onscreen{Constructor} output, but it uses @racket[quasiquote] (abbreviated with @litchar{`}) to print lists, and it uses @racket[unquote] (abbreviated with @litchar{,}) to escape back to -@onscreen{Constructor} printing as needed. This mode provides the same -benefit as @onscreen{Constructor} output, in that printed results are -expressions, but it is more convenient for many kinds of data, -especially data that represents expressions. +@onscreen{Constructor} printing as needed. The @as-index{@onscreen{write} output} mode corresponds to traditional -Scheme printing via the @racket[print] procedure, which defaults to -@racket[write]-like printing, as shown in the last column. +Scheme printing via the @racket[write] procedure. For example, lists +print by parenthesizing the printed form of the list elements, without +a leading quote mark or a constructor name. -DrRacket also sets the @racket[global-port-print-handler] in order to -customize a few aspects of the printing for all of these modes, namely -printing the symbol @racket[quote] as a single tick mark (mutatis -mutandis for @racket[quasiquote], @racket[unquote], and -@racket[unquote-splicing]), and to print rational real numbers using a -special @racket[snip%] object that lets the user choose between -improper fractions, mixed fractions, and repeating decimals. +Finally, the @as-index{@onscreen{print} output} mode corresponds to +Racket's default printing via the @racket[print] procedure. Output via +@racket[print] is further configurable through run-time settings, such +as the @racket[print-as-expression] parameter, and it may be adjusted +by a @hash-lang[]-specified language. For example, the +@racketmodname[scheme] language sets the @racket[print-as-expression] +parameter to @racket[#f], which essentially makes @onscreen{print} +mode act like @onscreen{write} mode. + +For any of the output styles, DrRacket sets the +@racket[global-port-print-handler] so that the @racket[print] +procedure produces output as selected.