Remove/unprovide a few unneeded utilities from patch.rkt
This commit is contained in:
parent
9b54069ecd
commit
46fd5e2b92
|
@ -143,7 +143,7 @@
|
||||||
[(cons a actions)
|
[(cons a actions)
|
||||||
(match a
|
(match a
|
||||||
[(? patch? p)
|
[(? patch? p)
|
||||||
(process-actions actions (apply-patch interests (label-patch p (datum-tset 'root))))]
|
(process-actions actions (update-interests interests p))]
|
||||||
[_
|
[_
|
||||||
(log-syndicate/ground-warning "run-ground: ignoring useless meta-action ~v" a)
|
(log-syndicate/ground-warning "run-ground: ignoring useless meta-action ~v" a)
|
||||||
(process-actions actions interests)])]))
|
(process-actions actions interests)])]))
|
||||||
|
|
|
@ -1,28 +1,15 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
;; State Change Notifications, and assorted protocol constructors
|
;; State Change Notifications, and assorted protocol constructors
|
||||||
|
|
||||||
(provide (struct-out scn)
|
(provide (struct-out scn))
|
||||||
strip-scn
|
|
||||||
label-scn)
|
|
||||||
|
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require "../trie.rkt")
|
(require "../trie.rkt")
|
||||||
(require "../patch.rkt")
|
|
||||||
(require "../pretty.rkt")
|
(require "../pretty.rkt")
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; State Change Notifications
|
;; State Change Notifications
|
||||||
(struct scn (trie) #:transparent
|
(struct scn (trie) #:transparent
|
||||||
#:methods gen:syndicate-pretty-printable
|
#:methods gen:syndicate-pretty-printable
|
||||||
[(define (syndicate-pretty-print d [p (current-output-port)])
|
[(define (syndicate-pretty-print d [p (current-output-port)])
|
||||||
(pretty-print-trie (scn-trie d) p))])
|
(pretty-print-trie (scn-trie d) p))])
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (strip-scn s)
|
|
||||||
(scn (strip-interests (scn-trie s))))
|
|
||||||
|
|
||||||
(define (label-scn s label)
|
|
||||||
(scn (label-interests (scn-trie s) label)))
|
|
||||||
|
|
|
@ -9,13 +9,8 @@
|
||||||
patch-non-empty?
|
patch-non-empty?
|
||||||
patch/added?
|
patch/added?
|
||||||
patch/removed?
|
patch/removed?
|
||||||
strip-interests
|
|
||||||
label-interests
|
|
||||||
strip-patch
|
|
||||||
label-patch
|
label-patch
|
||||||
limit-patch
|
limit-patch
|
||||||
limit-patch/routing-table
|
|
||||||
patch-pruned-by
|
|
||||||
patch-step
|
patch-step
|
||||||
patch-step*
|
patch-step*
|
||||||
compute-aggregate-patch
|
compute-aggregate-patch
|
||||||
|
@ -79,16 +74,9 @@
|
||||||
(define (patch/added? p) (and (patch? p) (trie-non-empty? (patch-added p))))
|
(define (patch/added? p) (and (patch? p) (trie-non-empty? (patch-added p))))
|
||||||
(define (patch/removed? p) (and (patch? p) (trie-non-empty? (patch-removed p))))
|
(define (patch/removed? p) (and (patch? p) (trie-non-empty? (patch-removed p))))
|
||||||
|
|
||||||
(define (strip-interests g)
|
|
||||||
(trie-relabel g (lambda (v) '<strip-interests>)))
|
|
||||||
|
|
||||||
(define (label-interests g label)
|
(define (label-interests g label)
|
||||||
(trie-relabel g (lambda (v) label)))
|
(trie-relabel g (lambda (v) label)))
|
||||||
|
|
||||||
(define (strip-patch p)
|
|
||||||
(patch (strip-interests (patch-added p))
|
|
||||||
(strip-interests (patch-removed p))))
|
|
||||||
|
|
||||||
(define (label-patch p label)
|
(define (label-patch p label)
|
||||||
(patch (label-interests (patch-added p) label)
|
(patch (label-interests (patch-added p) label)
|
||||||
(label-interests (patch-removed p) label)))
|
(label-interests (patch-removed p) label)))
|
||||||
|
@ -117,11 +105,11 @@
|
||||||
(trie-intersect out bound
|
(trie-intersect out bound
|
||||||
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2))))))
|
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2))))))
|
||||||
|
|
||||||
;; Completely ignores success-values in t.
|
;; ;; Completely ignores success-values in t.
|
||||||
(define (patch-pruned-by p t)
|
;; (define (patch-pruned-by p t)
|
||||||
(match-define (patch added removed) p)
|
;; (match-define (patch added removed) p)
|
||||||
(patch (trie-subtract #:combiner (lambda (v1 v2) trie-empty) added t)
|
;; (patch (trie-subtract #:combiner (lambda (v1 v2) trie-empty) added t)
|
||||||
(trie-subtract #:combiner (lambda (v1 v2) trie-empty) removed t)))
|
;; (trie-subtract #:combiner (lambda (v1 v2) trie-empty) removed t)))
|
||||||
|
|
||||||
;; Steps both added and removes sets
|
;; Steps both added and removes sets
|
||||||
(define (patch-step p key)
|
(define (patch-step p key)
|
||||||
|
@ -277,6 +265,13 @@
|
||||||
(pattern->trie label-set ?)
|
(pattern->trie label-set ?)
|
||||||
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2)))))
|
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2)))))
|
||||||
|
|
||||||
|
(define (strip-interests g)
|
||||||
|
(trie-relabel g (lambda (v) '<strip-interests>)))
|
||||||
|
|
||||||
|
(define (strip-patch p)
|
||||||
|
(patch (strip-interests (patch-added p))
|
||||||
|
(strip-interests (patch-removed p))))
|
||||||
|
|
||||||
(define tset datum-tset)
|
(define tset datum-tset)
|
||||||
|
|
||||||
(define (sanity-check-examples)
|
(define (sanity-check-examples)
|
||||||
|
|
Loading…
Reference in New Issue