syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Switch to arbitrary hash-order.

This commit is contained in:
Tony Garnock-Jones 2015-08-18 20:14:31 -04:00
parent 5eb155cc11
commit 35e966cb13
3 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
prospect/hash-order.rkt Normal file
View File

@ -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)))))

8
prospect/route.rkt
View File

@ -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*

8
prospect/tset.rkt
View File

@ -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)))