From fb5a39d3af6c87297788cbb2144358cdefb15bcc Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 5 Mar 2015 16:40:17 +0000 Subject: [PATCH] Add update-interests (similar to apply-patch) --- prospect/patch.rkt | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/prospect/patch.rkt b/prospect/patch.rkt index 20e0b73..da73a26 100644 --- a/prospect/patch.rkt +++ b/prospect/patch.rkt @@ -16,6 +16,7 @@ limit-patch compute-aggregate-patch apply-patch + update-interests unapply-patch compose-patch patch-seq @@ -92,10 +93,17 @@ (patch (matcher-subtract (patch-added p) base #:combiner combiner) (matcher-subtract (patch-removed p) base #:combiner combiner))) +;; For use by Matchers leading to (Setof Label). (define (apply-patch base p) (match-define (patch in out) p) (matcher-union (matcher-subtract base out) in)) +;; Like apply-patch, but for use by Matchers leading to True. +(define (update-interests base p) + (match-define (patch in out) p) + (matcher-union (matcher-subtract base out #:combiner (lambda (v1 v2) #f)) in + #:combiner (lambda (v1 v2) #t))) + (define (unapply-patch base p) (match-define (patch in out) p) (matcher-union (matcher-subtract base in) out)) @@ -105,8 +113,7 @@ ;; except for problems arising from use of set-subtract by default in {un,}apply-patch (match-define (patch in1 out1) p1) (match-define (patch in2 out2) p2) - (patch (matcher-union (matcher-subtract in1 out2 #:combiner (lambda (v1 v2) #f)) in2 - #:combiner (lambda (v1 v2) #t)) + (patch (update-interests in1 p2) (matcher-union (matcher-subtract out1 in2 #:combiner (lambda (v1 v2) #f)) out2 #:combiner (lambda (v1 v2) #t))))