diff --git a/macro-debugger-text-lib/macro-debugger/stepper-text.rkt b/macro-debugger-text-lib/macro-debugger/stepper-text.rkt index 0cb3422..b07c769 100644 --- a/macro-debugger-text-lib/macro-debugger/stepper-text.rkt +++ b/macro-debugger-text-lib/macro-debugger/stepper-text.rkt @@ -25,7 +25,7 @@ (define (internal-stepper stx show? error-file) (define steps (get-steps stx show? error-file)) (define used-steps null) - (define partition (new-bound-partition)) + (define partition (new-macro-scopes-partition)) (define dispatch (case-lambda [() (dispatch 'next)] diff --git a/macro-debugger-text-lib/macro-debugger/syntax-browser/partition.rkt b/macro-debugger-text-lib/macro-debugger/syntax-browser/partition.rkt index 10a53e8..0472feb 100644 --- a/macro-debugger-text-lib/macro-debugger/syntax-browser/partition.rkt +++ b/macro-debugger-text-lib/macro-debugger/syntax-browser/partition.rkt @@ -1,15 +1,19 @@ #lang racket/base (require racket/class - "interfaces.rkt" - "../util/stxobj.rkt") -(provide new-bound-partition + "interfaces.rkt") +(provide new-macro-scopes-partition + new-all-scopes-partition + partition-choices identifier=-choices) -(define (new-bound-partition) - (new bound-partition%)) +(define (new-macro-scopes-partition) + (new macro-scopes-partition%)) -;; bound-partition% -(define bound-partition% +(define (new-all-scopes-partition) + (new scopes-partition%)) + +;; scopes-partition% +(define scopes-partition% (class* object% (partition<%>) ;; simplified : hash[(listof nat) => nat] @@ -19,13 +23,16 @@ (define next-number 0) (define/public (get-partition stx) - (let ([marks (get-marks stx)]) + (let ([marks (get-scopes stx)]) (or (hash-ref simplified marks #f) (let ([n next-number]) (hash-set! simplified marks n) (set! next-number (add1 n)) n)))) + (define/public (get-scopes stx) + (get-all-scopes stx)) + (define/public (same-partition? a b) (= (get-partition a) (get-partition b))) @@ -35,6 +42,30 @@ (get-partition (datum->syntax #f 'nowhere)) (super-new))) +;; macro-scopes-partition% +(define macro-scopes-partition% + (class scopes-partition% + (super-new) + (define/override (get-scopes stx) + (get-macro-scopes stx)))) + +(define (get-macro-scopes stx) + (define ctx (hash-ref (syntax-debug-info stx) 'context null)) + (for/list ([scope (in-list ctx)] + #:when (memq (vector-ref scope 1) '(macro))) + (vector-ref scope 0))) + +(define (get-all-scopes stx) + (define ctx (hash-ref (syntax-debug-info stx) 'context null)) + (for/list ([scope (in-list ctx)]) + (vector-ref scope 0))) + +;; ==== Partition choices ==== + +(define partition-choices + `(("Macro scopes" . ,new-macro-scopes-partition) + ("All scopes" . ,new-all-scopes-partition))) + ;; ==== Identifier relations ==== (define identifier=-choices diff --git a/macro-debugger-text-lib/macro-debugger/util/stxobj.rkt b/macro-debugger-text-lib/macro-debugger/util/stxobj.rkt deleted file mode 100644 index 33570aa..0000000 --- a/macro-debugger-text-lib/macro-debugger/util/stxobj.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket/base - -(provide get-marks) - -(define (get-marks stx) - (define info (syntax-debug-info stx)) - (for/list ([e (in-list (hash-ref info 'context))]) - (vector-ref e 0))) diff --git a/macro-debugger/macro-debugger/syntax-browser/controller.rkt b/macro-debugger/macro-debugger/syntax-browser/controller.rkt index f2334a0..b4cfbde 100644 --- a/macro-debugger/macro-debugger/syntax-browser/controller.rkt +++ b/macro-debugger/macro-debugger/syntax-browser/controller.rkt @@ -37,7 +37,7 @@ ;; mark-manager-mixin (define mark-manager-mixin (mixin () (mark-manager<%>) - (init-field/i [primary-partition partition<%> (new-bound-partition)]) + (init-field/i [primary-partition partition<%> (new-macro-scopes-partition)]) (super-new) ;; get-primary-partition : -> partition @@ -46,7 +46,7 @@ ;; reset-primary-partition : -> void (define/public-final (reset-primary-partition) - (set! primary-partition (new-bound-partition))))) + (set! primary-partition (new-macro-scopes-partition))))) ;; secondary-relation-mixin (define secondary-relation-mixin diff --git a/macro-debugger/macro-debugger/syntax-browser/properties.rkt b/macro-debugger/macro-debugger/syntax-browser/properties.rkt index 37dac5a..bbe472b 100644 --- a/macro-debugger/macro-debugger/syntax-browser/properties.rkt +++ b/macro-debugger/macro-debugger/syntax-browser/properties.rkt @@ -7,8 +7,7 @@ racket/class/iop macro-debugger/syntax-browser/interfaces "util.rkt" - macro-debugger/util/mpi - macro-debugger/util/stxobj) + macro-debugger/util/mpi) (provide properties-view% properties-snip%)