Switch to arbitrary hash-order.
This commit is contained in:
parent
5eb155cc11
commit
35e966cb13
|
@ -0,0 +1,12 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide hash-order)
|
||||||
|
|
||||||
|
(require data/order)
|
||||||
|
(require racket/contract)
|
||||||
|
|
||||||
|
(define hash-order
|
||||||
|
(order 'hash-order
|
||||||
|
any/c
|
||||||
|
eq?
|
||||||
|
(lambda (a b) (< (eq-hash-code a) (eq-hash-code b)))))
|
|
@ -67,7 +67,7 @@
|
||||||
(require "canonicalize.rkt")
|
(require "canonicalize.rkt")
|
||||||
(require "treap.rkt")
|
(require "treap.rkt")
|
||||||
(require "tset.rkt")
|
(require "tset.rkt")
|
||||||
(require data/order)
|
(require "hash-order.rkt")
|
||||||
|
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
|
|
||||||
|
@ -187,10 +187,10 @@
|
||||||
(define sta? (struct-type? a))
|
(define sta? (struct-type? a))
|
||||||
(define stb? (struct-type? b))
|
(define stb? (struct-type? b))
|
||||||
(cond
|
(cond
|
||||||
[(and sta? stb?) (datum-order (struct-type-name a) (struct-type-name b))]
|
[(and sta? stb?) (hash-order (struct-type-name a) (struct-type-name b))]
|
||||||
[sta? '<]
|
[sta? '<]
|
||||||
[stb? '>]
|
[stb? '>]
|
||||||
[else (datum-order a b)]))
|
[else (hash-order a b)]))
|
||||||
|
|
||||||
;; (Treap (U Sigma Wildcard) Matcher)
|
;; (Treap (U Sigma Wildcard) Matcher)
|
||||||
;; The empty branch-matcher
|
;; The empty branch-matcher
|
||||||
|
@ -1564,7 +1564,7 @@
|
||||||
(("__") ((2 (((")") (((")") ("" ("A")))))))
|
(("__") ((2 (((")") (((")") ("" ("A")))))))
|
||||||
(3 (((")") (((")") ("" ("D"))))))))))))))
|
(3 (((")") (((")") ("" ("D"))))))))))))))
|
||||||
(check-equal? (matcher->jsexpr M (lambda (v) (map symbol->string (tset->list v)))) S)
|
(check-equal? (matcher->jsexpr M (lambda (v) (map symbol->string (tset->list v)))) S)
|
||||||
(check-requal? (jsexpr->matcher S (lambda (v) (make-tset datum-order (map string->symbol v)))) M)))
|
(check-requal? (jsexpr->matcher S (lambda (v) (make-tset hash-order (map string->symbol v)))) M)))
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(check-requal? (pretty-print-matcher*
|
(check-requal? (pretty-print-matcher*
|
||||||
|
|
|
@ -17,13 +17,13 @@
|
||||||
tset-member?
|
tset-member?
|
||||||
)
|
)
|
||||||
|
|
||||||
(require data/order)
|
(require "hash-order.rkt")
|
||||||
|
|
||||||
(define (tset? t)
|
(define (tset? t)
|
||||||
(treap? t))
|
(treap? t))
|
||||||
|
|
||||||
(define (datum-tset . elts)
|
(define (datum-tset . elts)
|
||||||
(make-tset datum-order elts))
|
(make-tset hash-order elts))
|
||||||
|
|
||||||
(define (make-tset o elts)
|
(define (make-tset o elts)
|
||||||
(for/fold [(t (tset-empty o))] [(e elts)] (tset-add t e)))
|
(for/fold [(t (tset-empty o))] [(e elts)] (tset-add t e)))
|
||||||
|
@ -75,7 +75,7 @@
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(require data/order)
|
(require data/order)
|
||||||
(define (tset . elts) (make-tset datum-order elts))
|
(define (tset . elts) (make-tset hash-order elts))
|
||||||
(check-equal? (tset->list (tset 1 2 3 4 5)) '(1 2 3 4 5))
|
(check-equal? (tset->list (tset 1 2 3 4 5)) '(1 2 3 4 5))
|
||||||
(check-equal? (tset->list (tset 5 4 3 2 1)) '(1 2 3 4 5))
|
(check-equal? (tset->list (tset 5 4 3 2 1)) '(1 2 3 4 5))
|
||||||
(check-equal? (tset->list (tset-union (tset 1 2 3) (tset 2 3 4))) '(1 2 3 4))
|
(check-equal? (tset->list (tset-union (tset 1 2 3) (tset 2 3 4))) '(1 2 3 4))
|
||||||
|
@ -88,7 +88,7 @@
|
||||||
(check-equal? (tset-count (tset 1 2 3)) 3)
|
(check-equal? (tset-count (tset 1 2 3)) 3)
|
||||||
(check-equal? (tset-count (tset)) 0)
|
(check-equal? (tset-count (tset)) 0)
|
||||||
(check-equal? (tset-count (tset-union (tset 1 2 3) (tset 2 3 4))) 4)
|
(check-equal? (tset-count (tset-union (tset 1 2 3) (tset 2 3 4))) 4)
|
||||||
(check-true (tset? (tset-empty datum-order)))
|
(check-true (tset? (tset-empty hash-order)))
|
||||||
(check-true (tset? (tset)))
|
(check-true (tset? (tset)))
|
||||||
(check-false (tset? 123))
|
(check-false (tset? 123))
|
||||||
(check-false (tset? (list 1 2 3)))
|
(check-false (tset? (list 1 2 3)))
|
||||||
|
|
Loading…
Reference in New Issue