diff --git a/racket/syndicate/patch.rkt b/racket/syndicate/patch.rkt index acd695f..189cc61 100644 --- a/racket/syndicate/patch.rkt +++ b/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 diff --git a/racket/syndicate/support/struct.rkt b/racket/syndicate/support/struct.rkt index c74b351..bc9694c 100644 --- a/racket/syndicate/support/struct.rkt +++ b/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) + diff --git a/racket/syndicate/trie.rkt b/racket/syndicate/trie.rkt index 6ff37a0..31ab24a 100644 --- a/racket/syndicate/trie.rkt +++ b/racket/syndicate/trie.rkt @@ -15,6 +15,7 @@ (rename-out [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.