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)
(match a
[(? 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)
(process-actions actions interests)])]))

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

@ -1,28 +1,15 @@
#lang racket/base
;; State Change Notifications, and assorted protocol constructors
(provide (struct-out scn)
strip-scn
label-scn)
(provide (struct-out scn))
(require racket/set)
(require racket/match)
(require "../trie.rkt")
(require "../patch.rkt")
(require "../pretty.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; State Change Notifications
(struct scn (trie) #:transparent
#:methods gen:syndicate-pretty-printable
[(define (syndicate-pretty-print d [p (current-output-port)])
(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/added?
patch/removed?
strip-interests
label-interests
strip-patch
label-patch
limit-patch
limit-patch/routing-table
patch-pruned-by
patch-step
patch-step*
compute-aggregate-patch
@ -79,16 +74,9 @@
(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 (strip-interests g)
(trie-relabel g (lambda (v) '<strip-interests>)))
(define (label-interests g 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)
(patch (label-interests (patch-added p) label)
(label-interests (patch-removed p) label)))
@ -117,11 +105,11 @@
(trie-intersect out bound
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2))))))
;; Completely ignores success-values in t.
(define (patch-pruned-by p t)
(match-define (patch added removed) p)
(patch (trie-subtract #:combiner (lambda (v1 v2) trie-empty) added t)
(trie-subtract #:combiner (lambda (v1 v2) trie-empty) removed t)))
;; ;; Completely ignores success-values in t.
;; (define (patch-pruned-by p t)
;; (match-define (patch added removed) p)
;; (patch (trie-subtract #:combiner (lambda (v1 v2) trie-empty) added t)
;; (trie-subtract #:combiner (lambda (v1 v2) trie-empty) removed t)))
;; Steps both added and removes sets
(define (patch-step p key)
@ -277,6 +265,13 @@
(pattern->trie label-set ?)
#: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 (sanity-check-examples)