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

macro-stepper: display binding info for phases -5 to 5, clean up

Browse Source
This commit is contained in:
Ryan Culpepper 2011-11-29 11:53:37 -07:00
parent 7ebd15c4b0
commit 7fbd232c77
1 changed files with 34 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
collects/macro-debugger/syntax-browser/properties.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require racket/class
racket/match
racket/gui/base
framework
unstable/class-iop
@ -174,28 +175,44 @@
;; display-bindings : syntax -> void
(define/private (display-bindings stx)
(define phases-to-search '(0 1 -1 #f 2 3 4 5 -2 -3 -4 -5))
(unless (identifier? stx)
(display "Not applicable\n\n" n/a-sd))
(when (identifier? stx)
(if (eq? (identifier-binding stx) 'lexical)
(display "lexical (all phases)\n" #f)
(for-each (lambda (p) (display-binding-kvs (car p) ((cdr p) stx)))
binding-properties))
(cond [(eq? (identifier-binding stx) 'lexical)
(display "lexical (all phases)\n" #f)]
[else
(let ([bindings (for/hash ([phase (in-list phases-to-search)])
(values phase (identifier-binding stx phase)))])
(cond [(for/or ([(p b) (in-hash bindings)]) b)
(for ([phase (in-list phases-to-search)])
(display-binding-kvs phase (hash-ref bindings phase #f) stx))]
[else (display "none\n" #f)]))])
(display "\n" #f)))
;; display-binding-kvs : string bindinginfo -> void
(define/private (display-binding-kvs k v)
(display k sub-key-sd)
;; display-binding-kvs : phase bindinginfo identifier -> void
(define/private (display-binding-kvs phase v stx)
(when v
(display (format "in phase ~a~a:"
phase
(case phase
((1) " (transformer phase)")
((-1) " (template phase)")
((#f) " (label phase)")
(else "")))
sub-key-sd)
(display "\n" #f)
(cond [(eq? v #f)
(display " top-level or unbound\n" #f)]
[(list? v)
(display-subkv " defined in" (mpi->string (list-ref v 0)))
(display-subkv " as" (list-ref v 1))
(display-subkv " imported from" (mpi->string (list-ref v 2)))
(display-subkv " as" (list-ref v 3))
(when (list-ref v 4)
(display " via define-for-syntax\n" sub-key-sd))]))
(match v
[(list* def-mpi def-sym imp-mpi imp-sym defined-at-phase _)
(display-subkv " defined in" (mpi->string def-mpi))
(unless (eq? def-sym (syntax-e stx))
(display-subkv " as" def-sym))
(display-subkv " imported from" (mpi->string imp-mpi))
(unless (eq? imp-sym (syntax-e stx))
(display-subkv " provided as" (list-ref v 3)))
(unless (zero? defined-at-phase)
(display-subkv " defined at phase" defined-at-phase))]
[_ (void)])))
;; display-stxobj-info : syntax -> void
(define/public (display-stxobj-info stx)
@ -304,15 +321,6 @@
(define (lift/id f)
(lambda (stx) (when (identifier? stx) (f stx))))
;; binding-properties : (listof (cons string (syntax -> any)))
(define binding-properties
(list (cons "in the standard phase"
(lift/id identifier-binding))
(cons "in the transformer phase (\"for-syntax\")"
(lift/id identifier-transformer-binding))
(cons "in the template phase (\"for-template\")"
(lift/id identifier-template-binding))))
(define (uninterned? s)
(not (eq? s (string->symbol (symbol->string s)))))