Macro stepper: fixed bugs and added new binding info (#%app, #%top, #%datum)
svn: r7395 original commit: 3f7ef884163ab94b86b34b571486d6646538f0b4
This commit is contained in:
parent
00f0692e48
commit
b6e46fabb6
|
@ -28,7 +28,7 @@
|
|||
(class* object% (partition<%>)
|
||||
(init relation)
|
||||
|
||||
(define related? relation)
|
||||
(define related? (or relation (lambda (a b) #f)))
|
||||
(field (rep=>num (make-hash-table)))
|
||||
(field (obj=>rep (make-hash-table 'weak)))
|
||||
(field (reps null))
|
||||
|
|
|
@ -138,11 +138,29 @@
|
|||
(when (and (identifier? stx)
|
||||
(uninterned? (syntax-e stx)))
|
||||
(display "Uninterned symbol!\n\n" key-sd))
|
||||
(display-binding-info stx))
|
||||
(display-binding-info stx)
|
||||
(display-indirect-binding-info stx))
|
||||
|
||||
;; display-binding-info : syntax -> void
|
||||
(define/private (display-binding-info stx)
|
||||
(display "Apparent identifier binding\n" key-sd)
|
||||
(display-bindings stx))
|
||||
|
||||
;; display-indirect-binding-info : syntax -> void
|
||||
(define/private (display-indirect-binding-info stx)
|
||||
(cond
|
||||
[(identifier? stx)
|
||||
(display "Binding if used for #%top\n" key-sd)
|
||||
(display-bindings (datum->syntax-object stx '#%top))]
|
||||
[(and (syntax? stx) (pair? (syntax-e stx)))
|
||||
(display "Binding if used for #%app\n" key-sd)
|
||||
(display-bindings (datum->syntax-object stx '#%app))]
|
||||
[else
|
||||
(display "Binding if used for #%datum\n" key-sd)
|
||||
(display-bindings (datum->syntax-object stx '#%datum))]))
|
||||
|
||||
;; display-bindings : syntax -> void
|
||||
(define/private (display-bindings stx)
|
||||
(unless (identifier? stx)
|
||||
(display "Not applicable\n\n" n/a-sd))
|
||||
(when (identifier? stx)
|
||||
|
|
|
@ -47,13 +47,14 @@
|
|||
|
||||
;; mpi->list : module-path-index -> (list-of module-spec)
|
||||
(define (mpi->list mpi)
|
||||
(if mpi
|
||||
(let-values ([(path rel) (module-path-index-split mpi)])
|
||||
(cond [(and (pair? path) (memq (car path) '(file lib planet)))
|
||||
(cons path null)]
|
||||
[path
|
||||
(cons path (mpi->list rel))]
|
||||
[else '()]))
|
||||
'()))
|
||||
|
||||
(cond [(module-path-index? mpi)
|
||||
(let-values ([(path rel) (module-path-index-split mpi)])
|
||||
(cond [(and (pair? path) (memq (car path) '(file lib planet)))
|
||||
(cons path null)]
|
||||
[path
|
||||
(cons path (mpi->list rel))]
|
||||
[else '()]))]
|
||||
[(not mpi)
|
||||
'()]
|
||||
[else (list mpi)]))
|
||||
)
|
||||
|
|
|
@ -130,9 +130,7 @@
|
|||
(callback
|
||||
(lambda _
|
||||
(send (send widget get-controller)
|
||||
on-update-identifier=?
|
||||
(car p)
|
||||
(cdr p)))))])
|
||||
set-identifier=? p))))])
|
||||
(send (send widget get-controller)
|
||||
listen-identifier=?
|
||||
(lambda (name+func)
|
||||
|
|
Loading…
Reference in New Issue
Block a user