From db41cb63d7659392e15891c48fc1bef0b735a3f0 Mon Sep 17 00:00:00 2001
From: Sam Caldwell <samc@ccs.neu.edu>
Date: Fri, 17 May 2019 10:37:49 -0400
Subject: [PATCH] query-hash

---
 .../examples/roles/simple-query-hash.rkt      | 25 +++++++++++++++++++
 racket/typed/roles.rkt                        | 23 ++++++++++++++++-
 2 files changed, 47 insertions(+), 1 deletion(-)
 create mode 100644 racket/typed/examples/roles/simple-query-hash.rkt

diff --git a/racket/typed/examples/roles/simple-query-hash.rkt b/racket/typed/examples/roles/simple-query-hash.rkt
new file mode 100644
index 0000000..ffca473
--- /dev/null
+++ b/racket/typed/examples/roles/simple-query-hash.rkt
@@ -0,0 +1,25 @@
+#lang typed/syndicate/roles
+
+;; Expected Output
+;; size: 0
+;; size: 2
+
+(assertion-struct output : Output (v))
+
+(define-type-alias ds-type
+  (U (Tuple String Int)
+     (Output Int)
+     (Observe ★/t)))
+
+(run-ground-dataspace ds-type
+  (spawn ds-type
+   (start-facet querier
+     (define/query-hash key# (tuple (bind k String) (bind v Int)) k v)
+     (assert (output (hash-count (ref key#))))))
+   (spawn ds-type
+    (start-facet client
+      (assert (tuple "key1" 18))
+      (assert (tuple "key2" 88))
+      (during (output (bind v Int))
+        (on start
+            (printf "size: ~v\n" v))))))
diff --git a/racket/typed/roles.rkt b/racket/typed/roles.rkt
index 744ce17..c655938 100644
--- a/racket/typed/roles.rkt
+++ b/racket/typed/roles.rkt
@@ -18,7 +18,10 @@
          let let* if spawn dataspace start-facet set! begin stop begin/dataflow #;unsafe-do
          when unless send! define
          ;; Derived Forms
-         during define/query-value define/query-set
+         during
+         define/query-value
+         define/query-set
+         define/query-hash
          ;; endpoints
          assert on field
          ;; expressions
@@ -317,6 +320,24 @@
             (on (retracted p)
                 (set! x (set-remove (ref x) e))))])
 
+(define-typed-syntax (define/query-hash x:id p e-key e-value) ≫
+  #:with ([y τ] ...) (pat-bindings #'p)
+  ;; e-key and e-value will be re-expanded :/
+  ;; but it's the most straightforward way to keep bindings in sync with
+  ;; pattern
+  [[y ≫ y- : τ] ... ⊢ e-key ≫ e-key- ⇒ τ-key]
+  [[y ≫ y-- : τ] ... ⊢ e-value ≫ e-value- ⇒ τ-value]
+  ;; TODO - this is gross, is there a better way to do this?
+  ;; #:with e-value-- (substs #'(y- ...) #'(y-- ...) #'e-value- free-identifier=?)
+  ;; I thought I could put e-key- and e-value-(-) in the output below, but that
+  ;; gets their references to pattern variables out of sync with `p`
+  ----------------------------------------
+  [≻ (begin (field [x (Hash τ-key τ-value) (hash)])
+            (on (asserted p)
+                (set! x (hash-set (ref x) e-key e-value)))
+            (on (retracted p)
+                (set! x (hash-remove (ref x) e-key))))])
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Expressions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;