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

adding external interface

Browse Source
This commit is contained in:
John Clements 2012-08-27 17:58:04 -07:00
parent fe1cc4f009
commit f933535639
2 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/stepper/private/annotate.rkt
View File

@ -22,14 +22,14 @@
(provide/contract (provide/contract
[annotate [annotate
(syntax? ; syntax to annotate (syntax? ; syntax to annotate
(((or/c continuation-mark-set? false/c) ((or/c continuation-mark-set? false/c)
break-kind?) break-kind?
(list?) (or/c list? false/c)
. ->* . . -> .
any/c) ; procedure for runtime break any/c) ; procedure for runtime break
boolean? ; show-lambdas-as-lambdas? boolean? ; show-lambdas-as-lambdas?
. -> . . -> .
syntax?)] ; results syntax?)] ; result
#;[top-level-rewrite (-> syntax? syntax?)]) #;[top-level-rewrite (-> syntax? syntax?)])
@ -90,10 +90,10 @@
temp)))) temp))))
(define (normal-break) (define (normal-break)
(break (current-continuation-marks) 'normal-break)) (break (current-continuation-marks) 'normal-break #f))
(define (result-exp-break) (define (result-exp-break)
(break (current-continuation-marks) 'result-exp-break)) (break (current-continuation-marks) 'result-exp-break #f))
(define (result-value-break vals-list) (define (result-value-break vals-list)
(break (current-continuation-marks) 'result-value-break vals-list)) (break (current-continuation-marks) 'result-value-break vals-list))
@ -105,7 +105,7 @@
(break #f 'expr-finished-break info-list)) (break #f 'expr-finished-break info-list))
(define (double-break) (define (double-break)
(break (current-continuation-marks) 'double-break)) (break (current-continuation-marks) 'double-break #f))
(define ((make-opaque-exp-break exp)) (define ((make-opaque-exp-break exp))
(exp-finished-break (exp-finished-break

24
collects/stepper/private/model.rkt
View File

@ -207,7 +207,7 @@
(define steps-received 0) (define steps-received 0)
(define break (define break
(lambda (mark-set break-kind [returned-value-list #f]) (lambda (mark-set break-kind returned-value-list)
(when DEBUG (when DEBUG
(printf "\n---------- BREAK TYPE = ~a ----------\n" break-kind)) (printf "\n---------- BREAK TYPE = ~a ----------\n" break-kind))
@ -516,14 +516,14 @@
;; break when lifting is off. ;; break when lifting is off.
(lambda (stx dont-care) (list stx)))) (lambda (stx dont-care) (list stx))))
(define (step-through-expression expanded expand-next-expression) (define show-lambdas-as-lambdas?
(define show-lambdas-as-lambdas?
(render-settings-show-lambdas-as-lambdas? render-settings)) (render-settings-show-lambdas-as-lambdas? render-settings))
(let* ([annotated (a:annotate expanded break
show-lambdas-as-lambdas?)]) ;; step through a single expanded expression.
(parameterize ([test-engine:test-silence #t]) (define (step-through-expression expanded)
(eval-syntax annotated)) (define annotated (a:annotate expanded break show-lambdas-as-lambdas?))
(expand-next-expression))) (parameterize ([test-engine:test-silence #t])
(eval-syntax annotated)))
(define (err-display-handler message exn) (define (err-display-handler message exn)
(match held-exp-list (match held-exp-list
@ -538,15 +538,15 @@
(set! held-exp-list the-no-sexp))])) (set! held-exp-list the-no-sexp))]))
(program-expander (program-expander
(lambda () (lambda () ; init
(unless disable-error-handling? (unless disable-error-handling?
(error-display-handler err-display-handler))) (error-display-handler err-display-handler)))
(lambda (expanded continue-thunk) ; iter (lambda (expanded continue-thunk) ; iter
(r:reset-special-values) (r:reset-special-values)
(if (eof-object? expanded) (if (eof-object? expanded)
(begin (receive-result (finished-stepping))
(receive-result (finished-stepping))) (begin (step-through-expression expanded)
(step-through-expression expanded continue-thunk))))) (continue-thunk))))))
; no-sexp is used to indicate no sexpression for display. ; no-sexp is used to indicate no sexpression for display.