commit c707389521850f662ef1e6584b41998455aae922
parent b5ba0c8c81e8faef2a84e875839ea3b9932a4686
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 15 Sep 2015 16:40:33 -0400
remove util/stxobj, rename primary partitions
Diffstat:
5 files changed, 43 insertions(+), 21 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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%)
