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

ranges for stepper-jump

Browse Source 
svn: r14895
This commit is contained in:
John Clements 2009-05-21 05:35:38 +00:00
parent 44848d349c
commit 0885877641
2 changed files with 37 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
collects/stepper/private/model.ss
View File

@ -11,7 +11,7 @@
; held = NO-HELD-STEP :
; first(x) : held := HELD(x)
; skipped-first : held := SKIPPED-STEP
; second(x) : trigger(NO-HELD-STEP, x), held := NO-HELD-STEP
; second(x) : trigger(NO-HELD-STEP, x), held := NO-HELD-STEP.
; this happens when evaluating unannotated code
; skipped-second : held := NO-HELD-STEP
; I believe this can also arise in unannotated code
@ -72,6 +72,12 @@
. -> .
void?)])
(define-struct posn-info (posn span))
(provide (struct-out posn-info))
; go starts a stepper instance
; see provide stmt for contract
(define (go program-expander receive-result render-settings
@ -94,7 +100,7 @@
;; the "held" variables are used to store the "before" step.
(define held-exp-list the-no-sexp)
(define-struct held (exps was-app? source-pos))
(define-struct held (exps was-app? source-info))
(define held-finished-list null)
@ -215,7 +221,9 @@
mark-list returned-value-list render-settings)
#f))
(r:step-was-app? mark-list)
(syntax-position (mark-source (car mark-list))))))]
(make-posn-info
(syntax-position (mark-source (car mark-list)))
(syntax-span (mark-source (car mark-list)))))))]
[(result-exp-break result-value-break)
(let ([reconstruct
@ -248,7 +256,7 @@
(append (reconstruct-all-completed) (reconstruct))
'normal
#f #f))]
[(struct held (held-exps held-step-was-app? held-source-pos))
[(struct held (held-exps held-step-was-app? held-posn-info))
(let*-values
([(step-kind)
(if (and held-step-was-app?
@ -267,8 +275,11 @@
(send-result
(make-before-after-result
left-exps right-exps step-kind held-source-pos
(syntax-position (mark-source (car mark-list))))))]))]
left-exps right-exps step-kind
held-posn-info
(make-posn-info
(syntax-position (mark-source (car mark-list)))
(syntax-span (mark-source (car mark-list)))))))]))]
[(double-break)
;; a double-break occurs at the beginning of a let's
@ -284,13 +295,16 @@
(maybe-lift (car reconstruct-result) #f))]
[right-side (map (lambda (exp) (unwind exp render-settings))
(maybe-lift (cadr reconstruct-result) #t))])
;; add highlighting code as for other cases...
(receive-result
(make-before-after-result
(append new-finished-list left-side)
(append new-finished-list right-side)
'normal
#f #f)))]
(let ([posn-info (make-posn-info
(syntax-position (mark-source (car mark-list)))
(syntax-span (mark-source (car mark-list))))])
(receive-result
(make-before-after-result
(append new-finished-list left-side)
(append new-finished-list right-side)
'normal
posn-info
posn-info))))]
[(expr-finished-break)
(unless (not mark-list)
@ -323,13 +337,13 @@
(match held-exp-list
[(struct no-sexp ())
(receive-result (make-error-result message))]
[(struct held (exps dc source-pos))
[(struct held (exps dc posn-info))
(begin
(receive-result
(make-before-error-result (append held-finished-list exps)
message
#f
source-pos))
posn-info))
(set! held-exp-list the-no-sexp))]))
(program-expander

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

@ -169,8 +169,15 @@
;; is this step on the selected expression?
(define (selected-exp-step? history-entry)
(member selection-posn (step-posns history-entry)))
(ormap (posn-in-span selection-posn) (step-posns history-entry)))
(define ((posn-in-span selection-posn) source-posn-info)
(match source-posn-info
[#f #f]
[(struct model:posn-info (posn span))
(and posn
(<= posn selection-posn)
(< selection-posn (+ posn span)))]))
;; build gui object: