diff --git a/collects/deinprogramm/deinprogramm-langs.ss b/collects/deinprogramm/deinprogramm-langs.ss index b1bcba5b1d..bed2a91831 100644 --- a/collects/deinprogramm/deinprogramm-langs.ss +++ b/collects/deinprogramm/deinprogramm-langs.ss @@ -1087,6 +1087,7 @@ (init-field stepper:supported) (define/override (stepper:supported?) stepper:supported) (define/override (stepper:show-inexactness?) #f) + (define/override (stepper:show-consumed-and/or-clauses?) #f) (define/override (stepper:render-to-sexp val settings language-level) (parameterize ([pc:current-print-convert-hook (make-print-convert-hook settings)]) (set-print-settings diff --git a/collects/lang/stepper-language-interface.ss b/collects/lang/stepper-language-interface.ss index be5ee49348..92666384af 100644 --- a/collects/lang/stepper-language-interface.ss +++ b/collects/lang/stepper-language-interface.ss @@ -8,4 +8,6 @@ stepper:supported? stepper:enable-let-lifting? stepper:show-lambdas-as-lambdas? + stepper:show-inexactness? + stepper:show-consumed-and/or-clauses? stepper:render-to-sexp))) diff --git a/collects/stepper/private/macro-unwind.ss b/collects/stepper/private/macro-unwind.ss index b393ab06f2..ff32fbff3c 100644 --- a/collects/stepper/private/macro-unwind.ss +++ b/collects/stepper/private/macro-unwind.ss @@ -274,17 +274,19 @@ (define ((unwind-and/or label) stx settings) (let ([user-source (syntax-property stx 'user-source)] - [user-position (syntax-property stx 'user-position)] - [clause-padder - (if (render-settings-true-false-printed? settings) - (case label [(and) #'true] [(or) #'false]) - (case label [(and) #'#t] [(or) #'#f]))]) + [user-position (syntax-property stx 'user-position)]) (with-syntax ([clauses (append - (build-list (stepper-syntax-property - stx 'stepper-and/or-clauses-consumed) - (lambda (dc) clause-padder)) + (if (render-settings-show-and/or-clauses-consumed? settings) + (build-list (stepper-syntax-property + stx 'stepper-and/or-clauses-consumed) + (let ([clause-padder + (if (render-settings-true-false-printed? settings) + (case label [(and) #'true] [(or) #'false]) + (case label [(and) #'#t] [(or) #'#f]))]) + (lambda (dc) clause-padder))) + '()) (let loop ([stx stx]) (if (and (eq? user-source (syntax-property stx 'user-source)) diff --git a/collects/stepper/private/model-settings.ss b/collects/stepper/private/model-settings.ss index 7b4449c18a..6666b97da5 100644 --- a/collects/stepper/private/model-settings.ss +++ b/collects/stepper/private/model-settings.ss @@ -16,8 +16,14 @@ ; the reconstructor gets the right invocation of the unit, it needs to be a ; unit as well. Pretty soon, everything is units. - (define-struct render-settings (true-false-printed? constructor-style-printing? abbreviate-cons-as-list? render-to-sexp lifting? - all-bindings-mutable?)) + (define-struct render-settings + (true-false-printed? + constructor-style-printing? + abbreviate-cons-as-list? + render-to-sexp + lifting? + show-and/or-clauses-consumed? + all-bindings-mutable?)) (provide/contract [check-global-defined (-> symbol? boolean?)] [global-lookup (-> any/c any)] @@ -28,6 +34,7 @@ [abbreviate-cons-as-list? boolean?] [render-to-sexp (any/c . -> . any)] [lifting? boolean?] + [show-and/or-clauses-consumed? boolean?] [all-bindings-mutable? boolean?])] @@ -35,6 +42,7 @@ [get-render-settings ((any/c . -> . string?) ; render-to-string (any/c . -> . any) ; render-to-sexp boolean? ; lifting? + boolean? ; show-and/or-clauses-consumed? . -> . render-settings?)] @@ -59,10 +67,10 @@ ; FIXME : #f totally unacceptable as 'render-to-string' (define fake-beginner-render-settings - (make-render-settings #t #t #f (make-fake-render-to-sexp #t #t #f) #t #f)) + (make-render-settings #t #t #f (make-fake-render-to-sexp #t #t #f) #t #t #f)) (define fake-beginner-wla-render-settings - (make-render-settings #t #t #t (make-fake-render-to-sexp #t #t #t) #t #f)) + (make-render-settings #t #t #t (make-fake-render-to-sexp #t #t #t) #t #t #f)) (define fake-intermediate-render-settings fake-beginner-wla-render-settings) @@ -80,13 +88,14 @@ (abbreviate-cons-as-list) print-convert #f - #f)) + #t + #f)) (define-struct test-struct () (make-inspector)) ;; get-render-settings : infer aspects of the current language's print conversion by explicitly testing ;; assorted test expressions - (define (get-render-settings render-to-string render-to-sexp lifting?) + (define (get-render-settings render-to-string render-to-sexp lifting? show-and/or-clauses-consumed?) (let* ([true-false-printed? (string=? (render-to-string #t) "true")] [constructor-style-printing? (string=? (render-to-string (make-test-struct)) "(make-test-struct)")] [rendered-list (render-to-string '(3))] @@ -101,6 +110,7 @@ abbreviate-cons-as-list? render-to-sexp lifting? + show-and/or-clauses-consumed? #f))) (define (check-global-defined identifier) diff --git a/collects/stepper/stepper-tool.ss b/collects/stepper/stepper-tool.ss index 123c256716..ed58805344 100644 --- a/collects/stepper/stepper-tool.ss +++ b/collects/stepper/stepper-tool.ss @@ -35,6 +35,9 @@ (public stepper:show-inexactness?) (define (stepper:show-inexactness?) #t) + + (public stepper:show-consumed-and/or-clauses?) + (define (stepper:show-consumed-and/or-clauses?) #t) (public stepper:render-to-sexp) (define (stepper:render-to-sexp val settings language-level) diff --git a/collects/stepper/view-controller.ss b/collects/stepper/view-controller.ss index d88b9f4473..bdbf39799a 100644 --- a/collects/stepper/view-controller.ss +++ b/collects/stepper/view-controller.ss @@ -390,7 +390,8 @@ (model:go program-expander-prime receive-result (get-render-settings render-to-string render-to-sexp - (send language-level stepper:enable-let-lifting?)) + (send language-level stepper:enable-let-lifting?) + (send language-level stepper:show-consumed-and/or-clauses?)) (send language-level stepper:show-lambdas-as-lambdas?) language-level run-on-drscheme-side