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 "treap.rkt")
|
||||
(require "tset.rkt")
|
||||
(require data/order)
|
||||
(require "hash-order.rkt")
|
||||
|
||||
(require rackunit)
|
||||
|
||||
|
@ -187,10 +187,10 @@
|
|||
(define sta? (struct-type? a))
|
||||
(define stb? (struct-type? b))
|
||||
(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? '<]
|
||||
[stb? '>]
|
||||
[else (datum-order a b)]))
|
||||
[else (hash-order a b)]))
|
||||
|
||||
;; (Treap (U Sigma Wildcard) Matcher)
|
||||
;; The empty branch-matcher
|
||||
|
@ -1564,7 +1564,7 @@
|
|||
(("__") ((2 (((")") (((")") ("" ("A")))))))
|
||||
(3 (((")") (((")") ("" ("D"))))))))))))))
|
||||
(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
|
||||
(check-requal? (pretty-print-matcher*
|
||||
|
|
|
@ -17,13 +17,13 @@
|
|||
tset-member?
|
||||
)
|
||||
|
||||
(require data/order)
|
||||
(require "hash-order.rkt")
|
||||
|
||||
(define (tset? t)
|
||||
(treap? t))
|
||||
|
||||
(define (datum-tset . elts)
|
||||
(make-tset datum-order elts))
|
||||
(make-tset hash-order elts))
|
||||
|
||||
(define (make-tset o elts)
|
||||
(for/fold [(t (tset-empty o))] [(e elts)] (tset-add t e)))
|
||||
|
@ -75,7 +75,7 @@
|
|||
(module+ test
|
||||
(require rackunit)
|
||||
(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 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))
|
||||
|
@ -88,7 +88,7 @@
|
|||
(check-equal? (tset-count (tset 1 2 3)) 3)
|
||||
(check-equal? (tset-count (tset)) 0)
|
||||
(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-false (tset? 123))
|
||||
(check-false (tset? (list 1 2 3)))
|
||||
|
|
Loading…
Reference in New Issue