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

Make the Stepper behavior on and/or configurable:

Browse Source 
In the HtDP languages, initial subexpressions that have evaluated to
#t / #f remain in the residual term, whereas in the DMdA languages,
they do not.

svn: r16018
This commit is contained in:
Mike Sperber 2009-09-15 17:32:21 +00:00
parent 11c6d0ac9b
commit c26b3b8c6c
6 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/deinprogramm/deinprogramm-langs.ss
View File

@ -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

2
collects/lang/stepper-language-interface.ss
View File

@ -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)))

18
collects/stepper/private/macro-unwind.ss
View File

@ -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))

22
collects/stepper/private/model-settings.ss
View File

@ -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)

3
collects/stepper/stepper-tool.ss
View File

@ -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)

3
collects/stepper/view-controller.ss
View File

@ -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