Macro stepper: fixed bugs and added new binding info (#%app, #%top, #%datum)

svn: r7395

original commit: 3f7ef884163ab94b86b34b571486d6646538f0b4
This commit is contained in:
Ryan Culpepper 2007-09-21 21:03:50 +00:00
parent 00f0692e48
commit b6e46fabb6
4 changed files with 31 additions and 14 deletions

View File

@ -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))

View File

@ -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)

View File

@ -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)]))
)

View File

@ -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)