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