From f1f47c5f1602a119a4d3d50637a986812693e76f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 11 Dec 2015 10:03:31 -0700 Subject: [PATCH] scribble/examples: revert logging change, add options The error-logging change in 81aeab1687 didn't work well for me in further experiments. Change `interactions`, etc., to have a `#:no-errors?` argument, instead. Also, add `eval:no-prompt`, which provides an alternative to `def+int`. Improve the documentaiton by correcting mistakes and filling in some missing exports. --- scribble-doc/scribblings/scribble/eval.scrbl | 91 +++++--- scribble-lib/scribble/eval.rkt | 222 +++++++++++++------ 2 files changed, 218 insertions(+), 95 deletions(-) diff --git a/scribble-doc/scribblings/scribble/eval.scrbl b/scribble-doc/scribblings/scribble/eval.scrbl index 3d789c68..f2832e61 100644 --- a/scribble-doc/scribblings/scribble/eval.scrbl +++ b/scribble-doc/scribblings/scribble/eval.scrbl @@ -13,11 +13,14 @@ utilities for evaluating code at document-build time and incorporating the results in the document, especially to show example uses of defined procedures and syntax.} -@defform/subs[(interaction maybe-eval maybe-escape datum ...) - ([maybe-eval code:blank +@defform/subs[(interaction maybe-options datum ...) + ([maybe-options maybe-eval maybe-escape maybe-disallow-errors] + [maybe-eval code:blank (code:line #:eval eval-expr)] [maybe-escape code:blank - (code:line #:escape escape-id)])]{ + (code:line #:escape escape-id)] + [maybe-disallow-errors code:blank + (code:line #:no-errors? no-errors?-expr)])]{ Like @racket[racketinput], except that the result for each input @racket[datum] is shown on the next line. The result is determined by @@ -27,10 +30,16 @@ evaluator produced by @racket[eval-expr], if provided. The @racket[eval-expr] must produce a sandbox evaluator via @racket[make-evaluator] or @racket[make-module-evaluator] with the @racket[sandbox-output] and @racket[sandbox-error-output] parameters -set to @racket['string]. If @racket[eval-expr] is not provided, an -evaluator is created using @racket[make-base-eval]. See also +set to @racket['string]. If @racket[eval-expr] is not provided or is +@racket[#f], an evaluator is created using @racket[make-base-eval]. See also @racket[make-eval-factory]. +If @racket[no-errors?-expr] is provided and produces a true +value, then when evaluating a @racket[datum] produces an error (and +@racket[datum] does not have an @racket[eval:error] wrapper), an +exception is raised by @racket[interaction]. Otherwise, any exception +produced by a @racket[datum] evaluation is typeset as an error result. + If the value of @racket[current-print] in the sandbox is changed from its default value, or if @racket[print-as-expression] in the sandbox is set to @racket[#f], then each evaluation result is formatted to a @@ -49,16 +58,20 @@ Certain patterns in @racket[datum] are treated specially: @racket[(@#,indexed-racket[code:line] _code-datum (@#,racketidfont{code:comment} _comment-datum ...))] is treated as @racket[_code-datum] for evaluation.} +@item{A @racket[datum] of the form + @racket[(@#,indexed-racket[code:line] _code-datum ...)] + evaluates each @racket[_code-datum], but only the last result is used.} + @item{Other uses of @racketidfont{code:comment}, @racketidfont{code:contract}, and @racketidfont{code:blank} are stripped from each @racket[datum] before evaluation.} - @item{A @racket[datum] of the form - @racket[(@#,indexed-racket[eval:error] #,(svar eval-datum))] - is treated like @racket[_eval-datum], but @racket[_eval-datum] is expected to - raise an exception: no error is logged if an exception is raised, - but an exception is raised if @racket[_eval-datum] - does @emph{not} raise an exception.} + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[eval:error] #,(svar eval-datum))] is + treated like @racket[_eval-datum], but @racket[_eval-datum] is + expected to raise an exception, and an error is shown as the + evaluation's result---even if @racket[#:no-errors? #t] is + specified for the @racket[interactions] form.} @item{A @racket[datum] of the form @racket[(@#,indexed-racket[eval:alts] #,(svar show-datum) #,(svar eval-datum))] @@ -86,11 +99,13 @@ Certain patterns in @racket[datum] are treated specially: should produce a list of @tech{content} for multiple results of evaluation. As with @racketidfont{eval:result}, @racket[_out-expr] and @racket[_err-expr] are optional.} -] + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[eval:no-prompt] _eval-datum ...)] + is treated like @racket[(@#,racket[code:line] _eval-datum ...)], but no prompt is shown before + the group, and a blank line is added before and after + @(svar eval-datum) and its result.} -By default, if evaluation raises an exception, an error is shown as -the evaluation's result, but an error is also logged. Use @racket[eval:error] -to avoid logging exceptions. +] As an example, @@ -112,27 +127,28 @@ As an example, uses an evaluator whose language is @racketmodname[typed/racket/base]. -@history[#:changed "1.14" @elem{Added @racket[eval:error] and added - logging of exceptions from expressions - that are not wrapped with - @racket[eval:error].}]} +@history[#:changed "1.14" @elem{Added @racket[#:no-errors?], + @racket[eval:no-prompt], and + @racket[eval:error], and changed + @racket[code:line] to support multiple + @racket[_datum]s.}]} -@defform[(interaction0 maybe-eval maybe-escape datum ...)]{ +@defform[(interaction0 maybe-options datum ...)]{ Like @racket[interaction], but without insetting the code via @racket[nested].} @defform[(interaction/no-prompt maybe-eval maybe-escape datum)]{ - Like @racket[interaction], but does not render the output with a prompt. + Like @racket[interaction], but does not render each @racket[datum] with a prompt. } -@defform[(interaction-eval maybe-eval maybe-escape datum)]{ +@defform[(interaction-eval maybe-eval datum)]{ Like @racket[interaction], evaluates the @racket[quote]d form of @racket[datum], but returns the empty string and does not catch exceptions (so @racket[eval:error] has no effect).} -@defform[(interaction-eval-show maybe-eval maybe-escape datum)]{ +@defform[(interaction-eval-show maybe-eval datum)]{ Like @racket[interaction-eval], but produces an element representing the printed form of the evaluation result.} @@ -153,30 +169,51 @@ Combines @racket[racketblock0] and @racket[interaction-eval].} Combines @racket[racketmod] and @racket[interaction-eval].} -@defform[(def+int maybe-eval maybe-escape defn-datum expr-datum ...)]{ +@defform[(def+int maybe-options defn-datum expr-datum ...)]{ Like @racket[interaction], except the @racket[defn-datum] is typeset as for @racket[racketblock] (i.e., no prompt) and a line of space is inserted before the @racket[expr-datum]s.} -@defform[(defs+int maybe-eval maybe-escape (defn-datum ...) expr-datum ...)]{ +@defform[(defs+int maybe-options (defn-datum ...) expr-datum ...)]{ Like @racket[def+int], but for multiple leading definitions.} -@defform[(examples maybe-eval maybe-escape datum ...)]{ +@defform[(examples maybe-options datum ...)]{ Like @racket[interaction], but with an ``Examples:'' label prefixed.} -@defform[(defexamples maybe-eval maybe-escape datum ...)]{ +@defform[(examples* label-expr maybe-options datum ...)]{ + +Like @racket[examples], but using the result of @racket[label-expr] in +place of the default ``Examples:'' label.} + + +@defform[(defexamples maybe-options datum ...)]{ Like @racket[examples], but each definition using @racket[define] or @racket[define-struct] among the @racket[datum]s is typeset without a prompt, and with line of space after it.} +@defform[(defexamples* label-expr maybe-options datum ...)]{ + +Like @racket[defexamples], but using the result of @racket[label-expr] in +place of the default ``Examples:'' label.} + + +@defproc*[([(as-examples [b block?]) block?] + [(as-examples [label (or/c block? content?)] + [b block?]) + block?])]{ + +Adds an ``examples'' label to @racket[b], using either a default label +or the given @racket[label].} + + @defproc[(make-base-eval [#:pretty-print? pretty-print? any/c #t] [#:lang lang (or/c module-path? diff --git a/scribble-lib/scribble/eval.rkt b/scribble-lib/scribble/eval.rkt index 52270868..d320d24b 100644 --- a/scribble-lib/scribble/eval.rkt +++ b/scribble-lib/scribble/eval.rkt @@ -127,34 +127,39 @@ (struct formatted-result (content)) -(define (interleave inset? title expr-paras val-list+outputs) +(define (interleave inset? title expr-paras promptless?+val-list+outputs) (let ([lines (let loop ([expr-paras expr-paras] - [val-list+outputs val-list+outputs] - [first? #t]) + [promptless?+val-list+outputs promptless?+val-list+outputs] + [first? #t] + [after-blank? #t]) (if (null? expr-paras) null (append + (if (and (caar promptless?+val-list+outputs) + (not after-blank?)) + (list (list (list blank-line))) + null) (list (list (let ([p (car expr-paras)]) (if (flow? p) p (make-flow (list p)))))) - (format-output (cadar val-list+outputs) output-color) - (format-output (caddar val-list+outputs) error-color) + (format-output (cadr (cdar promptless?+val-list+outputs)) output-color) + (format-output (caddr (cdar promptless?+val-list+outputs)) error-color) (cond - [(string? (caar val-list+outputs)) + [(string? (cadar promptless?+val-list+outputs)) ;; Error result case: (map (lambda (s) (define p (format-output s error-color)) (if (null? p) (list null) (car p))) - (string->wrapped-lines (caar val-list+outputs)))] - [(box? (caar val-list+outputs)) + (string->wrapped-lines (cadar promptless?+val-list+outputs)))] + [(box? (cadar promptless?+val-list+outputs)) ;; Output written to a port - (format-output-stream (unbox (caar val-list+outputs)) + (format-output-stream (unbox (cadar promptless?+val-list+outputs)) result-color)] [else ;; Normal result case: - (let ([val-list (caar val-list+outputs)]) + (let ([val-list (cadar promptless?+val-list+outputs)]) (if (equal? val-list (list (void))) null (map (lambda (v) @@ -166,7 +171,11 @@ (to-element/no-color v #:expr? (print-as-expression)))))))) val-list)))]) - (loop (cdr expr-paras) (cdr val-list+outputs) #f))))]) + (if (and (caar promptless?+val-list+outputs) + (pair? (cdr promptless?+val-list+outputs))) + (list (list (list blank-line))) + null) + (loop (cdr expr-paras) (cdr promptless?+val-list+outputs) #f (caar promptless?+val-list+outputs)))))]) (if inset? (let ([p (code-inset (make-table block-color lines))]) (if title @@ -213,26 +222,34 @@ (raise-argument-error 'eval:result "string?" err)) (eval-results (list content) out err)) -(define (extract-to-evaluate s) - (let loop ([s s] [expect #f] [error-expected? #f]) - (syntax-case s (code:line code:comment code:contract eval:alts eval:check eval:error) +(define (extract-to-evaluate s val handle-one) + (let loop ([val val] [s s] [expect #f] [error-expected? #f] [promptless? #f]) + (syntax-case s (code:line code:comment code:contract eval:no-prompt eval:alts eval:check eval:error) [(code:line v (code:comment . rest)) - (loop (extract s cdr car) expect error-expected?)] + (loop val (extract s cdr car) expect error-expected? promptless?)] + [(code:line v ...) + (for/fold ([val val]) ([v (in-list (extract s cdr))]) + (loop val v expect error-expected? promptless?))] [(code:comment . rest) - (values (nothing-to-eval) expect error-expected?)] + (handle-one val (nothing-to-eval) expect error-expected? promptless?)] [(code:contract . rest) - (values (nothing-to-eval) expect error-expected?)] + (handle-one val (nothing-to-eval) expect error-expected? promptless?)] + [(eval:no-prompt e ...) + (for/fold ([val val]) ([v (in-list (extract s cdr))]) + (handle-one val v expect error-expected? #t))] [(eval:error e) - (loop (extract s cdr car) expect #t)] + (handle-one val (extract s cdr car) expect #t promptless?)] [(eval:alts p e) - (loop (extract s cdr cdr car) expect error-expected?)] + (handle-one val (extract s cdr cdr car) expect error-expected? promptless?)] [(eval:check e expect) - (loop (extract s cdr car) - (list (syntax->datum (datum->syntax #f (extract s cdr cdr car)))) - error-expected?)] - [else (values s expect error-expected?)]))) + (handle-one val + (extract s cdr car) + (list (syntax->datum (datum->syntax #f (extract s cdr cdr car)))) + error-expected? + promptless?)] + [else (handle-one val s expect error-expected? promptless?)]))) -(define (do-eval ev who) +(define (do-eval ev who no-errors?) (define (get-outputs) (define (get getter what) (define s (getter ev)) @@ -272,36 +289,42 @@ (close-output-port out) in)))]))) (define (do-ev/expect s expect error-expected?) - (define-values (val render+output) + (define-values (val error? render+output) (with-handlers ([(lambda (x) (not (exn:break? x))) (lambda (e) - (unless error-expected? - (log-error "interaction without `eval:error` raised an exception: ~s; form: ~.s" - (if (exn? e) - (exn-message e) - e) - s)) + (when (and no-errors? + (not error-expected?)) + (error 'examples + (string-append "exception raised in example\n" + " error: ~s") + (if (exn? e) + (exn-message e) + e))) (values e + #t (cons ((scribble-exn->string) e) (get-outputs))))]) (define val (do-plain-eval ev s #t)) - (when error-expected? - (log-error "interaction failed to raise an expected exception: ~.s" s)) - (values val (cons (render-value val) (get-outputs))))) + (values val #f (cons (render-value val) (get-outputs))))) + (when (and error-expected? (not error?)) + (error 'eval "interaction failed to raise an expected exception: ~.s" s)) (when expect (let ([expect (do-plain-eval ev (car expect) #t)]) (unless (equal? val expect) - (raise-syntax-error 'eval "example result check failed" s)))) + (error 'eval "example result check failed: ~.s" s)))) render+output) (lambda (str) (if (eval-results? str) (list (map formatted-result (eval-results-contents str)) (eval-results-out str) (eval-results-err str)) - (let-values ([(s expect error-expected?) (extract-to-evaluate str)]) + (extract-to-evaluate + str + (list #f (list (void)) "" "") + (lambda (result s expect error-expected? promptless?) (if (nothing-to-eval? s) - (list (list (void)) "" "") - (do-ev/expect s expect error-expected?)))))) + result + (cons promptless? (do-ev/expect s expect error-expected?)))))))) (module+ test (require rackunit) @@ -641,44 +664,60 @@ ;; (require syntax/strip-context) #'(quote e)])])) -(define (do-interaction-eval ev e) - (let-values ([(e expect error-expected?/ignored) (extract-to-evaluate e)]) - (unless (nothing-to-eval? e) - (parameterize ([current-command-line-arguments #()]) - (do-plain-eval (or ev (make-base-eval)) e #f))) - "")) +(define (do-interaction-eval ev es) + (for/fold ([ev ev]) ([e (in-list es)]) + (extract-to-evaluate + e + ev + (lambda (ev e expect error-expected?/ignored promptless?/ignored) + (cond + [(nothing-to-eval? e) ev] + [else + (parameterize ([current-command-line-arguments #()]) + (let ([ev (or ev (make-base-eval))]) + (do-plain-eval ev e #f) + ev))])))) + "") (define-syntax interaction-eval (syntax-rules () - [(_ #:eval ev e) (do-interaction-eval ev (quote-expr e))] - [(_ e) (do-interaction-eval #f (quote-expr e))])) + [(_ #:eval ev e ...) (do-interaction-eval ev (list (quote-expr e) ...))] + [(_ e ...) (do-interaction-eval #f (list (quote-expr e) ...))])) (define (show-val v) (elem #:style result-color (to-element/no-color v #:expr? (print-as-expression)))) -(define (do-interaction-eval-show ev e) +(define (do-interaction-eval-show ev es) (parameterize ([current-command-line-arguments #()]) - (show-val (car (do-plain-eval (or ev (make-base-eval)) e #f))))) + (let ([ev (or ev (make-base-eval))]) + (show-val (car (for/fold ([v (list #f)]) ([e (in-list es)]) + (extract-to-evaluate + e + v + (lambda (prev-v e expect error-expected?/ignored promptless?/ignored) + (do-plain-eval ev e #f))))))))) (define-syntax interaction-eval-show (syntax-rules () - [(_ #:eval ev e) (do-interaction-eval-show ev (quote-expr e))] - [(_ e) (do-interaction-eval-show #f (quote-expr e))])) + [(_ #:eval ev e ...) (do-interaction-eval-show ev (list (quote-expr e) ...))] + [(_ e ...) (do-interaction-eval-show #f (list (quote-expr e) ...))])) (define-syntax racketinput* - (syntax-rules (eval:alts code:comment eval:check eval:error) + (syntax-rules (eval:alts code:comment eval:check eval:no-prompt eval:error) [(_ #:escape id (code:comment . rest)) (racketblock0 #:escape id (code:comment . rest))] [(_ #:escape id (eval:alts a b)) (racketinput* #:escape id a)] [(_ #:escape id (eval:check a b)) (racketinput* #:escape id a)] [(_ #:escape id (eval:error a)) (racketinput* #:escape id a)] + [(_ #:escape id (eval:no-prompt a ...)) (racketblock* #:escape id (code:line a ...))] [(_ #:escape id e) (racketinput0 #:escape id e)])) (define-syntax racketblock* - (syntax-rules (eval:alts code:comment eval:check eval:error) + (syntax-rules (eval:alts code:comment eval:check eval:no-prompt eval:error) [(_ #:escape id (code:comment . rest)) (racketblock0 #:escape id (code:comment . rest))] [(_ #:escape id (eval:alts a b)) (racketblock #:escape id a)] [(_ #:escape id (eval:check a b)) (racketblock #:escape id a)] + [(_ #:escape id (eval:no-prompt a ...)) (racketblock #:escape id (code:line a ...))] [(_ #:escape id (eval:error a)) (racketblock #:escape id a)] [(_ #:escape id e) (racketblock0 #:escape id e)])) @@ -700,23 +739,66 @@ [(_ #:escape _ e) #'(racketblock0+line #:escape id e)])] [(_ #:escape id e) #'(racketinput* #:escape id e)])) -(define (do-titled-interaction who inset? ev t shows evals) - (interleave inset? t shows (map (do-eval ev who) evals))) +(define (do-titled-interaction who inset? no-errors? ev t shows evals) + (interleave inset? t shows (map (do-eval ev who no-errors?) evals))) (define-syntax titled-interaction (syntax-rules () - [(_ who inset? t racketinput* #:eval ev #:escape unsyntax-id e ...) + [(_ who inset? t racketinput* + #:eval ev #:escape unsyntax-id #:no-errors? no-errors? + e ...) (do-titled-interaction - 'who inset? ev t (list (racketinput* #:escape unsyntax-id e) ...) (list (quote-expr e) ...))] - [(_ who inset? t racketinput* #:eval ev e ...) + 'who inset? no-errors? ev t + (list (racketinput* #:escape unsyntax-id e) ...) + (list (quote-expr e) ...))] + + [(_ who inset? t racketinput* + #:eval ev #:escape unsyntax-id + e ...) (titled-interaction - who inset? t racketinput* #:eval ev #:escape unsyntax e ...)] - [(_ who inset? t racketinput* #:escape unsyntax-id e ...) + who inset? t racketinput* + #:eval ev #:escape unsyntax-id #:no-errors? #f + e ...)] + [(_ who inset? t racketinput* + #:eval ev #:no-errors? no-errors? + e ...) (titled-interaction - who inset? t racketinput* #:eval (make-base-eval) #:escape unsyntax-id e ...)] + who inset? t racketinput* + #:eval ev #:escape unsyntax #:no-errors? no-errors? + e ...)] + [(_ who inset? t racketinput* + #:escape unsyntax-id #:no-errors? no-errors? + e ...) + (titled-interaction + who inset? t racketinput* + #:eval (make-base-eval) #:escape unsyntax-id #:no-errors? no-errors? + e ...)] + [(_ who inset? t racketinput* + #:eval ev + e ...) + (titled-interaction + who inset? t racketinput* + #:eval ev #:escape unsyntax #:no-errors? #f + e ...)] + [(_ who inset? t racketinput* + #:escape unsyntax-id + e ...) + (titled-interaction + who inset? t racketinput* + #:eval (make-base-eval) #:escape unsyntax-id + e ...)] + [(_ who inset? t racketinput* + #:no-errors? no-errors? + e ...) + (titled-interaction + who inset? t racketinput* + #:eval (make-base-eval) #:escape unsyntax #:no-errors? no-errors? + e ...)] [(_ who inset? t racketinput* e ...) (titled-interaction - who inset? t racketinput* #:eval (make-base-eval) e ...)])) + who inset? t racketinput* + #:eval (make-base-eval) #:escape unsyntax #:no-errors? #f + e ...)])) (define-syntax (-interaction stx) (syntax-case stx () @@ -743,7 +825,7 @@ [(_ racketblock #:eval ev #:escape unsyntax-id e ...) (let ([eva ev]) (#%expression - (begin (interaction-eval #:eval eva e) ... + (begin (interaction-eval #:eval eva e ...) (racketblock #:escape unsyntax-id e ...))))] [(_ racketblock #:eval ev e ...) (racketblockX+eval racketblock #:eval ev #:escape unsyntax e ...)] @@ -767,7 +849,7 @@ [(_ #:eval ev #:escape unsyntax-id name e ...) (let ([eva ev]) (#%expression - (begin (interaction-eval #:eval eva e) ... + (begin (interaction-eval #:eval eva e ...) (racketmod #:escape unsyntax-id name e ...))))] [(_ #:eval ev name e ...) (racketmod+eval #:eval ev #:escape unsyntax name e ...)] @@ -852,8 +934,12 @@ (case-lambda [(t) (as-examples examples-title t)] [(example-title t) - (compound-paragraph - plain - (list - example-title - (make-table #f (list (list (make-flow (do-splice (list t))))))))])) + (if example-title + (compound-paragraph + plain + (list + (if (block? example-title) + example-title + (make-paragraph (list example-title))) + t)) + t)]))