syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Remove/unprovide a few unneeded utilities from patch.rkt

This commit is contained in:
Tony Garnock-Jones 2017-06-23 17:57:35 -04:00
parent 9b54069ecd
commit 46fd5e2b92
3 changed files with 14 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
racket/syndicate/ground.rkt
View File

@ -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)])]))

15
racket/syndicate/monolithic/scn.rkt
View File

@ -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)))

29
racket/syndicate/patch.rkt
View File

@ -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)