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

v3.99.0.2

Browse Source 
svn: r7706

original commit: 39cedb62edf9258b051a22a29a90be9c6841956f
This commit is contained in:
Matthew Flatt 2007-11-13 12:40:00 +00:00
parent bcacd7b7de
commit 5640b966de
5 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/macro-debugger/info.ss
View File

@ -1,5 +1,5 @@
(module info (lib "infotab.ss" "setup")
(module info setup/infotab
(define name "Macro Debugger")
(define tools '(["tool.ss"]))
(define tool-names '("Macro Stepper"))

2
collects/macro-debugger/model/trace-raw.ss
View File

@ -8,7 +8,7 @@
(provide (all-defined))
(define current-expand-observe
(dynamic-require '#%expobs 'current-expand-observe))
(dynamic-require ''#%expobs 'current-expand-observe))
(define (go-trace sexpr)
(define events null)

2
collects/macro-debugger/model/trace.ss
View File

@ -17,7 +17,7 @@
(all-from "reductions.ss"))
(define current-expand-observe
(dynamic-require '#%expobs 'current-expand-observe))
(dynamic-require ''#%expobs 'current-expand-observe))
(define trace-verbose? (make-parameter #f))

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

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

10
collects/macro-debugger/view/hiding-panel.ss
View File

@ -233,8 +233,8 @@
(define/private (get-specialized-policies)
(map (lambda (policy)
(define key (car policy))
(define show? (cdr policy))
(define key (mcar policy))
(define show? (mcdr policy))
(cond [(pair? key)
(lambda (id binding return)
(when (and (pair? binding)
@ -260,11 +260,11 @@
(let loop ([i 0] [policies identifier-policies])
(cond [(null? policies)
(set! identifier-policies
(cons (cons key show?) identifier-policies))
(cons (mcons key show?) identifier-policies))
(send look-ctl append "")
(update-list-view i key show?)]
[(key=? key (car (car policies)))
(set-cdr! (car policies) show?)
[(key=? key (mcar (car policies)))
(set-mcdr! (car policies) show?)
(update-list-view i key show?)]
[else (loop (add1 i) (cdr policies))])))))