remove util/stxobj, rename primary partitions
This commit is contained in:
parent
b5ba0c8c81
commit
c707389521
|
@ -25,7 +25,7 @@
|
||||||
(define (internal-stepper stx show? error-file)
|
(define (internal-stepper stx show? error-file)
|
||||||
(define steps (get-steps stx show? error-file))
|
(define steps (get-steps stx show? error-file))
|
||||||
(define used-steps null)
|
(define used-steps null)
|
||||||
(define partition (new-bound-partition))
|
(define partition (new-macro-scopes-partition))
|
||||||
(define dispatch
|
(define dispatch
|
||||||
(case-lambda
|
(case-lambda
|
||||||
[() (dispatch 'next)]
|
[() (dispatch 'next)]
|
||||||
|
|
|
@ -1,15 +1,19 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/class
|
(require racket/class
|
||||||
"interfaces.rkt"
|
"interfaces.rkt")
|
||||||
"../util/stxobj.rkt")
|
(provide new-macro-scopes-partition
|
||||||
(provide new-bound-partition
|
new-all-scopes-partition
|
||||||
|
partition-choices
|
||||||
identifier=-choices)
|
identifier=-choices)
|
||||||
|
|
||||||
(define (new-bound-partition)
|
(define (new-macro-scopes-partition)
|
||||||
(new bound-partition%))
|
(new macro-scopes-partition%))
|
||||||
|
|
||||||
;; bound-partition%
|
(define (new-all-scopes-partition)
|
||||||
(define bound-partition%
|
(new scopes-partition%))
|
||||||
|
|
||||||
|
;; scopes-partition%
|
||||||
|
(define scopes-partition%
|
||||||
(class* object% (partition<%>)
|
(class* object% (partition<%>)
|
||||||
|
|
||||||
;; simplified : hash[(listof nat) => nat]
|
;; simplified : hash[(listof nat) => nat]
|
||||||
|
@ -19,13 +23,16 @@
|
||||||
(define next-number 0)
|
(define next-number 0)
|
||||||
|
|
||||||
(define/public (get-partition stx)
|
(define/public (get-partition stx)
|
||||||
(let ([marks (get-marks stx)])
|
(let ([marks (get-scopes stx)])
|
||||||
(or (hash-ref simplified marks #f)
|
(or (hash-ref simplified marks #f)
|
||||||
(let ([n next-number])
|
(let ([n next-number])
|
||||||
(hash-set! simplified marks n)
|
(hash-set! simplified marks n)
|
||||||
(set! next-number (add1 n))
|
(set! next-number (add1 n))
|
||||||
n))))
|
n))))
|
||||||
|
|
||||||
|
(define/public (get-scopes stx)
|
||||||
|
(get-all-scopes stx))
|
||||||
|
|
||||||
(define/public (same-partition? a b)
|
(define/public (same-partition? a b)
|
||||||
(= (get-partition a) (get-partition b)))
|
(= (get-partition a) (get-partition b)))
|
||||||
|
|
||||||
|
@ -35,6 +42,30 @@
|
||||||
(get-partition (datum->syntax #f 'nowhere))
|
(get-partition (datum->syntax #f 'nowhere))
|
||||||
(super-new)))
|
(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 ====
|
;; ==== Identifier relations ====
|
||||||
|
|
||||||
(define identifier=-choices
|
(define identifier=-choices
|
||||||
|
|
|
@ -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)))
|
|
|
@ -37,7 +37,7 @@
|
||||||
;; mark-manager-mixin
|
;; mark-manager-mixin
|
||||||
(define mark-manager-mixin
|
(define mark-manager-mixin
|
||||||
(mixin () (mark-manager<%>)
|
(mixin () (mark-manager<%>)
|
||||||
(init-field/i [primary-partition partition<%> (new-bound-partition)])
|
(init-field/i [primary-partition partition<%> (new-macro-scopes-partition)])
|
||||||
(super-new)
|
(super-new)
|
||||||
|
|
||||||
;; get-primary-partition : -> partition
|
;; get-primary-partition : -> partition
|
||||||
|
@ -46,7 +46,7 @@
|
||||||
|
|
||||||
;; reset-primary-partition : -> void
|
;; reset-primary-partition : -> void
|
||||||
(define/public-final (reset-primary-partition)
|
(define/public-final (reset-primary-partition)
|
||||||
(set! primary-partition (new-bound-partition)))))
|
(set! primary-partition (new-macro-scopes-partition)))))
|
||||||
|
|
||||||
;; secondary-relation-mixin
|
;; secondary-relation-mixin
|
||||||
(define secondary-relation-mixin
|
(define secondary-relation-mixin
|
||||||
|
|
|
@ -7,8 +7,7 @@
|
||||||
racket/class/iop
|
racket/class/iop
|
||||||
macro-debugger/syntax-browser/interfaces
|
macro-debugger/syntax-browser/interfaces
|
||||||
"util.rkt"
|
"util.rkt"
|
||||||
macro-debugger/util/mpi
|
macro-debugger/util/mpi)
|
||||||
macro-debugger/util/stxobj)
|
|
||||||
(provide properties-view%
|
(provide properties-view%
|
||||||
properties-snip%)
|
properties-snip%)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user