More ergonomic step/prepend for tries and patches

racket/syndicate/patch.rkt

@@ -22,6 +22,7 @@
          limit-patch/routing-table
          patch-pruned-by
          patch-without-at-meta
+         patch-step
          only-meta-tset
          compute-aggregate-patch
          apply-patch
@@ -148,6 +149,12 @@
 (define (patch-without-at-meta p)
   (patch-pruned-by p at-meta-everything))
 
+;; Steps both added and removes sets
+(define (patch-step p key)
+  (match-define (patch added removed) p)
+  (patch (trie-step added key)
+         (trie-step removed key)))
+
 (define only-meta-tset (datum-tset 'meta))
 
 ;; Entries labelled with `label` may already exist in `base`; the

racket/syndicate/support/struct.rkt

@@ -3,6 +3,7 @@
 
 (provide non-object-struct?
          struct-type-name
+         struct-type-constructor-arity
          struct->struct-type)
 
 (require (only-in racket/class object?))
@@ -20,9 +21,15 @@
   (define-values (name x2 x3 x4 x5 x6 x7 x8) (struct-type-info st))
   name)
 
+;; StructType -> Natural
+(define (struct-type-constructor-arity st)
+  (define-values (x1 arity x3 x4 x5 x6 x7 x8) (struct-type-info st))
+  arity)
+
 ;; Structure -> StructType
 ;; Errors when given any struct that isn't completely transparent/prefab.
 (define (struct->struct-type p)
   (define-values (t skipped?) (struct-info p))
   (when skipped? (error 'struct->struct-type "Cannot reflect on struct instance ~v" p))
   t)
+

racket/syndicate/trie.rkt

@@ -15,6 +15,7 @@
          (rename-out [open-parenthesis <open-parenthesis>]
                      [canonical-open-parenthesis open-parenthesis])
          (except-out (struct-out open-parenthesis) open-parenthesis)
+         struct-type->parenthesis
 
          ?
          wildcard?
@@ -27,8 +28,7 @@
          trie
          trie-empty?
          trie-non-empty?
-         (rename-out [rsigma trie-prepend-atom])
-         (rename-out [ropen trie-prepend-parenthesis])
+         trie-prepend
 
          pattern->trie*
          pattern->trie
@@ -304,14 +304,28 @@
 (define (canonical-open-parenthesis arity type)
   (canonicalize (open-parenthesis arity type)))
 
+;; StructType -> OpenParenthesis
+(define (struct-type->parenthesis st)
+  (canonical-open-parenthesis (struct-type-constructor-arity st) st))
+
+;; OpenParenthesis Trie -> Trie
+;; Prepends an open-parenthesis edge to r, if r is non-empty
+(define (ropen* paren r)
+  (if (trie-empty? r)
+      r
+      (canonicalize (branch (treap-insert empty-omap paren r) trie-empty empty-smap))))
+
 ;; Natural ParenType Trie -> Trie
 ;; Prepends an open-parenthesis edge to r, if r is non-empty
 (define (ropen arity type r)
-  (if (trie-empty? r)
-      r
-      (canonicalize (branch (treap-insert empty-omap (canonical-open-parenthesis arity type) r)
-                            trie-empty
-                            empty-smap))))
+  (ropen* (canonical-open-parenthesis arity type) r))
+
+;; (U Sigma OpenParenthesis) Trie -> Trie
+;; User-accessible rsigma / ropen*.
+(define (trie-prepend key r)
+  (if (open-parenthesis? key)
+      (ropen* key r)
+      (rsigma (canonicalize key) r)))
 
 ;; Natural Trie -> Trie
 ;; Prepends n wildcard edges to r, if r is non-empty.