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

fixed macro stepper cursors (no mpairs)

Browse Source 
svn: r7713

original commit: d3fe81cb16aacc5484cbd21fac83f8fd86ac578d
This commit is contained in:
Ryan Culpepper 2007-11-13 21:21:37 +00:00
parent 5640b966de
commit b70053ae2a
1 changed files with 11 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/macro-debugger/view/cursor.ss
View File

@ -78,25 +78,22 @@
(define (cursor:prev c) (define (cursor:prev c)
(let ([prefix (cursor-prefix c)]) (let ([prefix (cursor-prefix c)])
(if (mpair? prefix) (if (pair? prefix)
(mcar prefix) (car prefix)
#f))) #f)))
(define (cursor:move-prev c) (define (cursor:move-prev c)
(when (mpair? (cursor-prefix c)) (when (pair? (cursor-prefix c))
(let ([old-prefix-cell (cursor-prefix c)]) (let ([old-prefix (cursor-prefix c)])
(set-cursor-prefix! c (mcdr old-prefix-cell)) (set-cursor-prefix! c (cdr old-prefix))
(set-mcdr! old-prefix-cell (cursor-suffixp c)) (set-cursor-suffixp! c (cons (car old-prefix) (cursor-suffixp c))))))
(set-cursor-suffixp! c old-prefix-cell))))
(define (cursor:move-next c) (define (cursor:move-next c)
(when (cursor:has-next? c) (when (cursor:has-next? c)
(let* ([old-suffixp (cursor-suffixp c)] (let* ([old-suffixp (cursor-suffixp c)])
[old-suffix-pair (set-cursor-prefix! c (cons (stream-car old-suffixp)
(if (mpair? old-suffixp) old-suffixp (force old-suffixp))]) (cursor-prefix c)))
(set-cursor-suffixp! c (mcdr old-suffix-pair)) (set-cursor-suffixp! c (stream-cdr old-suffixp)))))
(set-mcdr! old-suffix-pair (cursor-prefix c))
(set-cursor-prefix! c old-suffix-pair))))
(define (cursor:at-start? c) (define (cursor:at-start? c)
(null? (cursor-prefix c))) (null? (cursor-prefix c)))