From 129dd23b84f04422a8c2b679630966b075dc24fd Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 30 Jul 2016 06:08:29 -0400 Subject: [PATCH] Remove obsolete endpoint.rkt and its example --- racket/syndicate/endpoint.rkt | 181 ------------------ .../syndicate/examples/endpoint-example.rkt | 67 ------- 2 files changed, 248 deletions(-) delete mode 100644 racket/syndicate/endpoint.rkt delete mode 100644 racket/syndicate/examples/endpoint-example.rkt diff --git a/racket/syndicate/endpoint.rkt b/racket/syndicate/endpoint.rkt deleted file mode 100644 index edc9cea..0000000 --- a/racket/syndicate/endpoint.rkt +++ /dev/null @@ -1,181 +0,0 @@ -#lang racket/base -;; Marketplace-style endpoints (analogous to threads) - -(provide (struct-out endpoint-group) - (struct-out add-endpoint) - (struct-out delete-endpoint) - (struct-out as-endpoint) - make-endpoint-group - spawn-endpoint-group - boot-endpoint-group - endpoint-action? - endpoint-group-handle-event - pretty-print-endpoint-group) - -(require racket/set) -(require racket/match) -(require (only-in racket/list flatten)) -(require "trie.rkt") -(require "patch.rkt") -(require "core.rkt") -(require "mux.rkt") -(require "pretty.rkt") -(require "tset.rkt") - -;; An EID is a Nat. - -;; Endpoint-group private states -(struct endpoint-group (mux ;; Mux - endpoints ;; (HashTable EID Endpoint) - state ;; Any - ) - #:transparent - #:methods gen:syndicate-pretty-printable - [(define (syndicate-pretty-print g [p (current-output-port)]) - (pretty-print-endpoint-group g p))]) - -;; A Endpoint is a (Event State -> Transition) -;; A Transition reuses the struct from core, but with EndpointActions instead of plain Actions. -;; An EndpointAction is either an Action, or a -;; (add-endpoint (EID State -> (Values Endpoint Transition))), or a -;; (delete-endpoint) -;; (as-endpoint EID EndpointAction) -(struct add-endpoint (function) #:prefab) -(struct delete-endpoint () #:prefab) -(struct as-endpoint (eid action) #:prefab) - -(define (make-endpoint-group initial-state) - (endpoint-group (mux) - (hash) - initial-state)) - -(define-syntax-rule (spawn-endpoint-group initial-state action-constree ...) - ( (lambda () (boot-endpoint-group initial-state (list action-constree ...))))) - -(define (boot-endpoint-group initial-state initial-actions) - (define-values (final-cumulative-patch final-actions final-g) - (interpret-endpoint-actions patch-empty - '() - (make-endpoint-group initial-state) - -1 - initial-actions)) - (list endpoint-group-handle-event - (transition final-g (incorporate-cumulative-patch final-actions - final-cumulative-patch)) - #f)) - -(define (endpoint-action? a) - (or (action? a) - (add-endpoint? a) - (delete-endpoint? a) - (and (as-endpoint? a) (endpoint-action? (as-endpoint-action a))))) - -(define (inert-endpoint e state) #f) - -(define (endpoint-group-handle-event e g) - (match-define (endpoint-group m endpoints state) g) - (define affected-eids - (match e - [#f (hash-keys endpoints)] - [(? patch?) (compute-affected-pids (mux-routing-table m) e)] - [(message body) (mux-route-message m body)])) - (sequence-handlers g (for/list [(eid (sort affected-eids <))] - (list (if (patch? e) - (view-patch e (mux-interests-of m eid)) - e) - eid - (hash-ref endpoints eid (lambda () inert-endpoint)))))) - -(define (sequence-handlers g tasks) - (let/ec return - (define-values (final-cumulative-patch final-actions final-g idle?) - (for/fold ([cumulative-patch patch-empty] - [actions '()] - [g g] - [idle? #t]) - ([task tasks]) - (match-define (list e eid ep) task) - (match (ep e (endpoint-group-state g)) - [#f (values cumulative-patch actions g idle?)] - [( exn ep-acs) (return ( exn (filter action? (flatten ep-acs))))] - [(transition new-state ep-acs) - (define-values (cp acs next-g) - (interpret-endpoint-actions cumulative-patch - actions - (struct-copy endpoint-group g [state new-state]) - eid - ep-acs)) - (values cp acs next-g #f)]))) - (if idle? - #f - (transition final-g (incorporate-cumulative-patch final-actions final-cumulative-patch))))) - -(define (incorporate-cumulative-patch actions cumulative-patch) - (if (patch-empty? cumulative-patch) - actions - (cons actions cumulative-patch))) - -(define (interpret-endpoint-patch cumulative-patch actions g eid p0) - (define-values (new-mux _eid p p-aggregate) - (mux-update-stream (endpoint-group-mux g) eid p0)) - (values (patch-seq cumulative-patch p-aggregate) - actions - (struct-copy endpoint-group g [mux new-mux]))) - -(define (interpret-endpoint-action cumulative-patch actions g eid endpoint-action) - (match endpoint-action - [(or (? message?) - (? spawn?)) - (values patch-empty - (cons (incorporate-cumulative-patch actions cumulative-patch) endpoint-action) - g)] - [(? patch? p0) - (interpret-endpoint-patch cumulative-patch actions g eid p0)] - [(add-endpoint function) - (define-values (new-mux new-eid _p _p-aggregate) - (mux-add-stream (endpoint-group-mux g) patch-empty)) - (define-values (new-ep initial-transition) (function new-eid (endpoint-group-state g))) - (interpret-endpoint-actions cumulative-patch - actions - (struct-copy endpoint-group g - [mux new-mux] - [endpoints - (hash-set (endpoint-group-endpoints g) - new-eid - new-ep)] - [state (transition-state initial-transition)]) - new-eid - (transition-actions initial-transition))] - [(delete-endpoint) - (interpret-endpoint-patch cumulative-patch - actions - (struct-copy endpoint-group g - [endpoints - (hash-remove (endpoint-group-endpoints g) eid)]) - eid - (patch trie-empty (pattern->trie ' ?)))] - [(as-endpoint other-eid inner-endpoint-action) - (interpret-endpoint-actions cumulative-patch actions g other-eid inner-endpoint-action)])) - -(define (interpret-endpoint-actions cumulative-patch actions g eid unflattened-endpoint-actions) - (define endpoint-actions (filter endpoint-action? (flatten unflattened-endpoint-actions))) - (for/fold ([cumulative-patch cumulative-patch] - [actions actions] - [g g]) - ([endpoint-action endpoint-actions]) - (interpret-endpoint-action cumulative-patch - actions - g - eid - endpoint-action))) - -(define (pretty-print-endpoint-group g [p (current-output-port)]) - (match-define (endpoint-group m endpoints state) g) - (fprintf p "ENDPOINT GROUP:\n") - (fprintf p " ---- STATE:\n") - (display (indented-port-output 6 (lambda (p) (syndicate-pretty-print state p))) p) - (newline p) - (fprintf p " - ~a endpoints\n" (hash-count endpoints)) - (fprintf p " - next eid: ~a\n" (mux-next-pid mux)) - (fprintf p " - routing table:\n") - (pretty-print-trie (mux-routing-table mux) p)) diff --git a/racket/syndicate/examples/endpoint-example.rkt b/racket/syndicate/examples/endpoint-example.rkt deleted file mode 100644 index b6c6f92..0000000 --- a/racket/syndicate/examples/endpoint-example.rkt +++ /dev/null @@ -1,67 +0,0 @@ -#lang syndicate - -(require "../endpoint.rkt") -(require/activate "../drivers/timer.rkt") - -(define ((log-it eid) e u) - (log-info "endpoint ~a state ~a: ~v" eid u e) - (and e (transition (+ u 1) - (if (equal? e (message 2)) - (if (equal? eid 0) - (list (unsub 2) (sub 5) (as-endpoint 1 (delete-endpoint))) - (list (unsub 2) (sub 5))) - '())))) - -(spawn (lambda (e u) - (when (message? e) (log-info "general: ~v" e)) - #f) - (void) - (patch-seq (sub ?) - (unsub (observe ?)) - (unsub (at-meta ?)))) - -(spawn-endpoint-group 0 - (add-endpoint - (lambda (eid state) - (values (log-it eid) - (transition state - (list (sub 1) - (sub 2)))))) - (add-endpoint - (lambda (eid state) - (values (log-it eid) - (transition state - (list (sub 3) - (sub 2))))))) - -(define (after msec thunk) - (define id (gensym 'after)) - (if (zero? msec) - (thunk) - (list - (spawn (lambda (e s) (and (message? e) (quit (thunk)))) - (void) - (sub (timer-expired id ?))) - (message (set-timer id msec 'relative))))) - -(after 100 - (lambda () - (list - (message 0) - (message 1) - (message 2) - (message 3) - (message 4) - (message 5) - (message 6)))) - -(after 100 - (lambda () - (list - (message 0) - (message 1) - (message 2) - (message 3) - (message 4) - (message 5) - (message 6))))