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

More tests of projection; change to default matcher-union-successes

This commit is contained in:
Tony Garnock-Jones 2014-05-25 13:22:49 -04:00
parent a9c750ab6b
commit 5058330e80
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
minimart/gestalt.rkt
View File

@ -168,16 +168,11 @@
;; View on g1 from g2's perspective.
(define (gestalt-filter g1 g2)
(parameterize ((matcher-union-successes (lambda (v1 v2)
(match* (v1 v2)
[(#t v) v]
[(v #t) v]
[(v1 v2) (set-union v1 v2)]))))
(gestalt (map-zip shorter-imbalance-handler
filter-one-metalevel
cons-metalevel
(gestalt-metalevels g1)
(gestalt-metalevels g2)))))
(gestalt (map-zip shorter-imbalance-handler
filter-one-metalevel
cons-metalevel
(gestalt-metalevels g1)
(gestalt-metalevels g2))))
;; Much like gestalt-filter, takes a view on gestalt g1 from g2's
;; perspective. However, instead of returning the filtered g1, returns

24
minimart/route.rkt
View File

@ -35,7 +35,11 @@
matcher-project-success)
;; TODO: perhaps avoid the parameters on the fast-path, if they are causing measurable slowdown.
(define matcher-union-successes (make-parameter set-union))
(define matcher-union-successes (make-parameter (lambda (v1 v2)
(match* (v1 v2)
[(#t v) v]
[(v #t) v]
[(v1 v2) (set-union v1 v2)]))))
(define matcher-intersect-successes (make-parameter set-union))
(define matcher-erase-path-successes (make-parameter (lambda (s1 s2)
(define r (set-subtract s1 s2))
@ -1106,6 +1110,22 @@
(list (pattern->matcher #t (vector 1 4))
(pattern->matcher #t (vector 3 4)))))
(check-equal? (matcher-key-set
(matcher-project (foldr matcher-union (matcher-empty)
(list (pattern->matcher SA (cons 1 2))
(pattern->matcher SC (cons ? 3))
(pattern->matcher SB (cons 3 4))))
(compile-projection (cons (?!) (?!)))))
#f)
(check-equal? (matcher-key-set
(matcher-project (foldr matcher-union (matcher-empty)
(list (pattern->matcher SA (cons ? 2))
(pattern->matcher SC (cons 1 3))
(pattern->matcher SB (cons 3 4))))
(compile-projection (cons ? (?!)))))
(set '#(2) '#(3) '#(4)))
(check-equal? (matcher-key-set
(matcher-project (matcher-union (pattern->matcher SA (cons 1 2))
(pattern->matcher SB (cons 3 4)))
@ -1123,4 +1143,4 @@
(check-equal? (projection->pattern (list 'a (?! 'b))) (list 'a 'b))
(check-equal? (projection->pattern (list 'a (?! (vector 'b)))) (list 'a (vector 'b)))
(check-equal? (projection->pattern (list 'a (?! (vector ? ?)))) (list 'a (vector ? ?)))
)
)