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

hash-table support in pattern.rkt

This commit is contained in:
Tony Garnock-Jones 2013-10-30 16:03:17 +00:00
parent 0bd556c7b7
commit 38b4fb6068
2 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
minimart/pattern.rkt
View File

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

10
minimart/test-pattern.rkt
View File

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