47 lines
1.3 KiB
Scheme
47 lines
1.3 KiB
Scheme
|
|
(module pretty-range mzscheme
|
|
(require (lib "class.ss")
|
|
(lib "list.ss")
|
|
"interfaces.ss")
|
|
(provide ranges%
|
|
(struct range (obj start end)))
|
|
|
|
;; A range contains
|
|
;; - obj : datum, stand-in for syntax object
|
|
;; - start : number
|
|
;; - end : number
|
|
(define-struct range (obj start end))
|
|
|
|
;; ranges%
|
|
(define ranges%
|
|
(class* object% (range<%>)
|
|
(define starts (make-hash-table))
|
|
(define ranges (make-hash-table))
|
|
|
|
(define/public (get-start obj)
|
|
(hash-table-get starts obj (lambda _ #f)))
|
|
(define/public (get-ranges obj)
|
|
(hash-table-get ranges obj (lambda _ null)))
|
|
|
|
(define/public (all-ranges)
|
|
(sort
|
|
(apply append
|
|
(hash-table-map
|
|
ranges
|
|
(lambda (k vs)
|
|
(map (lambda (v) (make-range k (car v) (cdr v))) vs))))
|
|
(lambda (x y)
|
|
(>= (- (range-end x) (range-start x))
|
|
(- (range-end y) (range-start y))))))
|
|
|
|
(define/public (set-start obj n)
|
|
(hash-table-put! starts obj n))
|
|
(define/private (set-ranges obj x)
|
|
(hash-table-put! ranges obj x))
|
|
(define/public (add-range obj range)
|
|
(set-ranges obj (cons range (get-ranges obj))))
|
|
|
|
(super-new)))
|
|
|
|
)
|