hash-table support in pattern.rkt
This commit is contained in:
parent
0bd556c7b7
commit
38b4fb6068
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require (only-in racket/class object?))
|
||||
|
||||
|
@ -41,6 +42,10 @@
|
|||
(for/and ([aa a] [bb b]) (walk aa bb))]
|
||||
[(and (non-object-struct? a) (non-object-struct? b))
|
||||
(walk (struct->vector a #f) (struct->vector b #f))]
|
||||
[(and (hash? a) (hash? b))
|
||||
(for/and ([k (in-hash-keys b)])
|
||||
(and (hash-has-key? a k)
|
||||
(walk (hash-ref a k) (hash-ref b k))))]
|
||||
[else (equal? a b)])))
|
||||
|
||||
;; Any -> Boolean
|
||||
|
@ -53,6 +58,7 @@
|
|||
[(pair? x) (and (walk (car x)) (walk (cdr x)))]
|
||||
[(vector? x) (andmap walk (vector->list x))]
|
||||
[(non-object-struct? x) (walk (struct->vector x #f))]
|
||||
[(hash? x) (for/and ([v (in-hash-values x)]) (walk v))]
|
||||
[else #t])))
|
||||
|
||||
;; Vector StructType -> Struct
|
||||
|
@ -76,6 +82,11 @@
|
|||
(when ta-skipped? (fail))
|
||||
(when tb-skipped? (fail))
|
||||
(vector->struct (unify (struct->vector a) (struct->vector b)) ta)]
|
||||
[(and (hash? a) (hash? b))
|
||||
(for/hash ([k (in-set (set-union (list->set (hash-keys a)) (list->set (hash-keys b))))])
|
||||
(when (not (hash-has-key? a k)) (fail))
|
||||
(when (not (hash-has-key? b k)) (fail))
|
||||
(values k (unify (hash-ref a k) (hash-ref b k))))]
|
||||
[(equal? a b)
|
||||
a]
|
||||
[else (fail)]))
|
||||
|
|
|
@ -28,3 +28,13 @@
|
|||
(check-equal? (intersect-or-void (b 'a) (b 'a)) (b 'a))
|
||||
(check-equal? (intersect-or-void (b 'a) (b ?)) (b 'a))
|
||||
(check-equal? (intersect-or-void (b 'a) ?) (b 'a))
|
||||
|
||||
(check-equal? (intersect-or-void (hash 'a 1 'b ?) (hash 'a ? 'b 2)) (hash 'a 1 'b 2))
|
||||
(check-equal? (intersect-or-void (hash 'a 1 'b ?) (hash 'a ?)) (void))
|
||||
(check-equal? (intersect-or-void (hash 'a 1 'b ?) (hash 'a 1 'b ?)) (hash 'a 1 'b ?))
|
||||
(check-equal? (intersect-or-void (hash 'a 1 'b ?) (hash 'a ? 'c ?)) (void))
|
||||
|
||||
(check-equal? (intersect-or-void (hash 'a 1 'b ?) (hash 'a 1 'b (list 2 ?)))
|
||||
(hash 'a 1 'b (list 2 ?)))
|
||||
(check-equal? (intersect-or-void (hash 'a 1 'b (list ? 3)) (hash 'a 1 'b (list 2 ?)))
|
||||
(hash 'a 1 'b (list 2 3)))
|
||||
|
|
Loading…
Reference in New Issue