suzanne.soy/macro-debugger
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 
original commit: 7fbd232c772787f0a82f35fa03fc6b3fd896e132
This commit is contained in:
Ryan Culpepper 2011-11-29 11:53:37 -07:00
parent dc25631944
commit 32a5cfb1ac
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 #lang racket/base
(require racket/class (require racket/class
racket/match
racket/gui/base racket/gui/base
framework framework
unstable/class-iop unstable/class-iop
@ -174,28 +175,44 @@
;; display-bindings : syntax -> void ;; display-bindings : syntax -> void
(define/private (display-bindings stx) (define/private (display-bindings stx)
(define phases-to-search '(0 1 -1 #f 2 3 4 5 -2 -3 -4 -5))
(unless (identifier? stx) (unless (identifier? stx)
(display "Not applicable\n\n" n/a-sd)) (display "Not applicable\n\n" n/a-sd))
(when (identifier? stx) (when (identifier? stx)
(if (eq? (identifier-binding stx) 'lexical) (cond [(eq? (identifier-binding stx) 'lexical)
(display "lexical (all phases)\n" #f) (display "lexical (all phases)\n" #f)]
(for-each (lambda (p) (display-binding-kvs (car p) ((cdr p) stx))) [else
binding-properties)) (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 "\n" #f)))
;; display-binding-kvs : string bindinginfo -> void ;; display-binding-kvs : phase bindinginfo identifier -> void
(define/private (display-binding-kvs k v) (define/private (display-binding-kvs phase v stx)
(display k sub-key-sd) (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) (display "\n" #f)
(cond [(eq? v #f) (match v
(display " top-level or unbound\n" #f)] [(list* def-mpi def-sym imp-mpi imp-sym defined-at-phase _)
[(list? v) (display-subkv " defined in" (mpi->string def-mpi))
(display-subkv " defined in" (mpi->string (list-ref v 0))) (unless (eq? def-sym (syntax-e stx))
(display-subkv " as" (list-ref v 1)) (display-subkv " as" def-sym))
(display-subkv " imported from" (mpi->string (list-ref v 2))) (display-subkv " imported from" (mpi->string imp-mpi))
(display-subkv " as" (list-ref v 3)) (unless (eq? imp-sym (syntax-e stx))
(when (list-ref v 4) (display-subkv " provided as" (list-ref v 3)))
(display " via define-for-syntax\n" sub-key-sd))])) (unless (zero? defined-at-phase)
(display-subkv " defined at phase" defined-at-phase))]
[_ (void)])))
;; display-stxobj-info : syntax -> void ;; display-stxobj-info : syntax -> void
(define/public (display-stxobj-info stx) (define/public (display-stxobj-info stx)
@ -304,15 +321,6 @@
(define (lift/id f) (define (lift/id f)
(lambda (stx) (when (identifier? stx) (f stx)))) (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) (define (uninterned? s)
(not (eq? s (string->symbol (symbol->string s))))) (not (eq? s (string->symbol (symbol->string s)))))