From a357ee388c1632e740053121b41c3230985dc770 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sat, 26 Oct 2013 19:07:10 +0100
Subject: [PATCH] Presence detector

---
 pattern.rkt           |  9 ++++++++-
 presence-detector.rkt | 28 ++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+), 1 deletion(-)
 create mode 100644 presence-detector.rkt

diff --git a/pattern.rkt b/pattern.rkt
index f81063e..c0119bf 100644
--- a/pattern.rkt
+++ b/pattern.rkt
@@ -7,7 +7,8 @@
 	 wildcard?
 	 specialization?
 	 ground?
-	 intersect)
+	 intersect
+	 intersect?)
 
 (struct exn:unification-failure ())
 (define unification-failure (exn:unification-failure))
@@ -87,3 +88,9 @@
   (if ok?
       (ks result)
       (kf)))
+
+;; Any Any -> Boolean
+(define (intersect? a b)
+  (with-handlers ([exn:unification-failure? (lambda (e) #f)])
+    (unify a b)
+    #t))
diff --git a/presence-detector.rkt b/presence-detector.rkt
new file mode 100644
index 0000000..eba6bc2
--- /dev/null
+++ b/presence-detector.rkt
@@ -0,0 +1,28 @@
+#lang racket/base
+
+(require racket/set)
+(require "core.rkt")
+(require "pattern.rkt")
+
+(provide (except-out (struct-out presence-detector) presence-detector)
+	 (rename-out [make-presence-detector presence-detector])
+	 presence-detector-update
+	 presence-exists-for?)
+
+(struct presence-detector (route-set) #:transparent)
+
+(define (make-presence-detector [initial-routes '()])
+  (presence-detector (list->set initial-routes)))
+
+(define (presence-detector-update p rs)
+  (define old-route-set (presence-detector-route-set p))
+  (define new-route-set (list->set rs))
+  (values (struct-copy presence-detector p [route-set new-route-set])
+	  (set-subtract new-route-set old-route-set)
+	  (set-subtract old-route-set new-route-set)))
+
+(define (presence-exists-for? p probe-route)
+  (for/or ((existing-route (in-set (presence-detector-route-set p))))
+    (and (equal? (route-subscription? probe-route) (route-subscription? existing-route))
+	 (equal? (route-meta-level probe-route) (route-meta-level existing-route))
+	 (intersect? (route-pattern probe-route) (route-pattern existing-route)))))