More ergonomic step/prepend for tries and patches
This commit is contained in:
parent
81e10632dd
commit
f486f93bd4
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue