├── neuron-doc ├── scribblings │ ├── full-width.css │ ├── leading-spaces.css │ ├── neuron-library-stack.png │ ├── blocks.css │ ├── reference │ │ ├── control-your-resources.scrbl │ │ ├── evaluation.scrbl │ │ ├── data-flow.scrbl │ │ └── concurrency.scrbl │ ├── tech-report.scrbl │ ├── main.scrbl │ ├── base.rkt │ ├── reference.scrbl │ ├── tech-report │ │ └── concurrency.scrbl │ ├── drawings.rkt │ └── guide.scrbl └── info.rkt ├── .gitignore ├── neuron-lib ├── info.rkt ├── main.rkt ├── syntax.rkt ├── reprovide.rkt ├── exchanger.rkt ├── evaluation.rkt ├── event.rkt ├── socket.rkt ├── network │ └── tcp.rkt ├── process │ ├── exchanger.rkt │ ├── messaging.rkt │ └── control.rkt ├── codec.rkt └── process.rkt ├── neuron └── info.rkt ├── README.md ├── .travis.yml └── LICENSE /neuron-doc/scribblings/full-width.css: -------------------------------------------------------------------------------- 1 | .FullWidth { 2 | width: 100%; 3 | } 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#* 3 | .\#* 4 | .DS_Store 5 | compiled/ 6 | doc/ 7 | coverage/ 8 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/leading-spaces.css: -------------------------------------------------------------------------------- 1 | .LeadingSpaces { 2 | width: 100%; 3 | margin: 0; 4 | padding: 0.25em; 5 | } 6 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/neuron-library-stack.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dedbox/racket-neuron/HEAD/neuron-doc/scribblings/neuron-library-stack.png -------------------------------------------------------------------------------- /neuron-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection "neuron") 4 | 5 | (define deps '("base")) 6 | 7 | (define build-deps '("rackunit-lib")) 8 | -------------------------------------------------------------------------------- /neuron/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps 6 | '("neuron-lib" 7 | "neuron-doc")) 8 | 9 | (define implies 10 | '("neuron-lib" 11 | "neuron-doc")) 12 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/blocks.css: -------------------------------------------------------------------------------- 1 | table.Blocks { 2 | border-collapse: collapse; 3 | border-style: hidden; 4 | } 5 | 6 | table.Blocks td { 7 | border: 1px solid black; 8 | text-align: center; 9 | } 10 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/reference/control-your-resources.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require "../base.rkt") 4 | 5 | @title[#:style '(grouper toc)]{Control Your Resources} 6 | 7 | @local-table-of-contents[] 8 | 9 | @include-section["evaluation.scrbl"] 10 | @include-section["concurrency.scrbl"] 11 | @include-section["data-flow.scrbl"] 12 | -------------------------------------------------------------------------------- /neuron-lib/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require neuron/reprovide) 4 | 5 | (reprovide 6 | neuron/codec 7 | neuron/evaluation 8 | neuron/event 9 | neuron/exchanger 10 | neuron/network/tcp 11 | neuron/process 12 | neuron/process/control 13 | neuron/process/exchanger 14 | neuron/process/messaging 15 | neuron/socket 16 | neuron/syntax) 17 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/tech-report.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title[ 4 | #:style '(unnumbered) 5 | #:tag "The Neuron Technical Report" 6 | ]{The Neuron Technical Report} 7 | @author{@author+email["Eric Griffis" "dedbox@gmail.com"]} 8 | 9 | @local-table-of-contents[#:style 'immediate-only] 10 | 11 | @include-section["tech-report/concurrency.scrbl"] 12 | -------------------------------------------------------------------------------- /neuron-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection "neuron") 4 | 5 | (define deps 6 | '("base" 7 | "neuron-lib")) 8 | 9 | (define build-deps 10 | '("at-exp-lib" 11 | "pict-lib" 12 | "racket-doc" 13 | "sandbox-lib" 14 | "scribble-lib")) 15 | 16 | (define scribblings 17 | '(("scribblings/main.scrbl" (multi-page) (library) "neuron"))) 18 | -------------------------------------------------------------------------------- /neuron-lib/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide (all-defined-out)) 4 | 5 | (define-syntax-rule (forever body ...) 6 | (let loop () body ... (loop))) 7 | 8 | (define-syntax-rule (while expr body ...) 9 | (let loop () (when expr body ... (loop)))) 10 | 11 | (define-syntax-rule (until expr body ...) 12 | (let loop () (unless expr body ... (loop)))) 13 | 14 | (define-syntax-rule (apply-values proc expr) 15 | (call-with-values (λ () expr) proc)) 16 | -------------------------------------------------------------------------------- /neuron-lib/reprovide.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide (all-defined-out)) 4 | 5 | (define-syntax-rule (reprovide module-path ...) 6 | (begin 7 | (require module-path ...) 8 | (provide (all-from-out module-path) ...))) 9 | 10 | (define-syntax-rule (reprovide-for-label module-path ...) 11 | (begin 12 | (require (for-label module-path ...)) 13 | (provide (for-label (all-from-out module-path ...))))) 14 | 15 | (define-syntax-rule (reprovide/for-label module-path ...) 16 | (begin 17 | (reprovide module-path ...) 18 | (reprovide-for-label module-path ...))) 19 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/main.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{Neuron: Decentralized Software Organisms} 4 | 5 | Neuron is a framework for creating and participating in Internet-scale 6 | software ecosystems. Neuron provides a unified API for IPC and distributed 7 | messaging, along with components for building dynamic data-flow networks. 8 | @; , decentralized run time environments and programs, and mobile software agents. 9 | 10 | @local-table-of-contents[#:style 'immediate-only] 11 | 12 | @include-section["guide.scrbl"] 13 | @include-section["reference.scrbl"] 14 | @include-section["tech-report.scrbl"] 15 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/base.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require neuron/reprovide) 4 | 5 | (reprovide 6 | pict 7 | racket/math 8 | racket/sandbox 9 | scribble/examples 10 | scribble/manual) 11 | 12 | (reprovide-for-label 13 | racket/base 14 | racket/contract 15 | racket/match 16 | racket/tcp 17 | json) 18 | 19 | (reprovide/for-label 20 | neuron) 21 | 22 | (provide (all-defined-out)) 23 | 24 | ;; Scribble Tech 25 | 26 | (define (rtech . args) 27 | (apply tech #:doc '(lib "scribblings/reference/reference.scrbl") args)) 28 | 29 | ;; Sandboxed Evaluation 30 | 31 | (define neuron-evaluator 32 | (parameterize ([sandbox-output 'string] 33 | [sandbox-error-output 'string] 34 | [sandbox-memory-limit 50] 35 | [sandbox-eval-limits '(30 50)] 36 | [sandbox-make-inspector current-inspector]) 37 | (make-evaluator 'racket #:requires '(neuron)))) 38 | 39 | (random-seed 1) 40 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Neuron 2 | 3 | **Decentralized Software Organisms** 4 | [![Racket Package](https://img.shields.io/badge/raco%20pkg-neuron-red.svg)](https://pkgs.racket-lang.org/package/neuron) 5 | [![Documentation](https://img.shields.io/badge/read-docs-blue.svg)](http://docs.racket-lang.org/neuron/) 6 | [![Build Status](https://travis-ci.org/dedbox/racket-neuron.svg?branch=master)](https://travis-ci.org/dedbox/racket-neuron) 7 | [![Coverage Status](https://coveralls.io/repos/github/dedbox/racket-neuron/badge.svg?branch=master)](https://coveralls.io/github/dedbox/racket-neuron?branch=master) 8 | 9 | Neuron is a framework for creating and participating in Internet-scale 10 | software ecosystems. Neuron provides a unified API for IPC and distributed 11 | messaging, along with components for building dynamic data-flow networks. 12 | 13 |

14 | Neuron library stack diagram 17 |

18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | 4 | branches: 5 | only: 6 | - master 7 | 8 | env: 9 | global: 10 | - RACKET_DIR=~/racket 11 | matrix: 12 | - RACKET_VERSION=6.12 13 | - RACKET_VERSION=HEAD 14 | 15 | matrix: 16 | allow_failures: 17 | - env: RACKET_VERSION=HEAD 18 | # fast_finish: true 19 | 20 | before_install: 21 | - git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket 22 | - cat ~/travis-racket/install-racket.sh | bash 23 | - export PATH="${RACKET_DIR}/bin:${PATH}" 24 | 25 | install: 26 | - raco pkg install --auto $TRAVIS_BUILD_DIR/neuron-lib 27 | - raco pkg install --auto $TRAVIS_BUILD_DIR/neuron-doc 28 | - raco pkg install --auto $TRAVIS_BUILD_DIR/neuron 29 | 30 | before_script: 31 | 32 | # Here supply steps such as raco make, raco test, etc. You can run 33 | # `raco pkg install --deps search-auto` to install any required 34 | # packages without it getting stuck on a confirmation prompt. 35 | script: 36 | - raco test -c neuron 37 | 38 | after_success: 39 | - raco setup --check-pkg-deps -p neuron 40 | - raco pkg install --deps search-auto cover cover-coveralls 41 | - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage ./neuron-lib 42 | -------------------------------------------------------------------------------- /neuron-lib/exchanger.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | racket/contract/base) 5 | 6 | (provide 7 | (contract-out 8 | [exchanger? predicate/c] 9 | [make-exchanger (->* () (channel? channel?) exchanger?)] 10 | [exchanger-ctrl-ch (-> exchanger? channel?)] 11 | [exchanger-data-ch (-> exchanger? channel?)] 12 | [offer (-> exchanger? #:to exchanger? void?)] 13 | [accept (-> #:from exchanger? exchanger?)] 14 | [put (-> any/c #:into exchanger? void?)] 15 | [get (-> #:from exchanger? any/c)] 16 | [offer-evt (-> exchanger? #:to exchanger? evt?)] 17 | [accept-evt (-> #:from exchanger? evt?)] 18 | [put-evt (-> any/c #:into exchanger? evt?)] 19 | [get-evt (-> #:from exchanger? evt?)])) 20 | 21 | (struct exchanger (ctrl-ch data-ch)) 22 | 23 | (define (make-exchanger [ctrl-ch (make-channel)] [data-ch (make-channel)]) 24 | (exchanger ctrl-ch data-ch)) 25 | 26 | ;; Commands 27 | 28 | (define (offer ex1 #:to ex2) 29 | (sync (offer-evt ex1 #:to ex2))) 30 | 31 | (define (accept #:from ex) 32 | (sync (accept-evt #:from ex))) 33 | 34 | (define (put v #:into ex) 35 | (sync (put-evt v #:into ex))) 36 | 37 | (define (get #:from ex) 38 | (sync (get-evt #:from ex))) 39 | 40 | ;; Events 41 | 42 | (define (offer-evt ex1 #:to ex2) 43 | (handle-evt (channel-put-evt (exchanger-ctrl-ch ex2) ex1) void)) 44 | 45 | (define (accept-evt #:from ex) 46 | (exchanger-ctrl-ch ex)) 47 | 48 | (define (put-evt v #:into ex) 49 | (handle-evt (channel-put-evt (exchanger-data-ch ex) v) void)) 50 | 51 | (define (get-evt #:from ex) 52 | (exchanger-data-ch ex)) 53 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/reference/evaluation.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require "../base.rkt") 4 | 5 | @title{Evaluation} 6 | 7 | @(defmodule neuron/evaluation #:packages ("neuron")) 8 | 9 | The @racket[bind] form offers an alternative to @racket[match-lambda] for 10 | specifying @tech{steppers} with Racket's @secref["match" #:doc '(lib 11 | "scribblings/reference/reference.scrbl")] sub-system. 12 | 13 | @defform[ 14 | (bind ([quoted-pat q-exp ...] ...) maybe-match maybe-else) 15 | #:grammar 16 | [(maybe-match (code:line) 17 | (code:line #:match ([pat p-exp ...] ...))) 18 | (maybe-else (code:line) 19 | (code:line #:else default))] 20 | ]{ 21 | 22 | Creates a @racket[match-lambda] with @racket[quoted-pat]s implicitly 23 | @racket[quasiquote]d. If @racket[pat] clauses are given, they are appended 24 | to the @racket[quoted-pat] clauses unmodified. If @racket[default] is given, 25 | a final catch-all clause that returns @racket[default] is added. 26 | 27 | @examples[ 28 | #:eval neuron-evaluator 29 | #:label "Example:" 30 | (define vars (make-hash)) 31 | (define calc 32 | (bind 33 | ([(,a + ,b) (+ (calc a) (calc b))] 34 | [(,a ^ ,b) (expt (calc a) (calc b))] 35 | [(,a = ,b) 36 | (hash-set! vars a (calc b)) 37 | (hash-ref vars a)]) 38 | #:match 39 | ([(? number? n) n] 40 | [(? symbol? x) (hash-ref vars x)]) 41 | #:else 'stuck)) 42 | (calc '(a = 2)) 43 | (calc '(b = ((a ^ 3) + (3 ^ a)))) 44 | vars 45 | ] 46 | 47 | } 48 | -------------------------------------------------------------------------------- /neuron-lib/evaluation.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/match) 4 | 5 | (provide bind) 6 | 7 | (define-syntax bind 8 | (syntax-rules () 9 | [(_ ([q q-exp ...] ...) 10 | #:match ([p p-exp ...] ...) 11 | #:else default) 12 | (match-lambda 13 | [`q q-exp ...] ... 14 | [p p-exp ...] ... 15 | [_ default])] 16 | 17 | [(_ ([q q-exp ...] ...) 18 | #:match ([p p-exp ...] ...)) 19 | (match-lambda 20 | [`q q-exp ...] ... 21 | [p p-exp ...] ...)] 22 | 23 | [(_ ([q q-exp ...] ...) 24 | #:else default) 25 | (match-lambda 26 | [`q q-exp ...] ... 27 | [_ default])] 28 | 29 | [(_ ([q q-exp ...] ...)) 30 | (match-lambda 31 | [`q q-exp ...] ...)])) 32 | 33 | (module+ test 34 | (require rackunit) 35 | 36 | (test-case 37 | "bind" 38 | (define f (bind ([a 1]) #:match (['b 2]) #:else 0)) 39 | (check = 1 (f 'a)) 40 | (check = 2 (f 'b)) 41 | (check = 0 (f 'z))) 42 | 43 | (test-case 44 | "bind:calc" 45 | (define vars (make-hasheq)) 46 | (define calc 47 | (bind 48 | ([(,a + ,b) (+ (calc a) (calc b))] 49 | [(,a ^ ,b) (expt (calc a) (calc b))] 50 | [(,a = ,b) 51 | (hash-set! vars a (calc b)) 52 | (hash-ref vars a)]) 53 | #:match 54 | ([(? number? n) n] 55 | [(? symbol? x) (hash-ref vars x #f)]) 56 | #:else 'stuck)) 57 | (check = (calc '(a = 2)) 2) 58 | (check = (calc '(b = ((a ^ 3) + (3 ^ a)))) 17) 59 | (check = (hash-ref vars 'a) 2) 60 | (check = (hash-ref vars 'b) 17))) 61 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/reference.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "base.rkt") 4 | 5 | @title[ 6 | #:style '(unnumbered toc) 7 | #:tag "The Neuron Reference" 8 | ]{The Neuron Reference} 9 | @author{@author+email["Eric Griffis" "dedbox@gmail.com"]} 10 | 11 | @defmodule[neuron #:packages ("neuron-lib")] 12 | 13 | This library is structured as a layered framework. Its architecture encourages 14 | reuse and simplifies customization without sacrificing flexibility. Each layer 15 | of the framework provides functionality for subsequent layers to build upon. 16 | 17 | The foundational layer defines the concurrency and serialization models used 18 | throughout the library. It contains a collection of protocol-agnostic 19 | constructs for high-level network programming and implementations for some 20 | basic protocols and formats. It also includes a privileged command mechanism 21 | suitable for information flow control. This foundation empowers developers to 22 | grow highly dynamic networks from the REPL by composing relatively simple 23 | components into more complex ones. 24 | 25 | @local-table-of-contents[#:style 'immediate-only] 26 | 27 | @include-section["reference/control-your-resources.scrbl"] 28 | 29 | @section[#:style '(grouper)]{Operate Your Network} 30 | @subsection{Distributed Evaluation} 31 | @subsubsection{Portability} 32 | @subsubsection{Process Mobility} 33 | @subsection{Capabilities} 34 | 35 | @section[#:style '(grouper)]{Cooperate with Others} 36 | @subsection{Decentralized Run Time Environments} 37 | @subsection{Decentralized Programs} 38 | 39 | @section[#:style '(grouper)]{Grow a Community} 40 | @subsection{Identity} 41 | @subsection{Association} 42 | @subsection{Accountability} 43 | @subsection{Policy} 44 | @subsubsection{Execution} 45 | @subsubsection{Enforcement} 46 | -------------------------------------------------------------------------------- /neuron-lib/event.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | (prefix-in list: racket/list)) 5 | 6 | (provide 7 | (contract-out 8 | [evt-set 9 | (->* () 10 | (#:then (-> any/c ... any)) 11 | #:rest (listof evt?) 12 | evt?)] 13 | [evt-sequence 14 | (->* ((-> evt?)) 15 | (#:then (-> any/c any)) 16 | #:rest (listof (-> evt?)) 17 | evt?)] 18 | [evt-series (->* ((-> any/c evt?)) 19 | (#:init any/c 20 | #:then (-> any/c any)) 21 | #:rest (listof (-> any/c evt?)) 22 | evt?)] 23 | [evt-loop (->* ((-> any/c evt?)) (#:init any/c) evt?)])) 24 | 25 | (define (evt-set #:then [proc list] . evts) 26 | (define results (make-vector (length evts) '?)) 27 | (define handlers 28 | (for/list ([k (vector-length results)] 29 | [e evts]) 30 | (thread (λ () (vector-set! results k (sync e)))))) 31 | (let loop ([es handlers]) 32 | (if (null? es) 33 | (handle-evt always-evt (λ _ (apply proc (vector->list results)))) 34 | (replace-evt 35 | (apply choice-evt es) 36 | (λ (e) 37 | (loop (remq e es))))))) 38 | 39 | (define (evt-sequence #:then [make-result values] make-evt0 . make-evts) 40 | (define-values (lhs rhs) (list:split-at-right make-evts 1)) 41 | (set! make-evts 42 | (append 43 | lhs 44 | (list (λ () (handle-evt ((car rhs)) make-result))))) 45 | (foldl (λ (make-evt evt) (replace-evt evt (λ _ (make-evt)))) 46 | (make-evt0) 47 | make-evts)) 48 | 49 | (define (evt-series #:init [init (void)] 50 | #:then [make-result values] 51 | make-evt0 . make-evts) 52 | (define-values (lhs rhs) (list:split-at-right make-evts 1)) 53 | (set! make-evts 54 | (append 55 | lhs 56 | (list (λ vs (handle-evt (apply (car rhs) vs) make-result))))) 57 | (foldl (λ (make-evt evt) (replace-evt evt (λ (v) (make-evt v)))) 58 | (make-evt0 init) 59 | make-evts)) 60 | 61 | (define (evt-loop #:init [init (void)] next-evt) 62 | (replace-evt (next-evt init) (λ (v) (evt-loop #:init v next-evt)))) 63 | -------------------------------------------------------------------------------- /neuron-lib/socket.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | racket/port) 5 | 6 | (provide 7 | (contract-out 8 | [struct socket 9 | ([in-port input-port?] 10 | [out-port output-port?])] 11 | [close-socket (-> socket? void?)] 12 | [socket-closed? (-> socket? boolean?)] 13 | [null-socket (-> socket?)] 14 | [byte-socket (->* () (#:in bytes? #:out boolean?) socket?)] 15 | [string-socket (->* () (#:in string? #:out boolean?) socket?)] 16 | [file-socket 17 | (->* () 18 | (#:in (or/c path-string? #f) 19 | #:in-mode (or/c 'binary 'text) 20 | #:out (or/c path-string? #f) 21 | #:out-mode (or/c 'binary 'text) 22 | #:exists (or/c 'error 'append 'update 'can-update 23 | 'replace 'truncate 24 | 'must-truncate 'truncate/replace)) 25 | socket?)])) 26 | 27 | (struct socket 28 | (in-port out-port) 29 | #:property prop:input-port (struct-field-index in-port) 30 | #:property prop:output-port (struct-field-index out-port) 31 | #:property prop:evt 32 | (λ (sock) 33 | (choice-evt 34 | (handle-evt (port-closed-evt (socket-in-port sock)) 35 | (λ _ (close-output-port sock))) 36 | (handle-evt (port-closed-evt (socket-out-port sock)) 37 | (λ _ (close-input-port sock)))))) 38 | 39 | (define (close-socket sock) 40 | (close-input-port sock) 41 | (close-output-port sock) 42 | (sync sock)) 43 | 44 | (define (socket-closed? sock) 45 | (and 46 | (port-closed? (socket-in-port sock)) 47 | (port-closed? (socket-out-port sock)))) 48 | 49 | (define (null-socket) 50 | (socket 51 | (open-input-string "") 52 | (open-output-nowhere))) 53 | 54 | (define (byte-socket #:in [bstr #""] 55 | #:out [out? #f]) 56 | (socket 57 | (open-input-bytes bstr) 58 | (if out? 59 | (open-output-bytes) 60 | (open-output-nowhere)))) 61 | 62 | (define (string-socket #:in [str ""] 63 | #:out [out? #f]) 64 | (socket 65 | (open-input-string str) 66 | (if out? 67 | (open-output-string) 68 | (open-output-nowhere)))) 69 | 70 | (define (file-socket #:in [in-path #f] 71 | #:in-mode [in-mode-flag 'binary] 72 | #:out [out-path #f] 73 | #:out-mode [out-mode-flag 'binary] 74 | #:exists [exists-flag 'error]) 75 | (socket 76 | (if in-path 77 | (open-input-file in-path #:mode in-mode-flag) 78 | (open-input-bytes #"")) 79 | (if out-path 80 | (open-output-file out-path #:mode out-mode-flag #:exists exists-flag) 81 | (open-output-nowhere)))) 82 | 83 | (module+ test 84 | (require rackunit) 85 | 86 | (test-case 87 | "A socket is an input port and an output port." 88 | (define sock (null-socket)) 89 | (check-pred input-port? sock) 90 | (check-pred output-port? sock)) 91 | 92 | (test-case 93 | "A socket syncs when its input port closes." 94 | (define sock (string-socket)) 95 | (close-input-port (socket-in-port sock)) 96 | (sync sock) 97 | (check-pred port-closed? (socket-in-port sock))) 98 | 99 | (test-case 100 | "A socket syncs when its output port closes." 101 | (define sock (string-socket #:out #t)) 102 | (close-output-port (socket-out-port sock)) 103 | (sync sock) 104 | (check-pred port-closed? (socket-out-port sock))) 105 | 106 | (test-case 107 | "A socket closes its output port when its input port closes." 108 | (define sock (string-socket #:out #t)) 109 | (close-input-port (socket-in-port sock)) 110 | (sync sock) 111 | (check-pred port-closed? (socket-out-port sock))) 112 | 113 | (test-case 114 | "A socket closes its input port when its output port closes." 115 | (define sock (string-socket #:out #t)) 116 | (close-output-port (socket-out-port sock)) 117 | (sync sock) 118 | (check-pred port-closed? (socket-in-port sock)))) 119 | -------------------------------------------------------------------------------- /neuron-lib/network/tcp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | neuron/codec 5 | neuron/evaluation 6 | neuron/event 7 | neuron/process 8 | neuron/process/control 9 | neuron/process/messaging 10 | neuron/socket 11 | neuron/syntax 12 | racket/contract/base 13 | racket/function 14 | racket/tcp) 15 | 16 | (provide 17 | (contract-out 18 | [tcp-socket? predicate/c] 19 | [tcp-socket (-> input-port? output-port? tcp-socket?)] 20 | [tcp-socket-address 21 | (-> tcp-socket? 22 | (list/c string? port-number? 23 | string? port-number?))] 24 | [tcp-client 25 | (->* (string? port-number?) 26 | ((or/c string? #f) 27 | (or/c port-number? #f)) 28 | socket?)] 29 | [tcp-server 30 | (->* (listen-port-number?) 31 | (exact-nonnegative-integer? any/c (or/c string? #f)) 32 | process?)] 33 | [tcp-service 34 | (->* (codec/c process?) 35 | (#:on-accept (-> any/c process? any) 36 | #:on-drop (-> any/c process? any)) 37 | process?)])) 38 | 39 | (struct tcp-socket socket (address) 40 | #:omit-define-syntaxes 41 | #:constructor-name make-tcp-socket) 42 | 43 | (define (tcp-socket in-port out-port) 44 | (make-tcp-socket in-port out-port 45 | (apply-values list (tcp-addresses in-port #t)))) 46 | 47 | (define (tcp-client hostname port-no [local-hostname #f] [local-port-no #f]) 48 | (apply-values tcp-socket (tcp-connect hostname port-no 49 | local-hostname local-port-no))) 50 | 51 | (define (tcp-server port-no [max-allow-wait 4] [reuse? #f] [hostname #f]) 52 | (define listener (tcp-listen port-no max-allow-wait reuse? hostname)) 53 | (define addr (apply-values list (tcp-addresses listener #t))) 54 | (start (source (λ () (apply-values tcp-socket (tcp-accept listener)))) 55 | #:on-dead (λ () (tcp-close listener)) 56 | #:command (bind ([address addr]) 57 | #:else unhandled))) 58 | 59 | (define (tcp-service make-codec srv 60 | #:on-accept [on-accept void] 61 | #:on-drop [on-drop void]) 62 | (define svc 63 | (service (λ (π) (tcp-socket-address (π 'socket))) #:on-drop on-drop)) 64 | (start 65 | (process 66 | (λ () 67 | (define peer-connect-evt 68 | (handle-evt 69 | (recv-evt srv) 70 | (λ (sock) 71 | (define π (make-codec sock)) 72 | (define addr (svc 'add π)) 73 | (on-accept addr π)))) 74 | (define peer-take-evt 75 | (replace-evt (take-evt) (curry give-evt svc))) 76 | (define peer-emit-evt 77 | (replace-evt (recv-evt svc) emit-evt)) 78 | (sync 79 | (evt-loop (λ _ peer-connect-evt)) 80 | (evt-loop (λ _ peer-take-evt)) 81 | (evt-loop (λ _ peer-emit-evt))))) 82 | #:on-stop (λ () (stop svc)) 83 | #:on-dead (λ () (kill svc)) 84 | #:command (bind ([peers (svc 'peers)] 85 | [(get ,addr) ((svc 'get) addr)] 86 | [(drop ,addr) ((svc 'drop) addr)]) 87 | #:else unhandled))) 88 | 89 | (module+ test 90 | (require rackunit 91 | (prefix-in list: racket/list)) 92 | 93 | (test-case 94 | "A tcp-socket is a socket with a TCP address." 95 | (define listener (tcp-listen 0 4 #t #f)) 96 | (define port-no (cadr (apply-values list (tcp-addresses listener #t)))) 97 | (define sock (apply-values tcp-socket (tcp-connect "localhost" port-no))) 98 | (check-pred socket? sock) 99 | (check-pred (list/c string? port-number? 100 | string? port-number?) 101 | (tcp-socket-address sock))) 102 | 103 | (test-case 104 | "A tcp-client returns a TCP socket connected to hostname:port-no." 105 | (define listener (tcp-listen 0 4 #t #f)) 106 | (define port-no (cadr (apply-values list (tcp-addresses listener #t)))) 107 | (define sock (tcp-client "localhost" port-no)) 108 | (check-pred tcp-socket? sock) 109 | (define peer (apply-values tcp-socket (tcp-accept listener))) 110 | (define sock-addr (tcp-socket-address sock)) 111 | (define peer-addr (tcp-socket-address peer)) 112 | (check equal? (list:take sock-addr 2) (list:drop peer-addr 2)) 113 | (check equal? (list:drop sock-addr 2) (list:take peer-addr 2))) 114 | 115 | (test-case 116 | "A tcp-server emits TCP sockets." 117 | (define srv (tcp-server 0 4 #t #f)) 118 | (define port-no (cadr (srv 'address))) 119 | (define sock (tcp-client "localhost" port-no)) 120 | (check-pred tcp-socket? (recv srv))) 121 | 122 | (test-case 123 | "A tcp-server listens for TCP connections on hostname:port-no." 124 | (define srv (tcp-server 0 4 #t #f)) 125 | (define port-no (cadr (srv 'address))) 126 | (define sock (tcp-client "localhost" port-no)) 127 | (define peer (recv srv)) 128 | (define sock-addr (tcp-socket-address sock)) 129 | (define peer-addr (tcp-socket-address peer)) 130 | (check equal? (list:take sock-addr 2) (list:drop peer-addr 2)) 131 | (check equal? (list:drop sock-addr 2) (list:take peer-addr 2))) 132 | 133 | (test-case 134 | "tcp-server command 'address returns a TCP address." 135 | (define srv (tcp-server 0 4 #t #f)) 136 | (check-pred (list/c string? port-number? 137 | string? listen-port-number?) 138 | (srv 'address)))) 139 | -------------------------------------------------------------------------------- /neuron-lib/process/exchanger.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | neuron/event 5 | neuron/exchanger 6 | racket/contract/base) 7 | 8 | (provide 9 | (contract-out 10 | [giver (-> exchanger? exchanger? any/c void?)] 11 | [taker (-> exchanger? any/c)] 12 | [receiver (-> exchanger? exchanger? any/c)] 13 | [emitter (-> exchanger? any/c void?)] 14 | [forwarder (-> exchanger? exchanger? void?)] 15 | [filterer (-> exchanger? exchanger? #:with (-> any/c any/c) void?)] 16 | [coupler 17 | (->* (exchanger? exchanger?) 18 | (exchanger?) 19 | void?)] 20 | [giver-evt (-> exchanger? exchanger? any/c evt?)] 21 | [taker-evt (-> exchanger? evt?)] 22 | [emitter-evt (-> exchanger? any/c evt?)] 23 | [receiver-evt (-> exchanger? exchanger? evt?)] 24 | [forwarder-evt (-> exchanger? exchanger? evt?)] 25 | [filterer-evt (-> exchanger? exchanger? #:with (-> any/c any/c) evt?)] 26 | [coupler-evt 27 | (->* (exchanger? exchanger?) 28 | (exchanger?) 29 | evt?)])) 30 | 31 | ;; Commands 32 | 33 | (define (giver tx rx v) 34 | (sync (giver-evt tx rx v))) 35 | 36 | (define (taker rx) 37 | (sync (taker-evt rx))) 38 | 39 | (define (receiver rx tx) 40 | (sync (receiver-evt rx tx))) 41 | 42 | (define (emitter tx v) 43 | (sync (emitter-evt tx v))) 44 | 45 | (define (forwarder ex1 ex2) 46 | (sync (forwarder-evt ex1 ex2))) 47 | 48 | (define (filterer ex1 ex2 #:with proc) 49 | (sync (filterer-evt ex1 ex2 #:with proc))) 50 | 51 | (define (coupler rx tx [ex (make-exchanger)]) 52 | (sync (coupler-evt rx tx ex))) 53 | 54 | ;; Events 55 | 56 | (define (giver-evt tx rx v) 57 | (evt-sequence 58 | (λ () (offer-evt tx #:to rx)) 59 | (λ () (put-evt v #:into tx)) 60 | #:then void)) 61 | 62 | (define (taker-evt rx) 63 | (evt-series 64 | (λ _ (accept-evt #:from rx)) 65 | (λ (tx) (get-evt #:from tx)))) 66 | 67 | (define (receiver-evt rx tx) 68 | (evt-sequence 69 | (λ () (offer-evt rx #:to tx)) 70 | (λ () (get-evt #:from rx)))) 71 | 72 | (define (emitter-evt tx v) 73 | (evt-series 74 | (λ _ (accept-evt #:from tx)) 75 | (λ (rx) (put-evt v #:into rx)) 76 | #:then void)) 77 | 78 | (define (forwarder-evt ex1 ex2) 79 | (evt-series 80 | (λ _ (accept-evt #:from ex1)) 81 | (λ (ex) (offer-evt ex #:to ex2)) 82 | #:then void)) 83 | 84 | (define (filterer-evt ex1 ex2 #:with proc) 85 | (evt-series 86 | (λ _ (accept-evt #:from ex1)) 87 | (λ (ex) 88 | (offer-evt 89 | (make-exchanger 90 | (exchanger-ctrl-ch ex) 91 | (impersonate-channel 92 | (exchanger-data-ch ex) 93 | (λ (c) (values c proc)) 94 | (λ (c v) (proc v)))) 95 | #:to ex2)))) 96 | 97 | (define (coupler-evt rx tx [ex (make-exchanger)]) 98 | (evt-sequence 99 | (λ () (offer-evt ex #:to rx)) 100 | (λ () (offer-evt ex #:to tx)) 101 | #:then void)) 102 | 103 | ;;; Unit Tests 104 | 105 | (module+ test 106 | (require rackunit 107 | racket/function) 108 | 109 | (test-case 110 | "giver -> taker" 111 | (define tx (make-exchanger)) 112 | (define rx (make-exchanger)) 113 | (thread (λ () (for ([j 10]) (check = (taker rx) j)))) 114 | (for ([i 10]) (check-pred void? (giver tx rx i)))) 115 | 116 | (test-case 117 | "taker <- giver" 118 | (define tx (make-exchanger)) 119 | (define rx (make-exchanger)) 120 | (thread (λ () (for ([i 10]) (check-pred void? (giver tx rx i))))) 121 | (for ([j 10]) (check = (taker rx) j))) 122 | 123 | (test-case 124 | "emitter -> receiver" 125 | (define tx (make-exchanger)) 126 | (define rx (make-exchanger)) 127 | (thread (λ () (for ([i 10]) (check-pred void? (emitter tx i))))) 128 | (for ([j 10]) (check = (receiver rx tx) j))) 129 | 130 | (test-case 131 | "receiver <- emitter" 132 | (define tx (make-exchanger)) 133 | (define rx (make-exchanger)) 134 | (thread (λ () (for ([j 10]) (check = (receiver rx tx) j)))) 135 | (for ([i 10]) (check-pred void? (emitter tx i)))) 136 | 137 | (test-case 138 | "giver -> forwarder -> taker" 139 | (define tx1 (make-exchanger)) 140 | (define rx1 (make-exchanger)) 141 | (define tx2 (make-exchanger)) 142 | (define rx2 (make-exchanger)) 143 | (thread (λ () (for ([_ 10]) (forwarder rx1 rx2)))) 144 | (thread (λ () (for ([j 10]) (check = (taker rx2) j)))) 145 | (for ([i 10]) (check-pred void? (giver tx1 rx1 i)))) 146 | 147 | (test-case 148 | "taker <- forwarder <- giver" 149 | (define tx1 (make-exchanger)) 150 | (define rx1 (make-exchanger)) 151 | (define tx2 (make-exchanger)) 152 | (define rx2 (make-exchanger)) 153 | (thread (λ () (for ([_ 10]) (forwarder rx1 rx2)))) 154 | (thread (λ () (for ([i 10]) (check-pred void? (giver tx1 rx1 i))))) 155 | (for ([j 10]) (check = (taker rx2) j))) 156 | 157 | (test-case 158 | "emitter -> forwarder -> receiver" 159 | (define tx1 (make-exchanger)) 160 | (define rx1 (make-exchanger)) 161 | (define tx2 (make-exchanger)) 162 | (define rx2 (make-exchanger)) 163 | (thread (λ () (for ([k 10]) (forwarder tx2 tx1)))) 164 | (thread (λ () (for ([j 10]) (check = (receiver rx2 tx2) j)))) 165 | (for ([i 10]) (check-pred void? (emitter tx1 i)))) 166 | 167 | (test-case 168 | "receiver <- forwarder <- emitter" 169 | (define tx1 (make-exchanger)) 170 | (define rx1 (make-exchanger)) 171 | (define tx2 (make-exchanger)) 172 | (define rx2 (make-exchanger)) 173 | (thread (λ () (for ([_ 10]) (forwarder tx2 tx1)))) 174 | (thread (λ () (for ([i 10]) (check-pred void? (emitter tx1 i))))) 175 | (for ([j 10]) (check = (receiver rx2 tx2) j))) 176 | 177 | (test-case 178 | "giver -> filterer -> taker" 179 | (define tx1 (make-exchanger)) 180 | (define rx1 (make-exchanger)) 181 | (define tx2 (make-exchanger)) 182 | (define rx2 (make-exchanger)) 183 | (thread (λ () (for ([_ 10]) (filterer rx1 rx2 #:with add1)))) 184 | (thread (λ () (for ([j 10]) (check = (taker rx2) (+ j 1))))) 185 | (for ([i 10]) (check-pred void? (giver tx1 rx1 i)))) 186 | 187 | (test-case 188 | "taker <- filterer <- giver" 189 | (define tx1 (make-exchanger)) 190 | (define rx1 (make-exchanger)) 191 | (define tx2 (make-exchanger)) 192 | (define rx2 (make-exchanger)) 193 | (thread (λ () (for ([_ 10]) (filterer rx1 rx2 #:with sub1)))) 194 | (thread (λ () (for ([i 10]) (check-pred void? (giver tx1 rx1 i))))) 195 | (for ([j 10]) (check = (taker rx2) (- j 1)))) 196 | 197 | (test-case 198 | "emitter -> filterer -> receiver" 199 | (define tx1 (make-exchanger)) 200 | (define rx1 (make-exchanger)) 201 | (define tx2 (make-exchanger)) 202 | (define rx2 (make-exchanger)) 203 | (thread (λ () (for ([k 10]) (filterer tx2 tx1 #:with (curry * 2))))) 204 | (thread (λ () (for ([j 10]) (check = (receiver rx2 tx2) (+ j j))))) 205 | (for ([i 10]) (check-pred void? (emitter tx1 i)))) 206 | 207 | (test-case 208 | "receiver <- filterer <- emitter" 209 | (define tx1 (make-exchanger)) 210 | (define rx1 (make-exchanger)) 211 | (define tx2 (make-exchanger)) 212 | (define rx2 (make-exchanger)) 213 | (thread (λ () (for ([_ 10]) (filterer tx2 tx1 #:with (curry * 3))))) 214 | (thread (λ () (for ([i 10]) (check-pred void? (emitter tx1 i))))) 215 | (for ([j 10]) (check = (receiver rx2 tx2) (+ j j j)))) 216 | 217 | (test-case 218 | "emitter -> coupler -> taker" 219 | (define rx (make-exchanger)) 220 | (define tx (make-exchanger)) 221 | (thread (λ () (for ([_ 10]) (coupler rx tx)))) 222 | (thread (λ () (for ([j 10]) (check = (taker tx) j)))) 223 | (for ([i 10]) (check-pred void? (emitter rx i)))) 224 | 225 | (test-case 226 | "taker <- coupler <- emitter" 227 | (define rx (make-exchanger)) 228 | (define tx (make-exchanger)) 229 | (thread (λ () (for ([_ 10]) (coupler rx tx)))) 230 | (thread (λ () (for ([i 10]) (check-pred void? (emitter rx i))))) 231 | (for ([j 10]) (check = (taker tx) j)))) 232 | -------------------------------------------------------------------------------- /neuron-lib/codec.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | neuron/evaluation 5 | neuron/process 6 | neuron/process/control 7 | neuron/process/messaging 8 | neuron/socket 9 | neuron/syntax 10 | json 11 | racket/contract/base 12 | racket/splicing) 13 | 14 | (require 15 | (for-syntax 16 | racket/base 17 | racket/syntax)) 18 | 19 | (provide 20 | define-codec 21 | (contract-out 22 | [parser/c contract?] 23 | [printer/c contract?] 24 | [codec/c contract?] 25 | [flushed (-> printer/c printer/c)] 26 | [decoder (-> parser/c (-> socket? process?))] 27 | [encoder (-> printer/c (-> socket? process?))] 28 | [codec (-> parser/c printer/c (-> socket? process?))] 29 | [make-codec-type 30 | (-> symbol? parser/c printer/c 31 | (values (-> input-port? process?) 32 | (-> output-port? process?) 33 | (-> input-port? output-port? process?)))] 34 | [line-parser parser/c] 35 | [line-printer printer/c] 36 | [line-decoder codec/c] 37 | [line-encoder codec/c] 38 | [line-codec codec/c] 39 | [sexp-parser parser/c] 40 | [sexp-printer printer/c] 41 | [sexp-decoder codec/c] 42 | [sexp-encoder codec/c] 43 | [sexp-codec codec/c] 44 | [json-parser parser/c] 45 | [json-printer printer/c] 46 | [json-decoder codec/c] 47 | [json-encoder codec/c] 48 | [json-codec codec/c])) 49 | 50 | (define parser/c (-> socket? any/c)) 51 | (define printer/c (-> any/c socket? any)) 52 | (define codec/c (-> socket? process?)) 53 | 54 | (define (flushed prn) 55 | (λ (v sock) 56 | (prn v sock) 57 | (flush-output sock))) 58 | 59 | (define (decoder prs) 60 | (λ (sock) 61 | (start 62 | (managed (process 63 | (λ () 64 | (sync 65 | (thread (λ () 66 | (with-handlers ([exn:fail? void]) 67 | (forever (emit (prs sock)))))) 68 | (handle-evt sock (λ _ (emit eof))))))) 69 | #:on-stop (λ () (close-socket sock)) 70 | #:command (bind ([parser prs] 71 | [socket sock]) 72 | #:else unhandled)))) 73 | 74 | (define (encoder prn) 75 | (λ (sock) 76 | (start 77 | (managed (process 78 | (λ () 79 | (sync 80 | (thread (λ () 81 | (with-handlers ([exn:fail? void]) 82 | (forever (prn (take) sock))))) 83 | (handle-evt sock die))))) 84 | #:on-stop (λ () (close-socket sock)) 85 | #:command (bind ([printer prn] 86 | [socket sock]) 87 | #:else unhandled)))) 88 | 89 | (define (codec prs prn) 90 | (define make-decoder (decoder prs)) 91 | (define make-encoder (encoder prn)) 92 | (λ (sock) 93 | (define dec (make-decoder sock)) 94 | (define enc (make-encoder sock)) 95 | (start 96 | (stream enc dec) 97 | #:on-stop (λ () (stop enc) (stop dec)) 98 | #:command (bind ([decoder dec] 99 | [encoder enc] 100 | [socket sock]) 101 | #:else unhandled)))) 102 | 103 | (define (make-codec-type name prs prn) 104 | (values 105 | (decoder prs) 106 | (encoder prn) 107 | (codec prs prn))) 108 | 109 | (define-syntax (define-codec stx) 110 | (syntax-case stx () 111 | [(_ name prs prn) 112 | (with-syntax ([name-parser (format-id stx "~a-parser" #'name)] 113 | [name-printer (format-id stx "~a-printer" #'name)] 114 | [name-decoder (format-id stx "~a-decoder" #'name)] 115 | [name-encoder (format-id stx "~a-encoder" #'name)] 116 | [name-codec (format-id stx "~a-codec" #'name)]) 117 | #'(splicing-letrec-values 118 | ([(prs*) prs] 119 | [(prn*) prn] 120 | [(make-dec make-enc make-cdc) (make-codec-type 'name prs* prn*)]) 121 | (define name-parser prs*) 122 | (define name-printer prn*) 123 | (define name-decoder make-dec) 124 | (define name-encoder make-enc) 125 | (define name-codec make-cdc)))])) 126 | 127 | (define-codec line read-line (flushed displayln)) 128 | (define-codec sexp read (flushed writeln)) 129 | (define-codec json 130 | read-json 131 | (flushed (λ (v out) (write-json v out) (newline out)))) 132 | 133 | (module+ test 134 | (require rackunit) 135 | 136 | (test-case 137 | "A decoder applies prs to sock and emits the result." 138 | (check = (recv ((decoder read) (string-socket #:in "123"))) 123)) 139 | 140 | (test-case 141 | "A decoder stops when prs returns eof." 142 | (define dec ((decoder read) (string-socket #:in "123"))) 143 | (check = (recv dec) 123) 144 | (check-pred eof-object? (recv dec)) 145 | (sync dec) 146 | (check-pred dead? dec)) 147 | 148 | (test-case 149 | "A decoder closes sock when it stops." 150 | (define dec ((decoder read) (null-socket))) 151 | (stop dec) 152 | (check-pred socket-closed? (dec 'socket))) 153 | 154 | (test-case 155 | "A decoder dies when sock closes." 156 | (define dec ((decoder read) (null-socket))) 157 | (check-pred eof-object? (recv dec)) 158 | (sync dec) 159 | (check-pred socket-closed? (dec 'socket)) 160 | (check-pred dead? dec)) 161 | 162 | (test-case 163 | "decoder command 'parser returns a parser." 164 | (check eq? (((decoder read) (null-socket)) 'parser) read)) 165 | 166 | (test-case 167 | "decoder command 'socket returns a socket." 168 | (define sock (null-socket)) 169 | (check eq? (((decoder read) sock) 'socket) sock)) 170 | 171 | (test-case 172 | "An encoder takes a value and prints it to sock." 173 | (define done (make-semaphore 0)) 174 | (define enc ((encoder (λ (v sock) (write v sock) (semaphore-post done))) 175 | (string-socket #:out #t))) 176 | (give enc 123) 177 | (semaphore-wait done) 178 | (check equal? (get-output-string (enc 'socket)) "123")) 179 | 180 | (test-case 181 | "An encoder stops when given eof." 182 | (define enc ((encoder write) (null-socket))) 183 | (give enc eof) 184 | (sync enc) 185 | (check-pred dead? enc)) 186 | 187 | (test-case 188 | "An encoder closes sock when it stops." 189 | (define enc ((encoder write) (null-socket))) 190 | (stop enc) 191 | (check-pred socket-closed? (enc 'socket))) 192 | 193 | (test-case 194 | "An encoder dies when sock closes." 195 | (define enc ((encoder write) (null-socket))) 196 | (close-socket (enc 'socket)) 197 | (sync enc) 198 | (check-pred dead? enc)) 199 | 200 | (test-case 201 | "encoder command 'printer returns prn." 202 | (check eq? (((encoder write) (null-socket)) 'printer) write)) 203 | 204 | (test-case 205 | "encoder command 'socket returns sock." 206 | (define sock (null-socket)) 207 | (check eq? (((encoder write) sock) 'socket) sock)) 208 | 209 | (test-case 210 | "A codec is a stream." 211 | (define cdc ((codec read write) (null-socket))) 212 | (check-pred process? cdc) 213 | (check-pred process? (cdc 'sink)) 214 | (check-pred process? (cdc 'source))) 215 | 216 | (test-case 217 | "A codec's source is a decoder on prs and sock." 218 | (define sock (null-socket)) 219 | (define cdc ((codec read write) sock)) 220 | (check-pred process? (cdc 'source)) 221 | (check eq? ((cdc 'source) 'parser) read) 222 | (check eq? ((cdc 'source) 'socket) sock)) 223 | 224 | (test-case 225 | "A codec's sink is an encoder on prn and sock." 226 | (define sock (null-socket)) 227 | (define cdc ((codec read write) sock)) 228 | (check-pred process? (cdc 'sink)) 229 | (check eq? ((cdc 'sink) 'printer) write) 230 | (check eq? ((cdc 'sink) 'socket) sock)) 231 | 232 | (test-case 233 | "codec command 'decoder returns a decoder." 234 | (define sock (null-socket)) 235 | (define dec (((codec read write) sock) 'decoder)) 236 | (check eq? (dec 'parser) read) 237 | (check eq? (dec 'socket) sock)) 238 | 239 | (test-case 240 | "codec command 'encoder returns an encoder." 241 | (define sock (null-socket)) 242 | (define dec (((codec read write) sock) 'encoder)) 243 | (check eq? (dec 'printer) write) 244 | (check eq? (dec 'socket) sock))) 245 | -------------------------------------------------------------------------------- /neuron-lib/process/messaging.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | neuron/event 5 | neuron/exchanger 6 | neuron/process 7 | neuron/process/exchanger 8 | racket/contract/base) 9 | 10 | (provide 11 | (contract-out 12 | [give (->* (process?) (any/c) boolean?)] 13 | [take (-> any/c)] 14 | [recv (-> process? any/c)] 15 | [emit (->* () (any/c) void?)] 16 | [call (-> process? any/c any/c)] 17 | [forward-to (-> process? void?)] 18 | [forward-from (-> process? void?)] 19 | [filter-to (-> process? #:with (-> any/c any/c) void?)] 20 | [filter-from (-> process? #:with (-> any/c any/c) void?)] 21 | [couple 22 | (->* (process? process?) 23 | (exchanger?) 24 | void?)] 25 | [give-evt (->* (process?) (any/c) evt?)] 26 | [take-evt (-> evt?)] 27 | [emit-evt (->* () (any/c) evt?)] 28 | [recv-evt (-> process? evt?)] 29 | [forward-to-evt (-> process? evt?)] 30 | [forward-from-evt (-> process? evt?)] 31 | [filter-to-evt (-> process? #:with (-> any/c any/c) evt?)] 32 | [filter-from-evt (-> process? #:with (-> any/c any/c) evt?)] 33 | [couple-evt 34 | (->* (process? process?) 35 | (exchanger?) 36 | evt?)])) 37 | 38 | ;; Commands 39 | 40 | (define (give π [v (void)]) 41 | (sync (give-evt π v))) 42 | 43 | (define (take) 44 | (sync (take-evt))) 45 | 46 | (define (recv π) 47 | (sync (recv-evt π))) 48 | 49 | (define (emit [v (void)]) 50 | (sync (emit-evt v))) 51 | 52 | (define (call π [v (void)]) 53 | (give π v) 54 | (recv π)) 55 | 56 | (define (forward-to π) 57 | (sync (forward-to-evt π))) 58 | 59 | (define (forward-from π) 60 | (sync (forward-from-evt π))) 61 | 62 | (define (filter-to π #:with proc) 63 | (sync (filter-to-evt π #:with proc))) 64 | 65 | (define (filter-from π #:with proc) 66 | (sync (filter-from-evt π #:with proc))) 67 | 68 | (define (couple π1 π2 [ex (make-exchanger)]) 69 | (sync (couple-evt π1 π2 ex))) 70 | 71 | ;; Events 72 | 73 | (define (give-evt π [v (void)]) 74 | (define tx (process-tx (current-process))) 75 | (define rx (process-rx π)) 76 | (choice-evt 77 | (handle-evt (giver-evt tx rx v) (λ _ #t)) 78 | (handle-evt π (λ _ #f)))) 79 | 80 | (define (take-evt) 81 | (taker-evt (process-rx (current-process)))) 82 | 83 | (define (recv-evt π) 84 | (define tx (process-tx π)) 85 | (define rx (process-rx (current-process))) 86 | (choice-evt 87 | (receiver-evt rx tx) 88 | (handle-evt π (λ _ eof)))) 89 | 90 | (define (emit-evt [v (void)]) 91 | (define tx (process-tx (current-process))) 92 | (handle-evt (emitter-evt tx v) void)) 93 | 94 | (define (forward-to-evt π) 95 | (forwarder-evt 96 | (process-rx (current-process)) 97 | (process-rx π))) 98 | 99 | (define (forward-from-evt π) 100 | (forwarder-evt 101 | (process-tx (current-process)) 102 | (process-tx π))) 103 | 104 | (define (filter-to-evt π #:with proc) 105 | (filterer-evt 106 | (process-rx (current-process)) 107 | (process-rx π) 108 | #:with proc)) 109 | 110 | (define (filter-from-evt π #:with proc) 111 | (filterer-evt 112 | (process-tx (current-process)) 113 | (process-tx π) 114 | #:with proc)) 115 | 116 | (define (couple-evt π1 π2 [ex (make-exchanger)]) 117 | (coupler-evt 118 | (process-rx π1) 119 | (process-tx π2) 120 | ex)) 121 | 122 | (module+ test 123 | (require rackunit) 124 | 125 | ;; Commands 126 | 127 | (test-case 128 | "give blocks until π accepts v." 129 | (check-false (not (give (process (λ () (take))))))) 130 | 131 | (test-case 132 | "give blocks until π dies." 133 | (check-false (give (process die)))) 134 | 135 | (test-case 136 | "give returns #t if π accepts v." 137 | (check-true (give (process (λ () (take)))))) 138 | 139 | (test-case 140 | "give returns #f if π dies before accepting v." 141 | (check-false (give (process die)))) 142 | 143 | (test-case 144 | "take blocks until a value is provided to π." 145 | (define π (process (λ () (check-false (not (take)))))) 146 | (give π) 147 | (void (sync π))) 148 | 149 | (test-case 150 | "take returns the provided value." 151 | (define π (process (λ () (check = (take) 7)))) 152 | (give π 7) 153 | (void (sync π))) 154 | 155 | (test-case 156 | "recv blocks until a value is accepted from π." 157 | (check-false (not (recv (process (λ () (emit))))))) 158 | 159 | (test-case 160 | "recv blocks until π dies." 161 | (check-false (not (recv (process die))))) 162 | 163 | (test-case 164 | "recv returns the value accepted from π." 165 | (check = (recv (process (λ () (emit 13)))) 13)) 166 | 167 | (test-case 168 | "recv returns eof when π dies." 169 | (check-pred eof-object? (recv (process die)))) 170 | 171 | (test-case 172 | "emit blocks until a process accepts v." 173 | (define π (process (λ () (check-false (not (emit)))))) 174 | (recv π) 175 | (void (sync π))) 176 | 177 | (test-case 178 | "emit returns void." 179 | (define π (process (λ () (check-pred void? (emit))))) 180 | (recv π) 181 | (void (sync π))) 182 | 183 | (test-case 184 | "call gives v to π and then recvs from π." 185 | (define π (process (λ () (emit (add1 (take)))))) 186 | (check = (call π 47) 48)) 187 | 188 | ;; Events 189 | 190 | (test-case 191 | "A give-evt is ready when π accepts v." 192 | (define π (process (λ () (emit) (take)))) 193 | (define evt (give-evt π)) 194 | (check-false (sync/timeout 0 evt)) 195 | (recv π) 196 | (check-false (not (sync evt)))) 197 | 198 | (test-case 199 | "A give-evt syncs to #t if π accepts v." 200 | (check-true (sync (give-evt (process (λ () (take))))))) 201 | 202 | (test-case 203 | "A give-evt syncs to #f if π dies before accepting v." 204 | (define π (process deadlock)) 205 | (define evt (give-evt π)) 206 | (kill π) 207 | (check-false (sync evt))) 208 | 209 | (test-case 210 | "A take-evt is ready when a process provides a value." 211 | (define π (process (λ () (check-false (not (sync (take-evt))))))) 212 | (give π) 213 | (void (sync π))) 214 | 215 | (test-case 216 | "A take-evt syncs to the provided value." 217 | (define π (process (λ () (check eq? (sync (take-evt)) 3)))) 218 | (give π 3) 219 | (void (sync π))) 220 | 221 | (test-case 222 | "A recv-evt is ready when a value is accepted from π." 223 | (define π (process (λ () (take) (emit)))) 224 | (define evt (recv-evt π)) 225 | (check-false (sync/timeout 0 evt)) 226 | (give π) 227 | (check-false (not (sync evt)))) 228 | 229 | (test-case 230 | "A recv-evt syncs to the value accepted from π." 231 | (check = (sync (recv-evt (process (λ () (emit 5))))) 5)) 232 | 233 | (test-case 234 | "A recv-evt syncs to eof if π dies." 235 | (define π (process deadlock)) 236 | (define evt (recv-evt π)) 237 | (kill π) 238 | (check-pred eof-object? (sync evt))) 239 | 240 | (test-case 241 | "An emit-evt is ready when a process accepts v." 242 | (define π (process (λ () (check-false (not (sync (emit-evt))))))) 243 | (recv π) 244 | (void (sync π))) 245 | 246 | (test-case 247 | "An emit-evt syncs to void." 248 | (define π (process (λ () (check-pred void? (sync (emit-evt)))))) 249 | (recv π) 250 | (void (sync π))) 251 | 252 | (test-case 253 | "forward-to-evt" 254 | (define π1 (process (λ () (emit (add1 (take)))))) 255 | (define π2 (process (λ () (sync (forward-to-evt π1))))) 256 | (check-true (give π2 1)) 257 | (check = (recv π1) 2)) 258 | 259 | (test-case 260 | "forward-from-evt" 261 | (define π1 (process (λ () (emit 1)))) 262 | (define π2 (process (λ () (sync (forward-from-evt π1))))) 263 | (check = (recv π2) 1) 264 | (check-pred eof-object? (recv π2))) 265 | 266 | (test-case 267 | "filter-to-evt" 268 | (define π1 (process (λ () (emit (take))))) 269 | (define π2 (process (λ () (sync (filter-to-evt π1 #:with add1))))) 270 | (check-true (give π2 1)) 271 | (check = (recv π1) 2)) 272 | 273 | (test-case 274 | "filter-from-evt" 275 | (define π1 (process (λ () (emit 1)))) 276 | (define π2 (process (λ () (sync (filter-from-evt π1 #:with add1))))) 277 | (check = (recv π2) 2) 278 | (check-pred eof-object? (recv π2))) 279 | 280 | (test-case 281 | "couple-evt" 282 | (define π1 (process (λ () (emit 1) (check = (take) 2)))) 283 | (define π2 (process (λ () (check = (take) 1) (emit 2)))) 284 | (void (sync 285 | (evt-set 286 | (thread (λ () (couple π1 π2))) 287 | (thread (λ () (couple π2 π1)))))))) 288 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/tech-report/concurrency.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require 4 | "../base.rkt" 5 | (prefix-in : "../drawings.rkt")) 6 | 7 | @title{A scale-invariant concurrency model} 8 | 9 | A @tech{process} is a concurrency primitive based on lightweight 10 | @rtech{threads} with extended messaging capabilities. Processes communicate 11 | through synchronous, one-way value exchange. Either the sender or receiver can 12 | initiate. One side waits to offer an exchange and the other side waits to 13 | accept. 14 | 15 | Senders can offer to @emph{give} values to passive takers, but receivers can 16 | also offer to @emph{take} values from passive senders. This generalized model 17 | of communication enables push- and pull-based messaging patterns independent 18 | of the direction of data flow. When a pair of processes perform complementary 19 | operations, the two synchronize and resume evaluation as the exchanged value 20 | is delivered. 21 | 22 | @section{A calculus of mediated exchange} 23 | 24 | The intransitivity of bare channel synchronization complicates the semantics 25 | of mediated operations such as forwarding. The following examples illustrate 26 | this problem in terms of a forwarding operation. 27 | 28 | With channels, the giver blocks to put a value into the forwarder while the 29 | taker blocks to get a value from the forwarder. The forwarder accepts a value 30 | from the giver as the giver unblocks ahead of the taker. The intended 31 | synchronization is now impossible. 32 | 33 | @(:named-seqs 34 | [@:val{giver} (:ch-put "v" "ch1") :cdots] 35 | [@:val{forwarder} (:ch-get "ch1" "v") (:ch-put "v" "ch2")] 36 | [@:val{taker} (:ch-get "ch2" "v") :cdots]) 37 | 38 | In the other direction, the emitter blocks to put a value into the forwarder 39 | while the receiver blocks to get a value from the forwarder. The forwarder 40 | accepts a value from the emitter as the emitter unblocks ahead of the 41 | receiver. Again, the intended synchronization becomes impossible. 42 | 43 | @(:named-seqs 44 | [@:val{emitter} (:ch-put "v" "ch1") :cdots] 45 | [@:val{forwarder} (:ch-get "ch1" "v") (:ch-put "v" "ch2")] 46 | [@:val{receiver} (:ch-get "ch2" "v") :cdots]) 47 | 48 | Exchangers are an alternative to bare channels that preserve synchronization 49 | across mediated exchanges by deferring the synchronizing operation until all 50 | sides have committed to the exchange. 51 | 52 | @subsection{Primitive operations} 53 | 54 | @(:define/picts 55 | [(make-exchanger [ctrl (make-channel)] 56 | [data (make-channel)]) (code:comment "ex")] 57 | @:exchanger[]) 58 | 59 | An exchanger contains a control channel and a data channel. 60 | 61 | @(:define/picts 62 | [(offer ex1 #:to ex2)] (:offer "ex1" #:to "ex2")) 63 | 64 | A thread can offer one exchanger to another by putting the first into the 65 | control channel of the second. 66 | 67 | @(:define/picts 68 | [(accept #:from ex) (code:comment "ex*")] (:accept #:from "ex" "ex*")) 69 | 70 | A thread can accept an exchanger by getting it from the control channel of 71 | another. 72 | 73 | @(:define/picts 74 | [(put v #:into ex)] (:put "v" #:into "ex")) 75 | 76 | A thread can put a value into the data channel of an exchanger. 77 | 78 | @(:define/picts 79 | [(get #:from ex) (code:comment "v")] (:get #:from "ex" "v")) 80 | 81 | A thread can get a value from the data channel of an exchanger. 82 | 83 | @subsection{Process exchangers} 84 | 85 | A process has two exchangers: one for transmitting and another for receiving. 86 | 87 | @(:define*/picts 88 | ([(giver tx rx v)] (:seq (:offer "tx" #:to "rx") (:put "v" #:into "tx"))) 89 | ([(taker rx)] (:seq (:accept #:from "rx" "tx") (:get #:from "tx" "v")))) 90 | 91 | In a give-take exchange, a giver offers its transmitting exchanger to the 92 | receiving exchanger of a taker. After the taker commits to the exchange by 93 | accepting the offer, a single value flows through the transmitting exchanger 94 | from giver to taker. 95 | 96 | @(:define*/picts 97 | ([(receiver rx tx)] (:seq (:offer "rx" #:to "tx") (:get #:from "rx" "v"))) 98 | ([(emitter tx v)] (:seq (:accept #:from "tx" "rx") (:put "v" #:into "rx")))) 99 | 100 | In a receive-emit exchange, a receiver offers its receiving exchanger to the 101 | transmitting exchanger of an emitter. After the emitter commits to the 102 | exchange by accepting the offer, a single value flows through the receiving 103 | exchanger from emitter to receiver. 104 | 105 | @(:define/picts 106 | [(forwarder ex1 ex2)] 107 | (:seq (:accept #:from "ex1" "ex") (:offer "ex" #:to "ex2"))) 108 | 109 | In a forwarding exchange, a mediator accepts an exchanger from one exchanger 110 | and then offers it to another. 111 | 112 | @(:define/picts 113 | [(filterer ex1 ex2 #:with proc)] 114 | (:seq (:accept* (:exchanger "ex1" "ctrl1" "data1") (:exchanger "ex")) 115 | (:offer* (:exchanger "ex*" "ctrl" "data*") 116 | (:exchanger "ex2" "ctrl2" "data2")))) 117 | 118 | A filtering exchange is a forwarding exchange with a filtering procedure. A 119 | mediator accepts an exchanger, wraps its data channel in an impersonator that 120 | applies the filtering procedure, then offers the modified exchanger to another. 121 | 122 | The filter procedure is applied by the thread that uses the impersonator. 123 | 124 | @(:define/picts 125 | [(coupler rx tx [ex (make-exchanger)])] 126 | (:seq (:offer "ex" #:to "rx") (:offer "ex" #:to "tx"))) 127 | 128 | In a coupling exchange, a mediator offers an exchanger to two others. 129 | 130 | @subsection{Transitive synchronization} 131 | 132 | @subsubsection[#:style '(unnumbered)]{From giver to taker} 133 | 134 | @(:named-seqs 135 | [@:val{giver} (:offer "tx" #:to "ex1") (:put "v" #:into "tx")] 136 | [@:val{forwarder} (:accept #:from "ex1" "tx") (:offer "tx" #:to "ex2")] 137 | [@:val{taker} (:accept #:from "ex2" "tx") (:get #:from "tx" "v")]) 138 | 139 | The giver offers its transmitting exchanger to the forwarder and then blocks 140 | to put a value into the exchanger. The forwarder accepts the exchanger from 141 | the giver and then offers it to the taker. The taker accepts the giver's 142 | transmitting exchanger from the forwarder and then gets a value as the giver 143 | unblocks. 144 | 145 | Data and control flow from the giver to the taker. Until the taker is ready to 146 | accept, the forwarder blocks to offer and the giver blocks to put, preventing 147 | the giver from prematurely synchronizing on the forwarder. 148 | 149 | @subsubsection[#:style '(unnumbered)]{From giver to taker with filter} 150 | 151 | @(:named-seqs 152 | [@:val{giver} (:offer "tx" #:to "ex1") (:put "v" #:into "tx")] 153 | [@:val{filterer} 154 | (:accept* (:exchanger "ex1" "ctrl1" "data1") (:exchanger "tx")) 155 | (:offer* (:exchanger "tx*" "ctrl" "data*") 156 | (:exchanger "ex2" "ctrl2" "data2"))] 157 | [@:val{taker} 158 | (:accept* (:exchanger "ex2" "ctrl2" "data2") (:ref "tx*")) 159 | (:get* (:exchanger "tx*" "ctrl" "data*") (:val "(proc v)"))]) 160 | 161 | In a give-take exchange, the filter is applied by the taker on get. 162 | 163 | @subsubsection[#:style '(unnumbered)]{From emitter to receiver} 164 | 165 | @(:named-seqs 166 | [@:val{receiver} (:offer "rx" #:to "ex1") (:get #:from "rx" "v")] 167 | [@:val{forwarder} (:accept #:from "ex1" "rx") (:offer "rx" #:to "ex2")] 168 | [@:val{emitter} (:accept #:from "ex2" "rx") (:put "v" #:into "rx")]) 169 | 170 | The receiver offers its receiving exchanger to the forwarder and then blocks 171 | to get a value from the exchanger. The forwarder accepts the exchanger from 172 | the receiver and then offers it to the emitter. The emitter accepts the 173 | receiver's receiving exchanger from the forwarder and then puts a value into 174 | it as the receiver unblocks. 175 | 176 | Data flows from emitter to receiver, but control flows in the opposite 177 | direction. Until the emitter is ready to accept, the forwarder blocks to offer 178 | and the receiver blocks to get, preventing the emitter from prematurely 179 | synchronizing on the forwarder. 180 | 181 | @subsubsection[#:style '(unnumbered)]{From emitter to receiver with filter} 182 | 183 | @(:named-seqs 184 | [@:val{receiver} (:offer "rx" #:to "ex1") (:get #:from "rx" "(proc v)")] 185 | [@:val{filterer} 186 | (:accept* (:exchanger "ex1" "ctrl1" "data1") (:exchanger "rx")) 187 | (:offer* (:exchanger "rx*" "ctrl" "data*") 188 | (:exchanger "ex2" "ctrl2" "data2"))] 189 | [@:val{emitter} 190 | (:accept* (:exchanger "ex2" "ctrl2" "data2") (:ref "rx*")) 191 | (:put* (:val "v") (:exchanger "rx*" "ctrl" "data*"))]) 192 | 193 | In an emit-receive exchange, the filter is applied by the emitter on put. 194 | 195 | @subsubsection[#:style '(unnumbered)]{From emitter to taker} 196 | 197 | Couplers are forwarders for emit-take exchanges. The coupler offers an 198 | exchanger to a taker and then an emitter. The emitter and taker both accept 199 | the exchanger from the coupler and then synchronize by exchanging a value 200 | through the shared exchanger. 201 | 202 | @(:named-seqs 203 | [@:val{coupler} (:offer "ex" #:to "rx") (:offer "ex" #:to "tx")] 204 | [@:val{emitter} (:accept #:from "tx" "ex") (:put "v" #:into "ex")] 205 | [@:val{taker} (:accept #:from "rx" "ex") (:get #:from "ex" "v")]) 206 | -------------------------------------------------------------------------------- /neuron-lib/process.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | neuron/exchanger 5 | racket/contract/base 6 | (only-in racket/list flatten)) 7 | 8 | (provide 9 | start 10 | (contract-out 11 | [unhandled symbol?] 12 | [struct unhandled-command 13 | ([process process?] 14 | [args (listof any/c)])] 15 | [process? predicate/c] 16 | [process (-> (-> any) process?)] 17 | [process-tx (-> process? exchanger?)] 18 | [process-rx (-> process? exchanger?)] 19 | [command (-> process? (listof any/c) any)] 20 | [stop (-> process? void?)] 21 | [kill (-> process? void?)] 22 | [wait (-> process? void?)] 23 | [dead? (-> process? boolean?)] 24 | [alive? (-> process? boolean?)] 25 | [current-process (-> process?)] 26 | [quit (->* () #:rest (listof any/c) void?)] 27 | [die (->* () #:rest (listof any/c) void?)] 28 | [deadlock (->* () #:rest (listof any/c) void?)])) 29 | 30 | (define unhandled 31 | (string->unreadable-symbol "unhandled")) 32 | 33 | (struct unhandled-command (process args) #:transparent) 34 | 35 | (struct process 36 | (thread dead-cont stop-cont command raised tx rx) 37 | #:constructor-name make-process 38 | #:omit-define-syntaxes 39 | #:property prop:evt (λ (π) (wait-evt π)) 40 | #:property prop:procedure (λ (π . vs) 41 | (define result (command π vs)) 42 | (if (eq? result unhandled) 43 | (raise (unhandled-command π vs)) 44 | result))) 45 | 46 | (define (wait-evt π) 47 | (handle-evt 48 | (process-thread π) 49 | (λ _ 50 | (define raised (unbox (process-raised π))) 51 | (when (pair? raised) 52 | (raise (car raised))) 53 | π))) 54 | 55 | (define (command π vs) 56 | (let loop ([handlers (process-command π)]) 57 | (if (null? handlers) 58 | unhandled 59 | (let ([result (apply (car handlers) vs)]) 60 | (if (equal? result unhandled) 61 | (loop (cdr handlers)) 62 | result))))) 63 | 64 | (define current-process 65 | (make-parameter 66 | (make-process (current-thread) 67 | #f #f #f #f 68 | (make-exchanger) 69 | (make-exchanger)))) 70 | 71 | (define (quit . _) 72 | ((process-stop-cont (current-process)))) 73 | 74 | (define (die . _) 75 | ((process-dead-cont (current-process)))) 76 | 77 | (define (deadlock . _) 78 | (sync never-evt)) 79 | 80 | (define current-on-stop (make-parameter null)) 81 | (define current-on-dead (make-parameter null)) 82 | (define current-command (make-parameter null)) 83 | 84 | (define (process thunk) 85 | (define on-stop-hook (flatten (current-on-stop))) 86 | (define on-dead-hook (flatten (current-on-dead))) 87 | (define command-hook (flatten (current-command))) 88 | (parameterize ([current-on-stop null] 89 | [current-on-dead null] 90 | [current-command null]) 91 | (define raised (box #f)) 92 | (define ready-ch (make-channel)) 93 | (define (process) 94 | (let/ec dead-cont 95 | (let/ec stop-cont 96 | (parameterize-break #f 97 | (channel-put ready-ch dead-cont) 98 | (channel-put ready-ch stop-cont) 99 | (parameterize ([current-process (channel-get ready-ch)]) 100 | (with-handlers ([exn:break:hang-up? quit] 101 | [exn:break:terminate? die] 102 | [(λ _ #t) (λ (e) (set-box! raised (list e)) (die))]) 103 | (parameterize-break #t 104 | (thunk)))))) 105 | (for ([proc on-stop-hook]) (proc))) 106 | (parameterize-break #f 107 | (for ([proc on-dead-hook]) (proc))) 108 | (sleep)) 109 | (define π 110 | (make-process (thread process) 111 | (channel-get ready-ch) 112 | (channel-get ready-ch) 113 | command-hook 114 | raised 115 | (make-exchanger) 116 | (make-exchanger))) 117 | (channel-put ready-ch π) 118 | π)) 119 | 120 | (define-syntax start 121 | (syntax-rules () 122 | [(start body ... #:on-stop on-stop) 123 | (parameterize ([current-on-stop (cons on-stop (current-on-stop))]) 124 | (start body ...))] 125 | [(start body ... #:on-dead on-dead) 126 | (parameterize ([current-on-dead (cons on-dead (current-on-dead))]) 127 | (start body ...))] 128 | [(start body ... #:command command) 129 | (parameterize ([current-command (cons command (current-command))]) 130 | (start body ...))] 131 | [(start π) π])) 132 | 133 | (define (stop π) 134 | (break-thread (process-thread π) 'hang-up) 135 | (wait π)) 136 | 137 | (define (kill π) 138 | (break-thread (process-thread π) 'terminate) 139 | (wait π)) 140 | 141 | (define (wait π) 142 | (void (sync π))) 143 | 144 | (define (dead? π) 145 | (thread-dead? (process-thread π))) 146 | 147 | (define (alive? π) 148 | (not (dead? π))) 149 | 150 | (module+ test 151 | (require rackunit) 152 | 153 | ;; starting and stopping 154 | 155 | (test-case 156 | "A process is alive if it is not dead." 157 | (define π (process deadlock)) 158 | (check-true (alive? π)) 159 | (check-false (dead? π))) 160 | 161 | (test-case 162 | "A process is dead if it is not alive." 163 | (define π (process void)) 164 | (wait π) 165 | (check-true (dead? π)) 166 | (check-false (alive? π))) 167 | 168 | (test-case 169 | "A process is alive when it starts." 170 | (define π (process deadlock)) 171 | (check-true (alive? π))) 172 | 173 | (test-case 174 | "A process is dead after it ends." 175 | (define π (process void)) 176 | (wait π) 177 | (check-true (dead? π))) 178 | 179 | (test-case 180 | "A process can be stopped before it ends." 181 | (define π (process deadlock)) 182 | (stop π) 183 | (check-true (dead? π))) 184 | 185 | (test-case 186 | "A process is dead after it is stopped." 187 | (define π (process deadlock)) 188 | (stop π) 189 | (check-true (dead? π))) 190 | 191 | (test-case 192 | "A process can be killed before it ends." 193 | (define π (process deadlock)) 194 | (kill π) 195 | (check-true (dead? π))) 196 | 197 | (test-case 198 | "A process is dead after it is killed." 199 | (define π (process deadlock)) 200 | (stop π) 201 | (check-true (dead? π))) 202 | 203 | ;; on-stop hook 204 | 205 | (require racket/function) 206 | 207 | (test-case 208 | "A process calls its on-stop hook when it ends." 209 | (define stopped #f) 210 | (wait (start (process void) #:on-stop (λ () (set! stopped #t)))) 211 | (check-true stopped)) 212 | 213 | (test-case 214 | "A process calls its on-stop hook when it stops." 215 | (define stopped #f) 216 | (stop (start (process deadlock) #:on-stop (λ () (set! stopped #t)))) 217 | (check-true stopped)) 218 | 219 | (test-case 220 | "A process does not call its on-stop hook when it dies." 221 | (define stopped #f) 222 | (wait (start (process die) #:on-stop (λ () (set! stopped #t)))) 223 | (check-false stopped)) 224 | 225 | (test-case 226 | "A process does not call its on-stop hook when it is killed." 227 | (define stopped #f) 228 | (kill (start (process deadlock) #:on-stop (λ () (set! stopped #t)))) 229 | (check-false stopped)) 230 | 231 | ;; on-dead hook 232 | 233 | (test-case 234 | "A process calls its on-dead hook when it ends." 235 | (define dead #f) 236 | (wait (start (process void) #:on-dead (λ () (set! dead #t)))) 237 | (check-true dead)) 238 | 239 | (test-case 240 | "A process calls its on-dead hook when it stops." 241 | (define dead #f) 242 | (stop (start (process deadlock) #:on-dead (λ () (set! dead #t)))) 243 | (check-true dead)) 244 | 245 | (test-case 246 | "A process calls its on-dead hook when it dies." 247 | (define dead #f) 248 | (wait (start (process die) #:on-dead (λ () (set! dead #t)))) 249 | (check-true dead)) 250 | 251 | (test-case 252 | "A process calls its on-dead hook when it is killed." 253 | (define dead #f) 254 | (kill (start (process deadlock) #:on-dead (λ () (set! dead #t)))) 255 | (check-true dead)) 256 | 257 | ;; command handler 258 | 259 | (test-case 260 | "A process invokes its command handler when applied as a procedure." 261 | (define handled #f) 262 | ((start (process deadlock) #:command (λ (v) (set! handled v))) #t) 263 | (check-true handled)) 264 | 265 | ;; synchronizable event 266 | 267 | (test-case 268 | "A process is ready for synchronization when sync would not block." 269 | (define π (process deadlock)) 270 | (check-false (sync/timeout 0 π)) 271 | (kill π) 272 | (check-false (not (sync/timeout 0 π)))) 273 | 274 | (test-case 275 | "The synchronization result of a process is the process itself." 276 | (define π (process die)) 277 | (check eq? (sync π) π)) 278 | 279 | ;; unhandled exceptions 280 | 281 | (test-case 282 | "Unhandled exceptions are fatal." 283 | (define π (process (λ () (raise #t)))) 284 | (with-handlers ([(λ _ #t) (λ (e) e)]) (wait π)) 285 | (check-true (dead? π))) 286 | 287 | (test-case 288 | "wait raises unhandled-exception on unhandled exceptions." 289 | (check-exn boolean? (λ () (wait (process (λ () (raise #t)))))))) 290 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/drawings.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require pict 4 | pict/convert 5 | racket/class 6 | racket/draw 7 | racket/function 8 | racket/match 9 | scribble/base 10 | (only-in scribble/core make-style) 11 | (only-in scribble/html-properties make-css-addition) 12 | (only-in scribble/manual racket)) 13 | 14 | (provide (all-defined-out)) 15 | 16 | (define FONT-SIZE 16) 17 | (define BIG-FONT-SIZE 30) 18 | (define MIN-CHANNEL-WIDTH 70) 19 | (define MIN-EDGE-LEN 60) 20 | 21 | ;; (define full-width-style 22 | ;; (make-style 23 | ;; "FullWidth" 24 | ;; (list (make-css-addition "scribblings/full-width.css")))) 25 | 26 | (define blocks-style 27 | (make-style "Blocks" (list (make-css-addition "scribblings/blocks.css")))) 28 | 29 | (define leading-spaces-style 30 | (make-style 31 | "LeadingSpaces" 32 | (list (make-css-addition "scribblings/leading-spaces.css")))) 33 | 34 | (define (draw pict) 35 | (if (pict-convertible? pict) (pict-convert pict) pict)) 36 | 37 | ;; Drawings 38 | 39 | (define (pad pict [t #f] [r #f] [b #f] [l #f]) 40 | (define w (pict-width pict)) 41 | (define h (pict-height pict)) 42 | (set! t (or t 5)) 43 | (set! r (or r 5)) 44 | (set! b (or b t 5)) 45 | (set! l (or l r 5)) 46 | (hc-append 47 | (blank l (+ h t b)) 48 | (vc-append (blank w t) pict (blank w b)) 49 | (blank r (+ h t b)))) 50 | 51 | (define (label content) 52 | (text content 'roman FONT-SIZE)) 53 | 54 | ;; Block Diagrams 55 | 56 | (define-syntax-rule (block-diagram [content ...] ...) 57 | (tabular 58 | #:cell-properties '(((center border))) 59 | (list (list content ...) ...))) 60 | 61 | (define-syntax-rule (blocks [content ...] ...) 62 | (tabular 63 | #:style blocks-style 64 | (list (list content ...) ...))) 65 | 66 | (define (block str) 67 | (pad (label str) 10 25)) 68 | 69 | ;; Semantic Diagrams 70 | 71 | (define val (compose pad label)) 72 | 73 | (struct ~channel 74 | (label in out) 75 | #:property prop:pict-convertible 76 | (match-lambda 77 | [(~channel lbl ch-in ch-out) 78 | (define pict (hc-append ch-in lbl ch-out)) 79 | (set! pict (pin-line pict ch-out lt-find ch-in lt-find)) 80 | (set! pict (pin-line pict ch-in lt-find ch-in rc-find)) 81 | (set! pict (pin-line pict ch-in rc-find ch-in lb-find)) 82 | (set! pict (pin-line pict ch-in lb-find ch-out lb-find)) 83 | (set! pict (pin-line pict ch-out lb-find ch-out rc-find)) 84 | (set! pict (pin-line pict ch-out rc-find ch-out lt-find)) 85 | pict])) 86 | 87 | (define (node content) 88 | (define body (pad (label content) 10 10)) 89 | (define w (pict-width body)) 90 | (define h (pict-height body)) 91 | (cc-superimpose 92 | (filled-rectangle w h #:draw-border? #f #:color "white") 93 | body 94 | (rectangle w h))) 95 | 96 | (define (channel content) 97 | (define lbl (val content)) 98 | (when (< (pict-width lbl) MIN-CHANNEL-WIDTH) 99 | (set! lbl (pad lbl 0 (/ (- MIN-CHANNEL-WIDTH (pict-width lbl)) 2)))) 100 | (define w (pict-width lbl)) 101 | (define h (pict-height lbl)) 102 | (set! lbl (cc-superimpose 103 | (filled-rectangle w h #:draw-border? #f #:color "white") 104 | lbl)) 105 | 106 | (define (draw-ch-in dc dx dy) 107 | (define old-brush (send dc get-brush)) 108 | (define old-pen (send dc get-pen)) 109 | (define top-fin (new dc-path%)) 110 | (send top-fin move-to 0 0) 111 | (send top-fin line-to 5 0) 112 | (send top-fin line-to 5 (/ h 2)) 113 | (send top-fin close) 114 | (define bottom-fin (new dc-path%)) 115 | (send bottom-fin move-to 0 h) 116 | (send bottom-fin line-to 5 h) 117 | (send bottom-fin line-to 5 (/ h 2)) 118 | (send bottom-fin close) 119 | (send dc set-brush (new brush% [color "white"] [style 'solid])) 120 | (send dc set-pen (new pen% [width 1] [color "white"])) 121 | (send dc draw-path top-fin dx dy) 122 | (send dc draw-path bottom-fin dx dy) 123 | (send dc set-brush old-brush) 124 | (send dc set-pen old-pen)) 125 | (define ch-in (dc draw-ch-in 5 h)) 126 | 127 | (define (draw-ch-out dc dx dy) 128 | (define old-brush (send dc get-brush)) 129 | (define old-pen (send dc get-pen)) 130 | (define path (new dc-path%)) 131 | (send path move-to 0 0) 132 | (send path line-to 5 (/ h 2)) 133 | (send path line-to 0 h) 134 | (send dc set-brush (new brush% [color "white"] [style 'solid])) 135 | (send dc set-pen (new pen% [width 1] [color "white"])) 136 | (send dc draw-path path dx dy) 137 | (send dc set-brush old-brush) 138 | (send dc set-pen old-pen)) 139 | (define ch-out (dc draw-ch-out 5 h)) 140 | 141 | (~channel lbl ch-in ch-out)) 142 | 143 | (define (big str) 144 | (text str null BIG-FONT-SIZE)) 145 | 146 | (define cdots (pad (big "···"))) 147 | 148 | (define (--> content 149 | lhs lhs-offset lhs-part lhs-find 150 | rhs rhs-offset rhs-part rhs-find) 151 | (define label-pict (pad (or content (blank)) 5 15 2 5)) 152 | (define label-width (pict-width label-pict)) 153 | (define lhs* (apply offset (cons (pict-convert lhs) lhs-offset))) 154 | (define rhs* (apply offset (cons (pict-convert rhs) rhs-offset))) 155 | (define edge-len (max (+ label-width 20) MIN-EDGE-LEN)) 156 | (define pict (hc-append edge-len lhs* rhs*)) 157 | (pin-arrow-line 158 | 10 pict 159 | (if lhs-part (lhs-part lhs) (~offset-target lhs*)) 160 | (or lhs-find rc-find) 161 | (if rhs-part (rhs-part rhs) (~offset-target rhs*)) 162 | (or rhs-find lc-find) 163 | #:label label-pict)) 164 | 165 | (struct ~offset 166 | (target x y) 167 | #:property prop:pict-convertible 168 | (match-lambda 169 | [(~offset tgt x y) 170 | (pad tgt (max y 0) (- (min x 0)) (- (min y 0)) (max x 0))])) 171 | 172 | (define (offset tgt [x 0] [y 0]) 173 | (~offset (draw tgt) x y)) 174 | 175 | (define (intersperse y xs) 176 | (if (or (null? xs) (null? (cdr xs))) 177 | xs 178 | (list* (car xs) y (intersperse y (cdr xs))))) 179 | 180 | (define (seq . picts) 181 | (apply (curry hc-append 10) 182 | (intersperse (big ";") picts))) 183 | 184 | (struct ~exchanger 185 | (name ctrl data) 186 | #:property prop:pict-convertible 187 | (match-lambda 188 | [(~exchanger name ctrl data) 189 | (define body 190 | (vc-append (pad name 10 10 5 10) (pad ctrl 0 10) (pad data 0 10 10 10))) 191 | (cc-superimpose 192 | (filled-rounded-rectangle 193 | (pict-width body) 194 | (pict-height body) 195 | -0.125 #:color "white") 196 | body)])) 197 | 198 | (define (exchanger [name "ex"] [ctrl "ctrl"] [data "data"]) 199 | (~exchanger 200 | (label name) 201 | (draw (channel ctrl)) 202 | (draw (channel data)))) 203 | 204 | (define (ref name) 205 | (define body (val name)) 206 | (cc-superimpose 207 | (filled-rounded-rectangle 208 | (pict-width body) 209 | (pict-height body) 210 | #:color "white") 211 | body)) 212 | 213 | ;; Document Structure 214 | 215 | (define-syntax-rule (named-picts [name pict] ... [last-name last-pict]) 216 | (tabular 217 | #:style leading-spaces-style 218 | #:cell-properties '((center)) 219 | (append 220 | (list 221 | (list (draw name) pict) 222 | (list (blank 25) 'cont)) 223 | ... 224 | (list 225 | (list (draw last-name) last-pict))))) 226 | 227 | (define-syntax-rule (named-seqs [name pict1 picts ...] ... 228 | [last-name last-pict1 last-picts ...]) 229 | (tabular 230 | #:style leading-spaces-style 231 | #:cell-properties '((center)) 232 | (append 233 | (list 234 | (list (draw name) (seq pict1 picts ...)) 235 | (list (blank 25) 'cont)) 236 | ... 237 | (list 238 | (list (draw last-name) (seq last-pict1 last-picts ...)))))) 239 | 240 | (define-syntax-rule (define/picts [code ...] pict ... last-pict) 241 | (tabular 242 | #:style 'boxed 243 | #:cell-properties '((center)) 244 | (append 245 | (list 246 | (list (racket code ...)) 247 | (list (blank 10))) 248 | (list 249 | (list (draw pict)) 250 | (list (blank 25))) 251 | ... 252 | (list 253 | (list (draw last-pict)))))) 254 | 255 | (define-syntax-rule (define*/picts 256 | ([code0 ...] pict0 ... last-pict0) ... 257 | ([code ...] pict ... last-pict)) 258 | (tabular 259 | #:style 'boxed 260 | #:cell-properties '((center)) 261 | (append 262 | (append 263 | (list 264 | (list (racket code0 ...)) 265 | (list (blank 10))) 266 | (list 267 | (list (draw pict0)) 268 | (list (blank 25))) 269 | ... 270 | (list 271 | (list (draw last-pict0)) 272 | (list (blank 10)))) 273 | ... 274 | (append 275 | (list 276 | (list (blank 20)) 277 | (list (racket code ...)) 278 | (list (blank 10))) 279 | (list 280 | (list (draw pict)) 281 | (list (blank 25))) 282 | ... 283 | (list 284 | (list (draw last-pict))))))) 285 | 286 | ;; Channel Operations 287 | 288 | (define (ch-put v ch) 289 | (--> (label "put") 290 | (val v) '(0 0) #f #f 291 | (channel ch) '(0 0) #f #f)) 292 | 293 | (define (ch-get ch v) 294 | (--> (label "get") 295 | (channel ch) '(0 0) #f #f 296 | (val v) '(0 0) #f #f)) 297 | 298 | ;; Exchanger Operations 299 | 300 | (define (offer* ex1 ex2 [ofs '(0 -5)]) 301 | (--> (label "offer") 302 | ex1 ofs #f #f 303 | ex2 '(0 0) ~exchanger-ctrl #f)) 304 | 305 | (define (accept* ex ex* [ofs '(0 -5)]) 306 | (--> (label "accept") 307 | ex '(0 0) ~exchanger-ctrl #f 308 | ex* ofs #f #f)) 309 | 310 | (define (put* v ex [ofs '(0 52)]) 311 | (--> (label "put") 312 | v ofs #f #f 313 | ex '(0 0) ~exchanger-data #f)) 314 | 315 | (define (get* ex v [ofs '(0 52)]) 316 | (--> (label "get") 317 | ex '(0 0) ~exchanger-data #f 318 | v ofs #f #f)) 319 | 320 | (define (offer ex1 #:to ex2) 321 | (offer* (ref ex1) (exchanger ex2))) 322 | 323 | (define (accept #:from ex ex*) 324 | (accept* (exchanger ex) (ref ex*))) 325 | 326 | (define (put v #:into ex) 327 | (put* (val v) (exchanger ex))) 328 | 329 | (define (get #:from ex v) 330 | (get* (exchanger ex) (val v))) 331 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/guide.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "base.rkt" 4 | (prefix-in : "drawings.rkt")) 5 | 6 | @title[ 7 | #:style '(unnumbered) 8 | #:tag "The Neuron Guide" 9 | ]{The Neuron Guide} 10 | @author{@author+email["Eric Griffis" "dedbox@gmail.com"]} 11 | 12 | This guide provides examples, tutorials, notes and other documentation that do 13 | not belong in @secref{The Neuron Reference}. 14 | 15 | @section{Introduction} 16 | 17 | Neuron is a series of Racket libraries that provide a consistent API over a 18 | spectrum of functionality related to the creation, operation, integration, and 19 | evolution of concurrent, distributed, and decentralized run time environments 20 | and applications. At its core is a communication-based concurrency model and a 21 | structural pattern-based DSL for working with composable evaluators. 22 | 23 | @(:named-picts 24 | [@:val{Control} 25 | (:block-diagram 26 | [@:block{Stepper} @:block{Process}] 27 | [ @:block{Data Flow} 'cont ])] 28 | [@:val{Operate} 29 | (:block-diagram 30 | [@:block{Consistency} @:block{Availability}] 31 | [ @:block{Distributed System} 'cont ])] 32 | [@:val{Cooperate} 33 | (:block-diagram 34 | [@:block{Identity} @:block{Consensus} @:block{Capability} ] 35 | [@:block{Trust} @:block{Reputation} @:block{Authorization}] 36 | [ @:block{Agreement} 'cont @:block{Enforcement} ] 37 | [ @:block{Decentralized Application} 'cont 'cont ])] 38 | [@:val{Grow} 39 | (:block-diagram 40 | [(:blocks 41 | [@:block{Agency} @:block{Adaptation} @:block{Reproduction}] 42 | [@:block{Organism} 'cont 'cont]) 43 | @:block{Resources}] 44 | [@:block{Software Ecosystem} 'cont])]) 45 | 46 | @section{Communication-based Concurrency} 47 | 48 | Neuron uses a concurrency model of lightweight processes communicating over 49 | named synchronous @tech{exchangers}. Neuron processes extend Racket 50 | @rtech{threads} with support for life cycle hooks and two orthogonal lines of 51 | communication. In other words, a @tech{process} is like a @rtech{thread} that 52 | can clean up after itself and keep ``secrets.'' 53 | 54 | @subsection{The Process Life Cycle} 55 | 56 | When a @tech{process} is created, @tech{hooks} and @tech{handlers} may be 57 | installed. A @deftech{hook} is a function to be invoked automatically at 58 | specific points in the life time of a @tech{process}. 59 | 60 | @(centered 61 | (let () 62 | (define starting @:val{starting}) 63 | (define alive @:val{alive}) 64 | (define stopping @:val{stopping}) 65 | (define dying @:val{dying}) 66 | (define dead @:val{dead}) 67 | (define blank1 @:val{ }) 68 | (define blank2 @:val{ }) 69 | (define diagram 70 | (hc-append 71 | 60 72 | (vc-append 40 starting blank1) 73 | (vc-append 40 alive blank2) 74 | (vc-append 40 stopping dying) 75 | (vc-append 40 blank1 dead))) 76 | (set! diagram (pin-arrow-line 10 diagram starting rc-find alive lc-find)) 77 | (set! diagram (pin-arrow-line 10 diagram alive rc-find stopping lc-find)) 78 | (set! diagram (pin-line diagram alive cb-find blank2 cc-find)) 79 | (set! diagram (pin-arrow-line 10 diagram blank2 cc-find dying lc-find)) 80 | (set! diagram (pin-arrow-line 10 diagram stopping cb-find dying ct-find)) 81 | (set! diagram (pin-arrow-line 10 diagram dying rc-find dead lc-find)) 82 | diagram)) 83 | 84 | A @tech{process} is created in the starting state when another @tech{process} 85 | attempts to spawn a new thread of execution. The requesting @tech{process} 86 | blocks until the new @tech{process} is alive and a fresh @tech{process 87 | descriptor} for it has been returned. 88 | 89 | A @tech{process} stays alive until its thread of execution terminates. A 90 | @tech{process} can terminate itself, either by reaching the end of its program 91 | or by issuing a @racket[quit] or @racket[die] command. A @tech{process} can 92 | also use the @racket[stop] or @racket[kill] command to terminate any 93 | @tech{process} it holds a @tech{process descriptor} for. 94 | 95 | When a @tech{process} reaches the end of its program or is terminated by 96 | @racket[quit] or @racket[stop], it enters the stopping state while it calls 97 | its @tech{on-stop hook}. When a @tech{process} reaches the end of its 98 | @tech{on-stop hook} or is terminated by a @racket[die] or @racket[kill] 99 | command, it enters the dying state while it calls its @tech{on-dead hook}. A 100 | @tech{process} is dead when its @tech{on-dead hook} returns. 101 | 102 | @examples[ 103 | #:eval neuron-evaluator 104 | #:label #f 105 | (wait (start (start (process (λ () (displayln 'ALIVE))) 106 | #:on-stop (λ () (displayln 'STOP-1)) 107 | #:on-dead (λ () (displayln 'DEAD-1))) 108 | #:on-stop (λ () (displayln 'STOP-2)) 109 | #:on-dead (λ () (displayln 'DEAD-2)))) 110 | ] 111 | 112 | The @tech{on-dead hook} is for freeing resources no longer needed by any 113 | @tech{process}. Neuron uses the @tech{on-dead hook} internally to terminate 114 | network listeners and @racket[kill] sub-processes. This @tech{hook} runs 115 | unconditionally and can't be canceled. 116 | 117 | The @tech{on-stop hook} is for extra or optional clean-up tasks. Neuron uses 118 | the @tech{on-stop hook} to close @rtech{ports}, terminate network connections, 119 | and @racket[stop] sub-processes. For example, some @tech{codecs} close 120 | @rtech{input ports} and @rtech{output ports} when stopped but not when killed 121 | so they can be swapped out mid-stream or restarted after errors have been 122 | handled. 123 | 124 | The @racket[deadlock] function waits for the current @tech{process} to 125 | terminate, allowing the computation to diverge efficiently. It can be used as 126 | a termination ``latch'' to prevent the current @tech{process} from ending 127 | until stopped or killed. 128 | 129 | @examples[ 130 | #:eval neuron-evaluator 131 | #:label #f 132 | (kill (start (start (process deadlock) 133 | #:on-stop (λ () (displayln 'STOP-1)) 134 | #:on-dead (λ () (displayln 'DEAD-1))) 135 | #:on-stop (λ () (displayln 'STOP-2)) 136 | #:on-dead (λ () (displayln 'DEAD-2)))) 137 | ] 138 | 139 | @subsection{Command Handlers} 140 | 141 | Applying a @tech{process descriptor} to an argument list invokes its 142 | @tech{command handler}, a simple dispatch mechanism. Because the @tech{command 143 | handler} is installed while a @tech{process} is starting, it can have direct 144 | access to the internal state of the @tech{process} via the constructing 145 | closure. 146 | 147 | Neuron uses the @tech{command handler} to provide simple properties and 148 | methods. 149 | 150 | @examples[ 151 | #:eval neuron-evaluator 152 | #:label #f 153 | (define π 154 | (let ([env #hash([(a b) . 1] 155 | [(c) . 2])]) 156 | (start (process deadlock) 157 | #:command (λ args (hash-ref env args #f))))) 158 | (π 'a 'b) 159 | (π 'c) 160 | (π 'd) 161 | ] 162 | 163 | @tech{Steppers} can be used as @tech{command handlers}, enabling 164 | @tech{term}-based DSLs for privileged control. 165 | 166 | @subsection[#:tag "guide:Data Flow"]{Data Flow} 167 | 168 | Processes can be combined to provide restricted or revocable access to others. 169 | 170 | @examples[ 171 | #:eval neuron-evaluator 172 | #:label "Restriction:" 173 | (define π (sexp-codec (string-socket #:in "12 34 56" #:out #t))) 174 | (define to-π (proxy-to π)) 175 | (define from-π (proxy-from π)) 176 | (recv from-π) 177 | (give to-π 'abc) 178 | (get-output-string (π 'socket)) 179 | (or (sync/timeout 0 (recv-evt to-π)) 180 | (sync/timeout 0 (give-evt from-π))) 181 | ] 182 | 183 | @examples[ 184 | #:eval neuron-evaluator 185 | #:label "Revocation:" 186 | (define A 187 | (process 188 | (λ () 189 | (define π-ref (take)) 190 | (displayln `(IN-A ,(recv π-ref))) 191 | (emit) (take) (code:comment "B kills π-ref") 192 | (displayln `(IN-A ,(recv π-ref)))))) 193 | (define B 194 | (process 195 | (λ () 196 | (define π (sexp-codec (string-socket #:in "12 34 56"))) 197 | (define π-ref (proxy π)) 198 | (give A π-ref) 199 | (recv A) (code:comment "A reads live π-ref") 200 | (kill π-ref) 201 | (give A) (wait A) (code:comment "A reads dead π-ref") 202 | (displayln `(IN-B ,(recv π)))))) 203 | (sync (evt-set A B #:then void)) 204 | ] 205 | 206 | @subsection{Working with Threads} 207 | 208 | Processes and @rtech{threads} can be combined. 209 | 210 | @examples[ 211 | #:eval neuron-evaluator 212 | #:label "Multiple producers:" 213 | (define (producer i) 214 | (thread (λ () (sleep (/ (random) 10.0)) (emit i)))) 215 | (define (make-producers) 216 | (apply evt-set (for/list ([i 10]) (producer i)))) 217 | (define π (process (λ () (sync (make-producers))))) 218 | (for/list ([_ 10]) 219 | (recv π)) 220 | ] 221 | 222 | @examples[ 223 | #:eval neuron-evaluator 224 | #:label "Multiple consumers:" 225 | (define (consumer) 226 | (thread (λ () (write (take))))) 227 | (define (make-consumers) 228 | (apply evt-set (for/list ([_ 10]) (consumer)))) 229 | (define π (process (λ () (sync (make-consumers))))) 230 | (for ([i 10]) 231 | (give π i)) 232 | ] 233 | 234 | @section[#:tag "guide:Evaluation"]{Evaluation} 235 | 236 | A @deftech{term} is defined recursively as a literal value or a serializable 237 | composite of sub-terms. For example, the symbol 238 | 239 | @racketblock['a-symbol] 240 | 241 | and the number 242 | 243 | @racketblock[123] 244 | 245 | are terms because they are literal values. The structures 246 | 247 | @racketblock[ 248 | '(a-symbol 123) 249 | ] 250 | 251 | and 252 | 253 | @racketblock[ 254 | #hasheq((a-symbol . 123)) 255 | ] 256 | 257 | are also terms because they are @racket[read]/@racket[write]able composites of 258 | literals. 259 | 260 | A @deftech{stepper} is a function that maps one @tech{term} to another. For 261 | example, 262 | 263 | @racketblock[ 264 | (case-lambda 265 | [(a) 1] 266 | [(b) 2] 267 | [else 0]) 268 | ] 269 | 270 | maps any term to a number between @racket[0] and @racket[2]. Similarly, 271 | 272 | @racketblock[ 273 | (match-lambda 274 | [1 'a] 275 | [2 'b] 276 | [_ 'z]) 277 | ] 278 | 279 | maps any term to @racket['a], @racket['b], or @racket['z]. A more realistic 280 | example is @racket[values], which maps every term to itself; or the function 281 | 282 | @racketblock[ 283 | (define step 284 | (match-lambda 285 | [(list (? term? e1) (? term? e2)) #:when (not (value? e1)) 286 | (list (step e1) e2)] 287 | [(list (? value? v1) (? term? e2?)) #:when (not (value? e2)) 288 | (list v1 (step e2))] 289 | [(list `(λ ,(? symbol? x11) ,(? term? e12)) (? value? v2)) 290 | (substitute e12 x11 v2)] 291 | [_ 'stuck])) 292 | ] 293 | 294 | a small-@tech{stepper} for the untyped lambda calculus. 295 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/reference/data-flow.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require "../base.rkt") 4 | 5 | @title{Data Flow} 6 | 7 | @section{Socket} 8 | 9 | @(defmodule neuron/socket) 10 | 11 | A @deftech{socket} is the local end of a bi-directional serial communications 12 | channel. Each socket holds an @rtech{input port} and an @rtech{output port}. 13 | 14 | A socket can be used as a @rtech{synchronizable event}. A socket is 15 | @rtech{ready for synchronization} when the ports it holds have closed. Sockets 16 | do not support half-open connections---when either port closes, the other port 17 | is closed immediately. 18 | 19 | @defproc[(socket? [v any/c]) boolean?]{ 20 | Returns @racket[#t] if @racket[v] is a @racket[socket], @racket[#f] 21 | otherwise. 22 | } 23 | 24 | @defproc[(socket [in-port input-port?] [out-port output-port?]) socket?]{ 25 | 26 | Returns a @tech{socket}. Serves as @racket[out-port] when used as an 27 | @rtech{output port}, and as @racket[in-port] when used as an @rtech{input 28 | port} or with procedures that take both kinds, such as 29 | @racket[file-position]. 30 | 31 | } 32 | 33 | @defproc[(close-socket [sock socket?]) void?]{ 34 | Closes the ports held by @racket[sock]. If the ports are already closed, 35 | @racket[close-socket] has no effect. 36 | } 37 | 38 | @defproc[(socket-closed? [sock socket?]) boolean?]{ 39 | Returns @racket{#t} if the ports held by @racket[sock] are closed, 40 | @racket[#f] otherwise. 41 | } 42 | 43 | @defproc[(null-socket) socket?]{ 44 | Returns a @tech{socket} that ignores all input and always outputs 45 | @racket[eof]. 46 | } 47 | 48 | @deftogether[( 49 | @defproc[(byte-socket [#:in str bytes? #""] 50 | [#:out out? boolean? #f]) socket?] 51 | @defproc[(string-socket [#:in str string? ""] 52 | [#:out out? boolean? #f]) socket?] 53 | )]{ 54 | 55 | Returns a @tech{socket} that inputs from @racket[str] and, if @racket[out?] 56 | is @racket[#t], accumulates output in a fresh output @rtech{string port}. 57 | 58 | @examples[ 59 | #:eval neuron-evaluator 60 | #:label "Example:" 61 | (define sock (string-socket #:in "123" #:out #t)) 62 | (read sock) 63 | (write 'abc sock) 64 | (get-output-string sock) 65 | ] 66 | } 67 | 68 | @defproc[(file-socket 69 | [#:in in-path (or/c path-string? #f) #f] 70 | [#:in-mode in-mode-flag (or/c 'binary 'text) 'binary] 71 | [#:out out-path (or/c path-string? #f) #f] 72 | [#:out-mode out-mode-flag (or/c 'binary 'text) 'binary] 73 | [#:exists exists-flag 74 | (or/c 'error 'append 'update 'can-update 75 | 'replace 'truncate 76 | 'must-truncate 'truncate/replace)]) socket?]{ 77 | Returns a @tech{socket} that opens the files specified by @racket[in-path] 78 | and @racket[out-path] for input and output, respectively. If 79 | @racket[in-path] is @racket[#f], then all input is ignored. If 80 | @racket[out-path] is @racket[#f], then only @racket[eof] is output. If both 81 | are @racket[#f], then the @racket[file-socket] call is equivalent to 82 | @racket[(null-socket)]. 83 | 84 | See @racket[open-input-file] for details on @racket[in-mode-flag], and 85 | @racket[open-output-file] for details on @racket[out-mode-flag] and 86 | @racket[exists-flag]. 87 | } 88 | 89 | @section{Codec} 90 | 91 | @(defmodule neuron/codec) 92 | 93 | A @deftech{codec} is a @racket[stream] that uses a @tech{socket} to exchange 94 | serializable values with remote agents. The @racket[sink] is called an 95 | @deftech{encoder}; it uses a @deftech{printer} procedure to serialize values 96 | to a socket. The @racket[source] is called a @deftech{decoder}; it uses a 97 | @deftech{parser} procedure to de-serialize values from a socket. 98 | 99 | @defthing[parser/c contract? #:value (-> socket? any/c)]{ 100 | 101 | Use this @rtech{function contract} to indicate that a function is a 102 | @tech{parser}. 103 | 104 | } 105 | 106 | @defthing[printer/c contract? #:value (-> any/c socket? any)]{ 107 | 108 | Use this @rtech{function contract} to indicate that a function is a 109 | @tech{printer}. 110 | 111 | } 112 | 113 | @defthing[codec/c contract? #:value (-> socket? process?)]{ 114 | 115 | Use this @rtech{function contract} to indicate that a function makes 116 | @tech{decoders}, @tech{encoders}, or @tech{codecs}. 117 | 118 | } 119 | 120 | @defproc[(flushed [prn printer/c]) printer/c]{ 121 | 122 | Returns a @tech{printer} that applies @racket[prn] to a @tech{socket} and 123 | then flushes its @rtech{output port}. 124 | 125 | } 126 | 127 | @defproc[(decoder [prs parser/c]) codec/c]{ 128 | Returns a procedure that makes @tech{decoders} based on @racket[prs]: 129 | 130 | Parses and emits values from a @tech{socket}. Stops when @racket[prs] 131 | returns @racket[eof]. Closes the @tech{socket} when it stops. Dies when the 132 | @tech{socket} closes. 133 | 134 | Commands: 135 | 136 | @itemlist[ 137 | @item{@racket['parser] -- returns @racket[prs]} 138 | @item{@racket['socket] -- returns a @tech{socket}} 139 | ] 140 | 141 | @examples[ 142 | #:eval neuron-evaluator 143 | #:label "Example:" 144 | (define dec ((decoder read) (string-socket #:in "123 abc"))) 145 | (recv dec) 146 | (recv dec) 147 | (recv dec) 148 | ] 149 | } 150 | 151 | @defproc[(encoder [prn printer/c]) codec/c]{ 152 | Returns a procedure that makes @tech{encoders} based on @racket[prn]: 153 | 154 | Takes and prints values to a @tech{socket}. Stops when it takes 155 | @racket[eof]. Closes the @tech{socket} when it stops. Dies when the 156 | @tech{socket} closes. 157 | 158 | Commands: 159 | 160 | @itemlist[ 161 | @item{@racket['printer] -- returns @racket[prn]} 162 | @item{@racket['socket] -- returns a @tech{socket}} 163 | ] 164 | 165 | @examples[ 166 | #:eval neuron-evaluator 167 | #:label "Example:" 168 | (define enc ((encoder writeln) (string-socket #:out #t))) 169 | (for-each (curry give enc) (list 123 'abc eof)) 170 | (get-output-string (enc 'socket)) 171 | ] 172 | } 173 | 174 | @defproc[(codec [prs parser/c] [prn printer/c]) codec/c]{ 175 | Returns a procedure that makes @tech{codecs} based on @racket[prs] and 176 | @racket[prn]: 177 | 178 | Takes and prints values to a @tech{socket}. Reads and emits values from a 179 | @tech{socket}. Stops when given @racket[eof] or @racket[prs] returns 180 | @racket[eof]. Closes the @tech{socket} when it stops. Dies when the 181 | @tech{socket} closes. 182 | 183 | Commands: 184 | 185 | @itemlist[ 186 | @item{@racket['decoder] -- returns a @tech{decoder} based on @racket[prs]} 187 | @item{@racket['encoder] -- returns an @tech{encoder} based on @racket[prn]} 188 | @item{@racket['socket] -- returns a @tech{socket}} 189 | ] 190 | 191 | @examples[ 192 | #:eval neuron-evaluator 193 | #:label "Example:" 194 | (define cdc ((codec read writeln) 195 | (string-socket #:in "123 abc" #:out #t))) 196 | (for-each (curry give cdc) (list 987 'zyx eof)) 197 | (recv cdc) 198 | (recv cdc) 199 | (recv cdc) 200 | (get-output-string (cdc 'socket)) 201 | ] 202 | } 203 | 204 | @subsection{Codec Types} 205 | 206 | A @deftech{codec type} is a set of uniformly-named procedures for making 207 | codecs and codec parts. A complete codec type named @var[name] is defined by 208 | the following procedures: 209 | 210 | @itemlist[ 211 | @item{@var[name]@racket[-parser] : @racket[parser/c]} 212 | @item{@var[name]@racket[-printer] : @racket[printer/c]} 213 | @item{@var[name]@racket[-decoder] : @racket[codec/c]} 214 | @item{@var[name]@racket[-encoder] : @racket[codec/c]} 215 | @item{@var[name]@racket[-codec] : @racket[codec/c]} 216 | ] 217 | 218 | @defproc[(make-codec-type [name symbol?] 219 | [prs parser/c] 220 | [prn printer/c]) 221 | (values codec/c 222 | codec/c 223 | codec/c)]{ 224 | Creates a new @tech{codec type}. The @racket[name] argument is used as the 225 | type name. 226 | 227 | The result of @racket[make-codec-type] is three values: 228 | 229 | @itemlist[ 230 | @item{a procedure that makes @tech{decoders} based on @racket[prs],} 231 | @item{a procedure that makes @tech{encoders} based on @racket[prn],} 232 | @item{a procedure that makes @tech{codecs} based on @racket[prs] and 233 | @racket[prn].} 234 | ] 235 | } 236 | 237 | @defform[(define-codec name prs prn)]{ 238 | Creates a new @tech{codec type} and binds variables related to the 239 | @tech{codec type}. 240 | 241 | A @racket[define-codec] form defines 5 names: 242 | 243 | @itemlist[ 244 | @item{@racket[name]@racketidfont{-parser}, an alias for @tech{parser} 245 | @racket[prs].} 246 | @item{@racket[name]@racketidfont{-printer}, an alias for @tech{printer} 247 | @racket[prn].} 248 | @item{@racket[name]@racketidfont{-decoder}, a procedure that makes 249 | @tech{decoders} based on @racket[prs].} 250 | @item{@racket[name]@racketidfont{-encoder}, a procedure that makes 251 | @tech{encoders} based on @racket[prn].} 252 | @item{@racket[name]@racketidfont{-codec}, a procedure that makes 253 | @tech{codecs} based on @racket[prs] and @racket[prn].} 254 | ] 255 | } 256 | 257 | @deftogether[( 258 | @defthing[#:kind "procedure" line-parser parser/c] 259 | @defthing[#:kind "procedure" line-printer printer/c] 260 | @defthing[#:kind "procedure" line-decoder codec/c] 261 | @defthing[#:kind "procedure" line-encoder codec/c] 262 | @defthing[#:kind "procedure" line-codec codec/c] 263 | )]{ 264 | Line @tech{codec type}. 265 | 266 | @examples[ 267 | #:eval neuron-evaluator 268 | #:label "Example:" 269 | (define cdc 270 | (line-codec 271 | (string-socket #:in "123 abc\n" #:out #t))) 272 | (give cdc "987 zyx") 273 | (recv cdc) 274 | (get-output-string (cdc 'socket)) 275 | ] 276 | } 277 | 278 | @deftogether[( 279 | @defthing[#:kind "procedure" sexp-parser parser/c] 280 | @defthing[#:kind "procedure" sexp-printer printer/c] 281 | @defthing[#:kind "procedure" sexp-decoder codec/c] 282 | @defthing[#:kind "procedure" sexp-encoder codec/c] 283 | @defthing[#:kind "procedure" sexp-codec codec/c] 284 | )]{ 285 | S-expression @tech{codec type}. 286 | 287 | @examples[ 288 | #:eval neuron-evaluator 289 | #:label "Example:" 290 | (define cdc 291 | (sexp-codec 292 | (string-socket #:in "(#hasheq((ab . 12)) 34)" #:out #t))) 293 | (give cdc (list 987 'zyx)) 294 | (recv cdc) 295 | (get-output-string (cdc 'socket)) 296 | ] 297 | } 298 | 299 | @deftogether[( 300 | @defthing[#:kind "procedure" json-parser parser/c] 301 | @defthing[#:kind "procedure" json-printer printer/c] 302 | @defthing[#:kind "procedure" json-decoder codec/c] 303 | @defthing[#:kind "procedure" json-encoder codec/c] 304 | @defthing[#:kind "procedure" json-codec codec/c] 305 | )]{ 306 | @other-doc['(lib "json/json.scrbl")] @tech{codec type}. 307 | 308 | To change how null is represented, set the @racket[json-null] parameter in 309 | the @other-doc['(lib "json/json.scrbl")] library. 310 | 311 | @examples[ 312 | #:eval neuron-evaluator 313 | #:label "Example:" 314 | (require json) 315 | (define cdc 316 | (parameterize ([json-null 'NULL]) 317 | (json-codec 318 | (string-socket #:in "[{\"ab\":12},34,null]" #:out #t)))) 319 | (give cdc '(98 #hasheq([zy . 76]) NULL)) 320 | (recv cdc) 321 | (get-output-string (cdc 'socket)) 322 | ] 323 | } 324 | 325 | @section{Network} 326 | 327 | @subsection{TCP} 328 | 329 | @(defmodule neuron/network/tcp) 330 | 331 | A @deftech{TCP socket} is a @tech{socket} with a TCP address. 332 | 333 | @defproc[(tcp-socket? [v any/c]) boolean?]{ 334 | Returns @racket[#t] if @racket[v] is a @tech{TCP socket}, @racket[#f] 335 | otherwise. 336 | } 337 | 338 | @defproc[(tcp-socket [in-port input-port?] 339 | [out-port output-port?]) tcp-socket?]{ 340 | Returns a @tech{TCP socket}. 341 | } 342 | 343 | @defproc[(tcp-socket-address [sock tcp-socket?]) (list/c string? port-number? 344 | string? port-number?)]{ 345 | Returns the address of @tech{TCP socket} @racket[sock]. 346 | } 347 | 348 | @defproc[(tcp-client [hostname string?] 349 | [port-no port-number?] 350 | [local-hostname (or/c string? #f) #f] 351 | [local-port-no (or/c port-number? #f) #f]) socket?]{ 352 | Establishes a TCP connection to @var[hostname]:@var[port-no]. Returns a 353 | @tech{TCP socket}. 354 | 355 | See @racket[tcp-connect] for argument details. 356 | } 357 | 358 | @defproc[(tcp-server [port-no listen-port-number?] 359 | [max-allow-wait exact-nonnegative-integer? 4] 360 | [reuse? any/c #f] 361 | [hostname (or/c string? #f) #f]) process?]{ 362 | Creates a ``listening'' TCP server on @var[hostname]:@var[port-no]. Returns 363 | a @racket[source] that emits a @tech{TCP socket} for each connection 364 | accepted. 365 | 366 | See @racket[tcp-listen] for argument details. 367 | 368 | Commands: 369 | 370 | @itemlist[ 371 | @item{@racket['address] -- returns @racket[(list hostname port-no)]} 372 | ] 373 | } 374 | 375 | @defproc[(tcp-service [make-codec codec/c] 376 | [srv process?] 377 | [#:on-accept on-accept (-> any/c process? any) void] 378 | [#:on-drop on-drop (-> any/c process? any) void]) 379 | process?]{ 380 | Returns a @racket[service] keyed by @tech{TCP socket} address. Applies 381 | @racket[make-codec] to each @tech{TCP socket} emitted by @racket[srv] and 382 | adds the resulting @tech{codec} to the service. When given @racket[(list 383 | addr v)], forwards @var[v] to @var[addr]. Emits @racket[(list addr v)] when 384 | @var[addr] emits @var[v]. Applies @racket[on-accept] to the @tech{codecs} 385 | made by @racket[make-codec] and their addresses. Applies @racket[on-drop] to 386 | each address--@tech{codec} pair it drops. Drops each @tech{codec} that dies. 387 | Drops every @tech{codec} when it stops. 388 | 389 | Commands: 390 | 391 | @itemlist[ 392 | @item{@racket['peers] -- returns a list of addresses} 393 | @item{@racket['get] @var[addr] -- returns the @tech{codec} associated with 394 | @var[addr], or @racket[#f] is no such @tech{codec} exists} 395 | @item{@racket['drop] @var[addr] -- disconnects the @tech{TCP socket} 396 | associated with @var[addr]; returns @racket[#t] if @var[addr] was in 397 | use, @racket[#f] otherwise} 398 | ] 399 | } 400 | 401 | @; @defproc[(udp-datagram-source [sock udp?]) process?]{ 402 | @; Emits each datagram received from @racket[sock] as a byte string. 403 | @; } 404 | 405 | @; @defproc[(udp-datagram-sink [sock udp?]) process?]{ 406 | @; Writes each given byte string to @racket[sock] as a datagram. Bytes strings 407 | @; of length exceeding 65,527 bytes, the maximum size of a UDP datagram 408 | @; payload, are truncated silently. 409 | @; } 410 | 411 | @; @defproc[(udp-datagram-stream [sock udp?]) process?]{ 412 | @; Returns a @racket[stream] process that combines a 413 | @; @racket[udp-datagram-source] and @racket[udp-datagram-sink]. 414 | @; } 415 | 416 | @; @defproc[(udp-source [prs parser/c]) process?]{ 417 | @; Listens for incoming UDP datagrams. Returns a @racket[source] process that 418 | @; applies @racket[prs] to each UDP datagram received and emits the result. 419 | @; } 420 | 421 | @; @defproc[(udp-sink [prn printer/c]) process?]{ 422 | @; Applies @racket[prn] to each value received and transmits the result as a 423 | @; UDP datagram. 424 | @; } 425 | 426 | @; @defproc[(udp-decoder [make-dec decoder/c]) process?]{ 427 | 428 | @; } 429 | -------------------------------------------------------------------------------- /neuron-lib/process/control.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | neuron/evaluation 5 | neuron/event 6 | neuron/process 7 | neuron/process/messaging 8 | neuron/syntax 9 | racket/contract/base 10 | racket/dict 11 | racket/function 12 | (only-in racket/list flatten make-list last) 13 | racket/match) 14 | 15 | (provide 16 | (contract-out 17 | [server (-> (-> any/c any/c) process?)] 18 | [proxy 19 | (->* (process?) 20 | (#:filter-to (or/c (-> any/c any/c) #f) 21 | #:filter-from (or/c (-> any/c any/c) #f)) 22 | process?)] 23 | [proxy-to 24 | (->* (process?) 25 | (#:with (or/c (-> any/c any/c) #f)) 26 | process?)] 27 | [proxy-from 28 | (->* (process?) 29 | (#:with (or/c (-> any/c any/c) #f)) 30 | process?)] 31 | [sink (-> (-> any/c any) process?)] 32 | [source (-> (-> any/c) process?)] 33 | [stream (-> process? process? process?)] 34 | [service 35 | (->* ((-> process? any/c)) 36 | (#:on-drop (-> any/c process? any)) 37 | process?)] 38 | [simulator (->* ((-> real? any)) (#:rate real?) process?)] 39 | [pipe (-> process? process? ... process?)] 40 | [bridge (-> process? process? process?)] 41 | [managed 42 | (->* (process?) 43 | (#:pre-take-eof (-> process? any) 44 | #:post-take-eof (-> process? any) 45 | #:pre-emit-eof (-> process? any) 46 | #:post-emit-eof (-> process? any)) 47 | process?)] 48 | [shutdown (-> process? void?)] 49 | [shutdown-evt (-> process? evt?)])) 50 | 51 | ;; Processes 52 | 53 | (define (server proc) 54 | (process (λ () (forever (emit (proc (take))))))) 55 | 56 | (define (proxy π #:filter-to [to-proc #f] #:filter-from [from-proc #f]) 57 | (start 58 | (process 59 | (λ () 60 | (define to-evt 61 | (if to-proc (filter-to-evt π #:with to-proc) (forward-to-evt π))) 62 | (define from-evt 63 | (if from-proc (filter-from-evt π #:with from-proc) (forward-from-evt π))) 64 | (sync 65 | (choice-evt 66 | (evt-loop (λ _ to-evt)) 67 | (evt-loop (λ _ from-evt)) 68 | (handle-evt π die))))) 69 | #:on-stop (λ () (stop π)))) 70 | 71 | (define (proxy-to π #:with [proc #f]) 72 | (start 73 | (process 74 | (λ () 75 | (define evt (if proc (filter-to-evt π #:with proc) (forward-to-evt π))) 76 | (sync (choice-evt 77 | (evt-loop (λ _ evt)) 78 | (handle-evt π die))))) 79 | #:on-stop (λ () (stop π)))) 80 | 81 | (define (proxy-from π #:with [proc #f]) 82 | (start 83 | (process 84 | (λ () 85 | (define evt 86 | (if proc (filter-from-evt π #:with proc) (forward-from-evt π))) 87 | (sync (choice-evt 88 | (evt-loop (λ _ evt)) 89 | (handle-evt π die))))) 90 | #:on-stop (λ () (stop π)))) 91 | 92 | (define (sink proc) 93 | (process (λ () (forever (proc (take)))))) 94 | 95 | (define (source proc) 96 | (process (λ () (forever (emit (proc)))))) 97 | 98 | (define (stream snk src) 99 | (start 100 | (process 101 | (λ () 102 | (sync 103 | (choice-evt 104 | (evt-loop (λ _ (forward-to-evt snk))) 105 | (evt-loop (λ _ (forward-from-evt src))) 106 | (handle-evt (evt-set snk src) die))))) 107 | #:on-stop (λ () (stop snk) (stop src)) 108 | #:command (bind 109 | ([sink snk] 110 | [source src]) 111 | #:else unhandled))) 112 | 113 | (define (service key-proc #:on-drop [on-drop void]) 114 | (define peers (make-hash)) 115 | (define latch (make-semaphore)) 116 | (define (add-peer π) 117 | (define key (key-proc π)) 118 | (hash-set! peers key π) 119 | (semaphore-post latch) 120 | key) 121 | (define (get-peer key) 122 | (hash-ref peers key #f)) 123 | (define (drop-peer key) 124 | (if (hash-has-key? peers key) 125 | (let ([π (hash-ref peers key)]) 126 | (hash-remove! peers key) 127 | (on-drop key π) 128 | (semaphore-post latch) 129 | #t) 130 | #f)) 131 | (start 132 | (process 133 | (λ () 134 | (define (peer-take-evt) 135 | (evt-series 136 | (λ _ (take-evt)) 137 | (match-lambda 138 | [(list key v) 139 | (if (hash-has-key? peers key) 140 | (handle-evt (give-evt (hash-ref peers key) v) (λ _ #t)) 141 | (handle-evt always-evt (λ _ #f)))] 142 | [_ (handle-evt always-evt (λ _ #f))]))) 143 | (define (peer-emit-evt key π) 144 | (replace-evt (recv-evt π) (λ (v) (emit-evt (list key v))))) 145 | (define (peer-emit-evts) 146 | (choice-evt 147 | latch 148 | (apply choice-evt 149 | (dict-map (hash->list peers) peer-emit-evt)))) 150 | (sync 151 | (evt-loop (λ _ (peer-take-evt))) 152 | (evt-loop (λ _ (peer-emit-evts)))))) 153 | #:on-stop (λ () (for-each drop-peer (dict-keys (hash->list peers)))) 154 | #:command (bind ([peers (hash->list peers)] 155 | [(add ,π) (add-peer π)] 156 | [(get ,key) (get-peer key)] 157 | [(drop ,key) (drop-peer key)]) 158 | #:else unhandled))) 159 | 160 | (define (simulator proc #:rate [rate 10]) 161 | (process 162 | (λ () 163 | (define period (/ 1000.0 rate)) 164 | (define timestamp (current-inexact-milliseconds)) 165 | (forever 166 | (set! timestamp (+ timestamp period)) 167 | (sync (alarm-evt timestamp)) 168 | (proc period))))) 169 | 170 | (define (pipe . πs) 171 | (start 172 | (process 173 | (λ () 174 | (sync 175 | (thread (λ () (forever (emit (foldl call (take) πs))))) 176 | (handle-evt (apply choice-evt πs) die)))) 177 | #:on-stop (λ () (for-each stop πs)))) 178 | 179 | (define (bridge π1 π2) 180 | (define (cmd π vs) 181 | (with-handlers ([unhandled-command? (λ _ unhandled)]) 182 | (apply π vs))) 183 | (start 184 | (process 185 | (λ () 186 | (sync 187 | (evt-loop (λ _ (couple-evt π1 π2))) 188 | (evt-loop (λ _ (couple-evt π2 π1))) 189 | (handle-evt (choice-evt π1 π2) die)))) 190 | #:on-stop (λ () (stop π1) (stop π2)) 191 | #:command (bind ([1 π1] 192 | [2 π2]) 193 | #:match 194 | ([v (let ([result (command π1 (list v))]) 195 | (if (eq? result unhandled) 196 | (command π2 (list v)) 197 | result))])))) 198 | 199 | (define (managed π 200 | #:pre-take-eof [pre-take-eof stop] 201 | #:post-take-eof [post-take-eof void] 202 | #:pre-emit-eof [pre-emit-eof void] 203 | #:post-emit-eof [post-emit-eof stop]) 204 | (start 205 | (process 206 | (λ () 207 | (sync 208 | (evt-loop 209 | (λ _ 210 | (evt-series 211 | (λ _ (take-evt)) 212 | (λ (v) 213 | (when (eof-object? v) (pre-take-eof π)) 214 | (handle-evt 215 | (give-evt π v) 216 | (λ _ (when (eof-object? v) (post-take-eof π)))))))) 217 | (evt-loop 218 | (λ _ 219 | (evt-series 220 | (λ _ (recv-evt π)) 221 | (λ (v) 222 | (when (eof-object? v) (pre-emit-eof π)) 223 | (handle-evt 224 | (emit-evt v) 225 | (λ _ (when (eof-object? v) (post-emit-eof π)))))))) 226 | (handle-evt π die)))) 227 | #:on-stop (λ () (stop π)) 228 | #:command π)) 229 | 230 | (define (shutdown π) 231 | (give π eof) 232 | (wait π)) 233 | 234 | (define (shutdown-evt π) 235 | (evt-sequence 236 | (λ () (give-evt π eof)) 237 | (λ () π))) 238 | 239 | (module+ test 240 | (require rackunit 241 | racket/async-channel) 242 | 243 | ;; Syntax 244 | 245 | (test-case 246 | "forever evaluates its body repeatedly." 247 | (define N 0) 248 | (define π 249 | (process (λ () (forever (set! N (+ N 1)) (when (> N 100) (die)))))) 250 | (wait π) 251 | (check > N 100)) 252 | 253 | (test-case 254 | "while evaluates its body for as long as expr evaluates to #t." 255 | (define count 0) 256 | (define π (process (λ () (while (<= count 100) (set! count (add1 count)))))) 257 | (wait π) 258 | (check > count 100)) 259 | 260 | (test-case 261 | "until evaluates its body for as long as expr evaluates to #f." 262 | (define count 0) 263 | (define π (process (λ () (until (> count 100) (set! count (add1 count)))))) 264 | (wait π) 265 | (check > count 100)) 266 | 267 | ;; Events 268 | 269 | (test-case 270 | "An evt-set is ready when every evt is ready." 271 | (define πs (for/list ([_ 10]) (process (λ () (take))))) 272 | (define evt (apply evt-set πs)) 273 | (for-each give πs) 274 | (check-false (not (sync evt)))) 275 | 276 | (test-case 277 | "An evt-set is not ready until every evt is ready." 278 | (define πs (for/list ([_ 10]) (process (λ () (take))))) 279 | (define evt (apply evt-set πs)) 280 | (for ([π πs]) 281 | (check-false (ormap (λ (π) (sync/timeout 0 π)) πs)) 282 | (check-false (sync/timeout 0 evt))) 283 | (for-each give πs) 284 | (for ([π πs]) 285 | (check-false (not (sync π)))) 286 | (check-false (not (sync evt)))) 287 | 288 | (test-case 289 | "An evt-set syncs to the list of results of evts." 290 | (define πs (for/list ([i 10]) (process (λ () (emit i))))) 291 | (define evt (apply evt-set (map recv-evt πs))) 292 | (check equal? (sync evt) '(0 1 2 3 4 5 6 7 8 9))) 293 | 294 | (test-case 295 | "An evt-sequence is ready when all generated events are ready." 296 | (check-false 297 | (not (sync (apply evt-sequence (make-list 10 (λ () (process void)))))))) 298 | 299 | (test-case 300 | "An evt-sequence is not ready until all generated events are ready." 301 | (define πs (for/list ([_ 10]) (process emit))) 302 | (define evt (apply evt-sequence (map (λ (π) (λ () π)) πs))) 303 | (for ([π πs]) 304 | (check-false (sync/timeout 0 π)) 305 | (check-false (sync/timeout 0 evt)) 306 | (recv π)) 307 | (check-false (not (sync evt)))) 308 | 309 | (test-case 310 | "An evt-sequence syncs on the results of make-evts in order." 311 | (define result null) 312 | (define (make-π i) 313 | (λ () (process (λ () (set! result (cons i result)))))) 314 | (sync (apply evt-sequence (for/list ([i 10]) (make-π i)))) 315 | (check equal? result '(9 8 7 6 5 4 3 2 1 0))) 316 | 317 | (test-case 318 | "An evt-sequence syncs to the same result as the last event generated." 319 | (define πs (for/list ([_ 10]) (process void))) 320 | (check eq? (sync (apply evt-sequence (map (λ (π) (λ () π)) πs))) (last πs))) 321 | 322 | (test-case 323 | "An evt-series is ready when all generated events are ready." 324 | (check-false 325 | (not (sync (apply evt-series (make-list 10 (λ _ (process void)))))))) 326 | 327 | (test-case 328 | "An evt-series is not ready until all generated events are ready." 329 | (define πs (for/list ([_ 10]) (process emit))) 330 | (define evt (apply evt-series (map (λ (π) (λ _ π)) πs))) 331 | (for ([π πs]) 332 | (check-false (sync/timeout 0 π)) 333 | (check-false (sync/timeout 0 evt)) 334 | (recv π)) 335 | (check-false (not (sync evt)))) 336 | 337 | (test-case 338 | "An evt-series syncs on the results of make-evts in order." 339 | (define result null) 340 | (define (make-π i) 341 | (λ _ (process (λ () (set! result (cons i result)))))) 342 | (sync (apply evt-series (for/list ([i 10]) (make-π i)))) 343 | (check equal? result '(9 8 7 6 5 4 3 2 1 0))) 344 | 345 | (test-case 346 | "An evt-series syncs to the same result as the last event generated." 347 | (define πs (for/list ([_ 10]) (process void))) 348 | (check eq? (sync (apply evt-series (map (λ (π) (λ _ π)) πs))) (last πs))) 349 | 350 | (test-case 351 | "An evt-series calls make-evt on the result of the previous event." 352 | (define (make-evt) 353 | (λ (i) (handle-evt always-evt (λ _ (+ i 1))))) 354 | (check = (sync (apply evt-series #:init 0 (for/list ([i 10]) (make-evt)))) 355 | 10)) 356 | 357 | (test-case 358 | "An evt-loop repeatedly syncs on the result of next-evt." 359 | (define (next-evt i) 360 | (handle-evt always-evt (λ _ (if (<= i 100) (+ i 1) (raise 19))))) 361 | (check = (with-handlers ([number? (λ (v) v)]) 362 | (sync (evt-loop #:init 0 next-evt))) 363 | 19)) 364 | 365 | ;; Processes 366 | 367 | (test-case 368 | "A server applies proc and emits the result." 369 | (define π (server add1)) 370 | (give π 23) 371 | (check = (recv π) 24)) 372 | 373 | (test-case 374 | "A proxy forwards to π." 375 | (define π (proxy (server (λ (x) (* x 2))))) 376 | (give π 37) 377 | (check = (recv π) 74)) 378 | 379 | (test-case 380 | "A proxy forwards from π." 381 | (define π (proxy (server (λ (x) (* x 2))))) 382 | (give π 43) 383 | (check = (recv π) 86)) 384 | 385 | (test-case 386 | "A proxy stops π when it stops." 387 | (define π (process deadlock)) 388 | (stop (proxy π)) 389 | (check-true (dead? π))) 390 | 391 | (test-case 392 | "A proxy dies when π dies." 393 | (define π (process deadlock)) 394 | (define π* (proxy π)) 395 | (kill π) 396 | (wait π*) 397 | (check-true (dead? π*))) 398 | 399 | (test-case 400 | "proxy with #:filter-to and #:filter-from" 401 | (define π (process (λ () (emit 4) (check = (take) 9)))) 402 | (define π* (proxy π #:filter-to sub1 #:filter-from (curry * 3))) 403 | (check = (recv π*) 12) 404 | (check-true (give π* 10))) 405 | 406 | (test-case 407 | "A proxy-to forwards to π." 408 | (define π (server add1)) 409 | (define to-π (proxy-to π)) 410 | (for ([i 10]) 411 | (check-true (give to-π i)) 412 | (check = (recv π) (add1 i)))) 413 | 414 | (test-case 415 | "A proxy-to does not forward from π." 416 | (define π (server add1)) 417 | (define to-π (proxy-to π)) 418 | (for ([i 10]) 419 | (give to-π i) 420 | (check-false (sync/timeout 0 (recv-evt to-π))) 421 | (check = (recv π) (add1 i)))) 422 | 423 | (test-case 424 | "A proxy-to stops π when it stops." 425 | (define π (server add1)) 426 | (define to-π (proxy-to π)) 427 | (check-pred alive? π) 428 | (check-pred alive? to-π) 429 | (stop to-π) 430 | (check-pred dead? to-π) 431 | (check-pred dead? π)) 432 | 433 | (test-case 434 | "A proxy-to dies when π dies." 435 | (define π (server add1)) 436 | (define to-π (proxy-to π)) 437 | (check-pred alive? π) 438 | (check-pred alive? to-π) 439 | (kill π) 440 | (check-pred dead? π) 441 | (wait to-π) 442 | (check-pred dead? to-π)) 443 | 444 | (test-case 445 | "proxy-to #:with filter" 446 | (define π (process (λ () (check = (take) 6)))) 447 | (check-true (give (proxy-to π #:with (curry * 3)) 2))) 448 | 449 | (test-case 450 | "A proxy-from does not forward to π." 451 | (define π (server add1)) 452 | (define from-π (proxy-from π)) 453 | (for ([i 10]) 454 | (check-false (sync/timeout 0 (give-evt from-π i))))) 455 | 456 | (test-case 457 | "A proxy-from forwards from π." 458 | (define π (server add1)) 459 | (define from-π (proxy-from π)) 460 | (for ([i 10]) 461 | (check-true (give π i)) 462 | (check = (recv from-π) (add1 i)))) 463 | 464 | (test-case 465 | "A proxy-from stops π when it stops." 466 | (define π (server add1)) 467 | (define from-π (proxy-from π)) 468 | (check-pred alive? π) 469 | (check-pred alive? from-π) 470 | (stop from-π) 471 | (check-pred dead? from-π) 472 | (check-pred dead? π)) 473 | 474 | (test-case 475 | "A proxy-from dies when π dies." 476 | (define π (server add1)) 477 | (define from-π (proxy-from π)) 478 | (check-pred alive? π) 479 | (check-pred alive? from-π) 480 | (kill π) 481 | (check-pred dead? π) 482 | (wait from-π) 483 | (check-pred dead? from-π)) 484 | 485 | (test-case 486 | "proxy-from #:with filter" 487 | (define π (process (λ () (emit 3)))) 488 | (check = (recv (proxy-from π #:with (curry * 4))) 12)) 489 | 490 | (test-case 491 | "A sink applies proc to each value taken." 492 | (define last -1) 493 | (define π (sink (λ (n) (check = n (+ last 1)) (set! last n)))) 494 | (for ([i 10]) (give π i))) 495 | 496 | (test-case 497 | "A sink ignores the result of proc." 498 | (define π (sink add1)) 499 | (give π 31) 500 | (check-false (sync/timeout 0 (recv-evt π)))) 501 | 502 | (test-case 503 | "A source applies proc repeatedly and emits each result." 504 | (define N -1) 505 | (define π (source (λ () (set! N (+ N 1)) N))) 506 | (for ([i 10]) (check = (recv π) i))) 507 | 508 | (test-case 509 | "A stream forwards to snk." 510 | (define result-ch (make-channel)) 511 | (define π (stream (sink (curry channel-put result-ch)) (source void))) 512 | (for ([i 10]) 513 | (give π i) 514 | (check = (channel-get result-ch) i))) 515 | 516 | (test-case 517 | "A stream forwards from src." 518 | (define π (stream (sink void) (source random))) 519 | (for ([_ 10]) 520 | (define v (recv π)) 521 | (check >= v 0) 522 | (check <= v 1))) 523 | 524 | (test-case 525 | "A stream stops snk and src when it stops." 526 | (define ch (make-async-channel)) 527 | (define π 528 | (stream 529 | (start (sink deadlock) #:on-stop (λ () (async-channel-put ch #t))) 530 | (start (source deadlock) #:on-stop (λ () (async-channel-put ch #t))))) 531 | (stop π) 532 | (check-true (async-channel-get ch)) 533 | (check-true (async-channel-get ch))) 534 | 535 | (test-case 536 | "A stream dies when snk and src die." 537 | (define snk (sink deadlock)) 538 | (define src (source deadlock)) 539 | (define sock (stream snk src)) 540 | (kill snk) 541 | (kill src) 542 | (wait sock) 543 | (check-true (dead? sock))) 544 | 545 | (test-case 546 | "A stream does not die when snk dies if src is alive." 547 | (define snk (sink deadlock)) 548 | (define src (source deadlock)) 549 | (define sock (stream snk src)) 550 | (kill snk) 551 | (check-true (alive? src)) 552 | (check-false (dead? sock))) 553 | 554 | (test-case 555 | "A stream does not die when src dies if snk is alive." 556 | (define snk (sink deadlock)) 557 | (define src (source deadlock)) 558 | (define sock (stream snk src)) 559 | (kill src) 560 | (check-true (alive? snk)) 561 | (check-false (dead? sock))) 562 | 563 | (test-case 564 | "The stream command 'sink returns snk." 565 | (define snk (sink deadlock)) 566 | (define sock (stream snk (source deadlock))) 567 | (check eq? (sock 'sink) snk)) 568 | 569 | (test-case 570 | "The stream command 'source returns src." 571 | (define src (source deadlock)) 572 | (define sock (stream (sink deadlock) src)) 573 | (check eq? (sock 'source) src)) 574 | 575 | (test-case 576 | "A simulator calls proc at a frequency of rate." 577 | (define N 0) 578 | (define t0 (current-inexact-milliseconds)) 579 | (wait (simulator (λ _ (set! N (+ N 1)) (when (= N 10) (die))) #:rate 100)) 580 | (define t10 (current-inexact-milliseconds)) 581 | (check = N 10) 582 | (check >= (- t10 t0) 100)) 583 | 584 | (test-case 585 | "A pipe calls πs in series." 586 | (define π (apply pipe (for/list ([_ 10]) (server add1)))) 587 | (give π 49) 588 | (check = (recv π) 59)) 589 | 590 | (test-case 591 | "A pipe stops all πs when it stops." 592 | (define πs (for/list ([_ 10]) (process deadlock))) 593 | (stop (apply pipe πs)) 594 | (for ([π πs]) (check-true (dead? π)))) 595 | 596 | (test-case 597 | "A pipe dies when any π dies." 598 | (for ([i 3]) 599 | (define πs (for/list ([_ 3]) (process deadlock))) 600 | (define p (apply pipe πs)) 601 | (kill (list-ref πs i)) 602 | (wait p) 603 | (check-true (dead? p)))) 604 | 605 | (test-case 606 | "A bridge forwards from π1 to π2, and vice versa." 607 | (wait 608 | (bridge 609 | (process (λ () (emit 51) (check = (take) 53))) 610 | (process (λ () (check = (take) 51) (emit 53)))))) 611 | 612 | (test-case 613 | "A bridge stops π1 and π2 when it stops." 614 | (define π1 (process deadlock)) 615 | (define π2 (process deadlock)) 616 | (stop (bridge π1 π2)) 617 | (check-true (dead? π1)) 618 | (check-true (dead? π2))) 619 | 620 | (test-case 621 | "A bridge dies when π1 dies." 622 | (define π1 (process deadlock)) 623 | (define π (bridge π1 (process deadlock))) 624 | (kill π1) 625 | (wait π) 626 | (check-true (dead? π))) 627 | 628 | (test-case 629 | "A bridge dies when π2 dies." 630 | (define π2 (process deadlock)) 631 | (define π (bridge (process deadlock) π2)) 632 | (kill π2) 633 | (wait π) 634 | (check-true (dead? π))) 635 | 636 | (test-case 637 | "bridge command 1 returns π1." 638 | (define π1 (process deadlock)) 639 | (define π2 (process deadlock)) 640 | (check equal? π1 ((bridge π1 π2) 1))) 641 | 642 | (test-case 643 | "bridge command 2 return π2." 644 | (define π1 (process deadlock)) 645 | (define π2 (process deadlock)) 646 | (check equal? π2 ((bridge π1 π2) 2))) 647 | 648 | (test-case 649 | "A bridge forwards unhandled commands to π1 first." 650 | (define π 651 | (bridge (start (process deadlock) #:command add1) 652 | (process deadlock))) 653 | (check-pred process? (π 1)) 654 | (check = 4 (π 3))) 655 | 656 | (test-case 657 | "A bridge forwards unhandled commands to π2 when π1 fails." 658 | (define π 659 | (bridge (process deadlock) 660 | (start (process deadlock) #:command sub1))) 661 | (check-pred process? (π 2)) 662 | (check = 2 (π 3))) 663 | 664 | (test-case 665 | "A bridge raises unhandled-command when π1 and π2 both fail." 666 | (define π 667 | (bridge (process deadlock) 668 | (process deadlock))) 669 | (check-exn unhandled-command? (λ () (π 3)))) 670 | 671 | (test-case 672 | "A managed process forwards non-eof values to and from π." 673 | (check = (call (managed (server add1)) 57) 58)) 674 | 675 | (test-case 676 | "A managed process calls pre-take-eof before eof is given." 677 | (define π (managed (server add1))) 678 | (give π eof) 679 | (wait π) 680 | (check-true (dead? π))) 681 | 682 | (test-case 683 | "A managed process calls post-emit-eof after π emits eof." 684 | (define π (managed (process (λ () (emit eof) (deadlock))))) 685 | (recv π) 686 | (wait π) 687 | (check-true (dead? π))) 688 | 689 | (test-case 690 | "A managed process stops π when it stops." 691 | (define stopped #f) 692 | (stop (managed (start (process deadlock) 693 | #:on-stop (λ () (set! stopped #t))))) 694 | (check-true stopped)) 695 | 696 | (test-case 697 | "A managed process dies when π dies." 698 | (define π (process deadlock)) 699 | (define π* (managed π)) 700 | (kill π) 701 | (wait π*) 702 | (check-pred dead? π*)) 703 | 704 | (test-case 705 | "A managed process forwards commands to π." 706 | (define π (start (process deadlock) #:command add1)) 707 | (check = ((managed π) 59) 60)) 708 | 709 | (test-case 710 | "shutdown gives eof to π and blocks until it dies." 711 | (define π (process (λ () (check-true (eof-object? (take)))))) 712 | (shutdown π) 713 | (check-true (dead? π))) 714 | 715 | (test-case 716 | "shutdown-evt returns a synchronizable event." 717 | (check-pred evt? (shutdown-evt (process deadlock)))) 718 | 719 | (test-case 720 | "shutdown-evt gives eof to π and syncs when π dies." 721 | (define π (process (λ () (check-pred eof-object? (take))))) 722 | (sync (shutdown-evt π)) 723 | (check-pred dead? π)) 724 | 725 | (test-case 726 | "shutdown-evt syncs to π." 727 | (define π (managed (process deadlock))) 728 | (check eq? (sync (shutdown-evt π)) π))) 729 | -------------------------------------------------------------------------------- /neuron-doc/scribblings/reference/concurrency.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require "../base.rkt") 4 | 5 | @title{Concurrency} 6 | 7 | @section{Syntax} 8 | 9 | @(defmodule neuron/syntax) 10 | 11 | @defform[(forever body ...)]{ 12 | 13 | Evaluates @var[body]s repeatedly. 14 | 15 | } 16 | 17 | @defform[(while expr body ...)]{ 18 | 19 | Evaluates @var[body]s repeatedly for as long as @var[expr] evaluates to 20 | @racket[#t]. 21 | 22 | } 23 | 24 | @defform[(until expr body ...)]{ 25 | 26 | Evaluates @var[body]s repeatedly for as long as @var[expr] evalutes to 27 | @racket[#f]. 28 | 29 | } 30 | 31 | @defform[(apply-values proc expr)]{ 32 | 33 | Evaluates @var[expr] and then applies @var[proc] to the resulting values. 34 | 35 | @examples[ 36 | #:eval neuron-evaluator 37 | #:label "Example:" 38 | (apply-values list (values 1 2 3)) 39 | ] 40 | } 41 | 42 | @section{Exchanger} 43 | 44 | @margin-note{@secref{The Neuron Technical Report} explains the difference 45 | between exchangers and @rtech{channels}.} 46 | 47 | @(defmodule neuron/exchanger) 48 | 49 | An @deftech{exchanger} is a @rtech{channel}-based primitive that both 50 | synchronizes a pair of threads and passes a value from one to the other. 51 | Exchangers are synchronous, fair, and support multiple senders and receivers, 52 | but can not be used as @rtech{synchronizable events} directly. 53 | 54 | @; In any exchange, one thread puts a value and another thread get it. The 55 | @; @racket[channel-get] and @racket[channel-put] operations model this data flow 56 | @; explicitly. Unfortunately, channels offer no way to tell which side initiates 57 | @; the exchange. Exchangers enable this ability by making the initiating side 58 | @; provide the channel for the exchange. 59 | 60 | The participants of an exchange can be characterized by two orthogonal 61 | factors: control flow and data flow. In an exchange, one side waits for the 62 | other to initiate. If the initiating side is transmitting, then the waiting 63 | side is receiving. Similarly, if the initiating side is receiving, then the 64 | waiting side is transmitting. With this distinction, forwarding exchangers 65 | with precise control flow semantics can be defined. 66 | 67 | @defproc[(exchanger? [v any/c]) boolean?]{ 68 | 69 | Returns @racket[#t] if @racket[v] is an @tech{exchanger}, @racket[#f] 70 | otherwise. 71 | 72 | } 73 | 74 | @defproc[(make-exchanger) exchanger?]{ 75 | 76 | Creates and returns a new exchanger. 77 | 78 | } 79 | 80 | @defproc[(offer [ex1 exchanger?] [#:to ex2 exchanger?]) void?]{ 81 | 82 | Blocks until @var[ex2] is ready to accept @var[ex1]. 83 | 84 | } 85 | 86 | @defproc[(accept [#:from ex exchanger?]) exchanger?]{ 87 | 88 | Blocks until an exchanger is offered to @var[ex]. 89 | 90 | } 91 | 92 | @defproc[(put [v any/c] [#:into ex exchanger?]) void?]{ 93 | 94 | Blocks until an exchanger is ready to get @var[v] from @var[ex]. 95 | 96 | } 97 | 98 | @defproc[(get [#:from ex exchanger?]) any/c]{ 99 | 100 | Blocks until an exchanger puts a value into @var[ex]. 101 | 102 | } 103 | 104 | @subsection{Process Exchangers} 105 | 106 | @(defmodule neuron/process/exchanger) 107 | 108 | @defproc[(giver [tx exchanger?] [rx exchanger?] [v any/c]) void?]{ 109 | 110 | Offers @var[tx] to @var[rx], then puts @var[v] into @var[tx]. 111 | 112 | } 113 | 114 | @defproc[(taker [rx exchanger?]) any/c]{ 115 | 116 | Gets a value from an exchanger accepted from @var[rx]. 117 | 118 | } 119 | 120 | @defproc[(receiver [rx exchanger?] [tx exchanger?]) any/c]{ 121 | 122 | Offers @var[rx] to @var[tx], then gets a value from @var[rx]. 123 | 124 | } 125 | 126 | @defproc[(emitter [tx exchanger?] [v any/c]) void?]{ 127 | 128 | Puts @var[v] into an exchanger accepted from @var[tx]. 129 | 130 | } 131 | 132 | @defproc[(forwarder [ex1 exchanger?] [ex2 exchanger?]) void?]{ 133 | 134 | Offers an exchanger accepted from @var[ex1] to @var[ex2]. 135 | 136 | } 137 | 138 | @defproc[ 139 | (filterer [ex1 exchanger?] 140 | [ex2 exchanger?] 141 | [#:with proc (-> any/c any/c)]) 142 | void? 143 | ]{ 144 | 145 | Forwards a value from @var[ex1] to @var[ex2]. Applies @var[proc] to the 146 | value being forwarded. 147 | 148 | } 149 | 150 | @defproc[ 151 | (coupler [rx exchanger?] [tx exchanger?] [ex exchanger? (make-exchanger)]) 152 | void? 153 | ]{ 154 | 155 | Offers @var[ex] to @var[rx] and @var[tx]. 156 | 157 | } 158 | 159 | @defproc[(giver-evt [tx exchanger?] [rx exchanger?] [v any/c]) evt?]{ 160 | 161 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 162 | synchronization} when @racket[(giver #,(var tx) #,(var rx) #,(var v))] would 163 | not block. 164 | 165 | } 166 | 167 | @defproc[(taker-evt [rx exchanger?]) evt?]{ 168 | 169 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 170 | for synchronization} when @racket[(taker #,(var rx))] would not block, and 171 | the @rtech{synchronization result} is the value taken through @var[rx]. 172 | 173 | } 174 | 175 | @defproc[(receiver-evt [rx exchanger?] [tx exchanger?]) evt?]{ 176 | 177 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 178 | for synchronization} when @racket[(receiver #,(var rx) #,(var tx))] would 179 | not block, and the @rtech{synchronization result} is the value received 180 | through @var[rx]. 181 | 182 | } 183 | 184 | @defproc[(emitter-evt [tx exchanger?] [v any/c]) evt?]{ 185 | 186 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 187 | synchronization} when @racket[(emitter #,(var tx) #,(var v))] would not 188 | block. 189 | 190 | } 191 | 192 | @defproc[(forwarder-evt [ex1 exchanger?] [ex2 exchanger?]) evt?]{ 193 | 194 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 195 | for synchronization} when @racket[(forwarder #,(var ex1) #,(var ex2))] would 196 | not block. 197 | 198 | } 199 | 200 | @defproc[ 201 | (filterer-evt [ex1 exchanger?] 202 | [ex2 exchanger?] 203 | [#:with proc (-> any/c any/c)]) 204 | evt? 205 | ]{ 206 | 207 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 208 | for synchronization} when @racket[(filterer #,(var ex1) #,(var ex2) #:with 209 | #,(var proc))] would not block. 210 | 211 | } 212 | 213 | @defproc[ 214 | (coupler-evt [rx exchanger?] [tx exchanger?] [ex exchanger? (make-exchanger)]) 215 | evt? 216 | ]{ 217 | 218 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 219 | for synchronization} when @racket[(coupler #,(var rx) #,(var tx) #,(var 220 | ex))] would not block. 221 | 222 | } 223 | 224 | @section{Event} 225 | 226 | @(defmodule neuron/event) 227 | 228 | @defproc[(evt-set [evt evt?] ...) evt?]{ 229 | 230 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 231 | synchronization} when all @var[evt]s are @rtech{ready for synchronization}. 232 | The @rtech{synchronization result} is a list of the @rtech{synchronization 233 | results} of @var[evt]s in the order specified. 234 | 235 | @examples[ 236 | #:eval neuron-evaluator 237 | #:label "Example:" 238 | (sync 239 | (evt-set 240 | (wrap-evt (thread (λ () (sleep 0.1) (write 1))) (λ _ 1)) 241 | (wrap-evt (thread (λ () (write 2))) (λ _ 2)))) 242 | ] 243 | } 244 | 245 | @defproc[ 246 | (evt-sequence [make-evt (-> evt?)] ...+ 247 | [#:then make-result (-> any/c any) values]) 248 | evt? 249 | ]{ 250 | 251 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 252 | synchronization} when all events generated by @var[make-evt]s are 253 | @rtech{ready for synchronization}. Calls each @var[make-evt] in the order 254 | specified and immediately @racket[sync]s the result. Wtaps the last 255 | @var[make-evt] in a @racket[handle-evt] that applies the 256 | @rtech{synchronization result} of the previous event to @var[make-result]. 257 | The @rtech{synchronization result} of the sequence is the 258 | @rtech{synchronization result} of its final event. 259 | 260 | @examples[ 261 | #:eval neuron-evaluator 262 | #:label "Example:" 263 | (sync 264 | (evt-sequence 265 | (λ () (wrap-evt (thread (λ () (sleep 0.1) (write 1))) (λ _ 1))) 266 | (λ () (wrap-evt (thread (λ () (write 2))) (λ _ 2))))) 267 | ] 268 | } 269 | 270 | @defproc[ 271 | (evt-series [#:init init any/c (void)] 272 | [make-evt (-> any/c evt?)] ...+ 273 | [#:then make-result (-> any/c any) values]) 274 | evt? 275 | ]{ 276 | 277 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 278 | synchronization} when all events generated by @var[make-evt]s have become 279 | @rtech{ready for synchronization}. Calls each @var[make-evt] in the order 280 | specified and immediately @racket[sync]s the result. Applies @var[make-evt] 281 | first to @var[init], then to the @rtech{synchronization result} of the 282 | previous event. Wraps the last @var[make-evt] in a @racket[handle-evt] that 283 | applies the @rtech{synchronization result} of the previous event to 284 | @var[make-result]. The @rtech{synchronization result} of the series is the 285 | @rtech{synchronization result} of its final event. 286 | 287 | @examples[ 288 | #:eval neuron-evaluator 289 | #:label "Example:" 290 | (sync 291 | (evt-series 292 | #:init 1 293 | (λ (x) (wrap-evt (thread (λ () (write x))) (λ _ (+ x 2)))) 294 | (λ (x) (wrap-evt (thread (λ () (write x))) (λ _ (+ x 4)))))) 295 | ] 296 | } 297 | 298 | @defproc[ 299 | (evt-loop [#:init init any/c (void)] 300 | [next-evt (-> any/c evt?)]) evt? 301 | ]{ 302 | 303 | Returns a fresh @rtech{synchronizable event} that is never @rtech{ready for 304 | synchronization}. Repeatedly calls @var[next-evt] and immediately 305 | @racket[sync]s the result. Applies @var[next-evt] first to @var[init], then 306 | to the @rtech{synchronization result} of the previous event. 307 | 308 | @examples[ 309 | #:eval neuron-evaluator 310 | #:label "Example:" 311 | (eval:error 312 | (sync 313 | (evt-loop 314 | #:init 1 315 | (λ (x) 316 | (if (> x 5) 317 | (raise x) 318 | (wrap-evt always-evt (λ _ (+ x 1)))))))) 319 | ] 320 | } 321 | 322 | @section{Process} 323 | 324 | @(defmodule neuron/process) 325 | 326 | A @deftech{process} is a @rtech{thread}-like concurrency primitive. Processes 327 | are made from @rtech{threads} by replacing the @seclink["threadmbox" #:doc 328 | '(lib "scribblings/reference/reference.scrbl")]{thread mailbox} with a few 329 | other features: 330 | 331 | @itemlist[ 332 | @item{A pair of @tech{exchangers}: one for transmitting and another for 333 | receiving.} 334 | @item{An out-of-band @tech{command handler}.} 335 | @item{An @deftech{on-stop hook} that is called when a process ends 336 | gracefully, but not when it dies abruptly.} 337 | @item{An @deftech{on-dead hook} that is called unconditionally when a 338 | process terminates.} 339 | ] 340 | 341 | A process can be applied as a procedure, which invokes its @deftech{command 342 | handler}, or @deftech{handler}. The @tech{command handler} is a list of 343 | procedures, and the result of a command is the same as the result of the first 344 | procedure in the list to return a value other than @racket[unhandled]. If 345 | every procedure returns @racket[unhandled] or the list is empty, 346 | @racket[unhandled-command] is raised. 347 | 348 | @examples[ 349 | #:eval neuron-evaluator 350 | #:label #f 351 | (define π 352 | (start 353 | (process deadlock) 354 | #:command (bind ([A 1] 355 | [B (λ _ 2)]) 356 | #:else unhandled))) 357 | (π 'A) 358 | ((π 'B) 5) 359 | (eval:error (π '(x y))) 360 | ] 361 | 362 | A process can be used as a @rtech{synchronizable event}. A process is 363 | @rtech{ready for synchronization} when @racket[dead?] would return 364 | @racket[#t]. The synchronization result is the process itself. 365 | 366 | Unhandled exceptions are fatal. Attempting to synchronize a process killed by 367 | an unhandled exception re-raises the exception. 368 | 369 | @examples[ 370 | #:eval neuron-evaluator 371 | #:label #f 372 | (eval:error (sync (process (λ () (raise 'VAL))))) 373 | ] 374 | 375 | Processes are created explicitly by the @racket[process] function. Use 376 | @racket[start] to install hooks and handlers. 377 | 378 | @defthing[unhandled symbol?]{ 379 | 380 | Return this value from a @tech{command handler} to indicate that it will not 381 | handle a command. 382 | 383 | } 384 | 385 | @defstruct*[ 386 | unhandled-command ([process process?] 387 | [args (listof any/c)]) #:transparent 388 | ]{ 389 | 390 | Raised when a @tech{command handler} applied to @var[args] returns 391 | @racket[unhandled]. 392 | 393 | } 394 | 395 | @defproc[(process? [v any/c]) boolean?]{ 396 | 397 | Returns @racket[#t] if @var[v] is a @tech{process}, @racket[#f] otherwise. 398 | 399 | } 400 | 401 | @defproc[(process [thunk (-> any)]) process?]{ 402 | 403 | Calls @var[thunk] with no arguments in a new @tech{process}. Returns 404 | immediately with a @deftech{process descriptor} value. 405 | 406 | } 407 | 408 | @defproc[(process-tx [π process?]) transmitter?]{ 409 | 410 | Returns the transmitting @tech{exchanger} of @var[π]. 411 | 412 | } 413 | 414 | @defproc[(process-rx [π process?]) transmitter?]{ 415 | 416 | Returns the receiving @tech{exchanger} of @var[π]. 417 | 418 | } 419 | 420 | @defform[ 421 | (start π-expr hooks-and-handlers ...) 422 | #:grammar 423 | [(hooks-and-handlers 424 | (code:line #:on-stop on-stop) 425 | (code:line #:on-dead on-dead) 426 | (code:line #:command handler))] 427 | ]{ 428 | 429 | Installs @var[hooks-and-handlers] into all processes created in the 430 | lexical scope of @var[π-expr]. 431 | 432 | @examples[ 433 | #:eval neuron-evaluator 434 | #:label "Example:" 435 | (define π 436 | (start 437 | (process deadlock) 438 | #:on-stop (λ () (displayln 'STOP1)) 439 | #:on-dead (λ () (displayln 'DEAD1)) 440 | #:on-stop (λ () (displayln 'STOP2)) 441 | #:on-dead (λ () (displayln 'DEAD2)) 442 | #:command add1)) 443 | (π 1) 444 | (stop π) 445 | ] 446 | } 447 | 448 | @defproc[(command [π process?] [v any/c] ...) any]{ 449 | 450 | Applies the @tech{command handler} of @var[π] to @var[v]s and returns the 451 | result. Does not raise @racket[unhandled-command] if the result is 452 | @racket[unhandled]. 453 | 454 | } 455 | 456 | @defproc[(stop [π process?]) void?]{ 457 | 458 | Gracefully terminates the execution of @var[π] if it is running. Blocks 459 | until @var[π] is dead. If @var[π] is already dead, @racket[stop] has no 460 | effect. 461 | 462 | } 463 | 464 | @defproc[(kill [π process?]) void?]{ 465 | 466 | Immediately terminates the execution of @var[π] if it is running. Blocks 467 | until @var[π] is dead. If @var[π] is already dead, @racket[kill] has no 468 | effect. 469 | 470 | } 471 | 472 | @defproc[(wait [π process?]) void? #:value (void (sync π))]{ 473 | 474 | Blocks until @var[π] is @rtech{ready for synchronization}. 475 | 476 | } 477 | 478 | @defproc[(dead? [π process?]) boolean?]{ 479 | 480 | Returns @racket[#t] if @var[π] has terminated, @racket[#f] otherwise. 481 | 482 | } 483 | 484 | @defproc[(alive? [π process?]) boolean?]{ 485 | 486 | Returns @racket[#t] if @var[π] is not dead, @racket[#f] otherwise. 487 | 488 | } 489 | 490 | @defproc[(current-process) process?]{ 491 | 492 | Returns the @tech{process descriptor} for the currently executing process. 493 | 494 | } 495 | 496 | @defproc[(quit [v any/c] ...) void?]{ 497 | 498 | Gracefully terminates the current process, ignoring any arguments. 499 | 500 | } 501 | 502 | @defproc[(die [v any/c] ...) void?]{ 503 | 504 | Immediately terminates the current process, ignoring any arguments. 505 | 506 | } 507 | 508 | @defproc[(deadlock [v any/c] ...) void?]{ 509 | 510 | Hangs the current process, ignoring any arguments. 511 | 512 | } 513 | 514 | @section{Messaging} 515 | 516 | @(defmodule neuron/process/messaging) 517 | 518 | @defproc[(give [π process?] [v any/c (void)]) boolean?]{ 519 | 520 | Blocks until @var[π] is ready to accept @var[v] on its receiving 521 | @tech{exchanger}, or until @var[π] is dead. Returns @racket[#t] if @var[π] 522 | accepted @var[v], @racket[#f] otherwise. 523 | 524 | } 525 | 526 | @defproc[(take) any/c]{ 527 | 528 | Blocks until a sender is ready to provide a value on the receiving 529 | @tech{exchanger} of the current process. Returns the provided value. 530 | 531 | } 532 | 533 | @defproc[(recv [π process?]) any/c]{ 534 | 535 | Blocks until @var[π] is ready to provide a value through its transmitting 536 | @tech{exchanger}, or until @var[π] is dead. Returns the provided value, or 537 | @racket[eof] if @var[π] died. 538 | 539 | } 540 | 541 | @defproc[(emit [v any/c (void)]) void?]{ 542 | 543 | Blocks until a receiver is ready to accept the value @var[v] through the 544 | transmitting @tech{exchanger} of the current process. 545 | 546 | } 547 | 548 | @defproc[(call [π process?] [v any/c (void)]) any/c]{ 549 | 550 | Gives @var[v] to @var[π] and then immediately @racket[recv]s from @var[π]. 551 | Returns the received value. 552 | 553 | } 554 | 555 | @defproc[(forward-to [π process?]) void?]{ 556 | 557 | Takes a value and gives it to @var[π]. 558 | 559 | } 560 | 561 | @defproc[(forward-from [π process?]) void?]{ 562 | 563 | Emits a value received from @var[π]. 564 | 565 | } 566 | 567 | @defproc[(filter-to [π process?] [#:with proc (-> any/c any/c)]) void?]{ 568 | 569 | Takes a value, applies @var[proc] to it, and gives the result to @var[π]. 570 | 571 | } 572 | 573 | @defproc[(filter-from [π process?] [#:with proc (-> any/c any/c)]) void?]{ 574 | 575 | Receives a value from @var[π], applies @var[proc] to it, and emits the 576 | result. 577 | 578 | } 579 | 580 | @defproc[(couple [π1 process?] [π2 process?]) void?]{ 581 | 582 | Receives a value from @var[π1] and gives it to @var[π2]. 583 | 584 | } 585 | 586 | @defproc[(give-evt [π process?] [v any/c (void)]) evt?]{ 587 | 588 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 589 | synchronization} when @var[π] is ready to accept the value @var[v] on its 590 | receiving @tech{exchanger}, or until @var[π] is dead. The 591 | @rtech{synchronization result} is @racket[#t] if @var[π] accepted @var[v], 592 | @racket[#f] otherwise. 593 | 594 | } 595 | 596 | @defproc[(take-evt) evt?]{ 597 | 598 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 599 | for synchronization} when a sender is ready to provide a value on the 600 | receiving @tech{exchanger} of the current process. The 601 | @rtech{synchronization result} is the provided value. 602 | 603 | } 604 | 605 | @defproc[(recv-evt [π process?]) evt?]{ 606 | 607 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 608 | for synchronization} when @var[π] is ready to provide a value through its 609 | transmitting @tech{exchanger}, or until @var[π] is dead. The 610 | @rtech{synchronization result} is the provided value or @racket[eof]. 611 | 612 | } 613 | 614 | @defproc[(emit-evt [v any/c (void)]) evt?]{ 615 | 616 | Returns a fresh @rtech{synchronizable event} that becomes @rtech{ready for 617 | synchronization} when a receiver is ready to accept the value @var[v] 618 | through the transmitting @tech{exchanger} of the current process. 619 | 620 | } 621 | 622 | @defproc[(forward-to-evt [π process?]) evt?]{ 623 | 624 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 625 | for synchronization} when a value has been taken and then given to 626 | @var[π]. 627 | 628 | } 629 | 630 | @defproc[(forward-from-evt [π process?]) evt?]{ 631 | 632 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 633 | for synchronization} when a value has been received from @var[π] and then 634 | emitted. 635 | 636 | } 637 | 638 | @defproc[(filter-to-evt [π process?] [#:with proc (-> any/c any/c)]) evt?]{ 639 | 640 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 641 | for synchronization} when @racket[(filter-to #,(var π) #:with #,(var proc))] 642 | would not block. 643 | 644 | } 645 | 646 | @defproc[(filter-from-evt [π process?] [#:with proc (-> any/c any/c)]) evt?]{ 647 | 648 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 649 | for synchronization} when @racket[(filter-from #,(var π) #:with #,(var 650 | proc))] would not block. 651 | 652 | } 653 | 654 | @defproc[(couple-evt [π1 process?] [π2 process?]) void?]{ 655 | 656 | Returns a constant @rtech{synchronizable event} that becomes @rtech{ready 657 | for synchronization} when a value has been received from @var[π1] and then 658 | given to @var[π2]. 659 | 660 | } 661 | 662 | @section{Control} 663 | 664 | @(defmodule neuron/process/control) 665 | 666 | @defproc[(server [proc (-> any/c any/c)]) process?]{ 667 | 668 | Applies @var[proc] to each value taken and then emits the result. 669 | 670 | @examples[ 671 | #:eval neuron-evaluator 672 | #:label "Example:" 673 | (define π (server add1)) 674 | (call π 1) 675 | (call π -1) 676 | ] 677 | } 678 | 679 | @defproc[ 680 | (proxy [π process?] 681 | [#:filter-to to-proc (or/c (-> any/c any/c) #f) #f] 682 | [#:filter-from from-proc (or/c (-> any/c any/c) #f) #f]) 683 | process? 684 | ]{ 685 | 686 | Forwards values to and from @var[π]. Filters taken values with @var[to-proc] 687 | when not @racket[#f]. Filters emitted values with @var[from-proc] when not 688 | @racket[#f]. Stops @var[π] when it stops. Dies when @var[π] dies. 689 | 690 | @examples[ 691 | #:eval neuron-evaluator 692 | #:label "Example:" 693 | (call (proxy (server (curry * 3))) 2) 694 | ] 695 | } 696 | 697 | @defproc[ 698 | (proxy-to [π process?] 699 | [#:with proc (or/c (-> any/c any/c) #f) #f]) 700 | process? 701 | ]{ 702 | 703 | Gives all values taken to @var[π]. Filters taken values with @var[proc] when 704 | not @racket[#f]. Stops @var[π] when it stops. Dies when @var[π] dies. 705 | 706 | } 707 | 708 | @defproc[ 709 | (proxy-from [π process?] 710 | [#:with proc (or/c (-> any/c any/c) #f) #f]) 711 | process? 712 | ]{ 713 | 714 | Emits all values emitted by @var[π]. Filters emitted values with @var[proc] 715 | when not @racket[#f]. Stops @var[π] when it stops. Dies when @var[π] dies. 716 | 717 | } 718 | 719 | @defproc[(sink [proc (-> any/c any)]) process?]{ 720 | 721 | Applies @var[proc] to each value taken and ignores the result. 722 | 723 | @examples[ 724 | #:eval neuron-evaluator 725 | #:label "Example:" 726 | (define i 0) 727 | (define π (sink (λ (x) (set! i (+ i x))))) 728 | (give π 1) 729 | (give π 2) 730 | i 731 | ] 732 | } 733 | 734 | @defproc[(source [proc (-> any/c)]) process?]{ 735 | 736 | Calls @var[proc] repeatedly and emits each result. 737 | 738 | @examples[ 739 | #:eval neuron-evaluator 740 | #:label "Example:" 741 | (define π (source random)) 742 | (recv π) 743 | (recv π) 744 | ] 745 | } 746 | 747 | @defproc[(stream [snk process?] [src process?]) process?]{ 748 | 749 | Forwards to @var[snk] and from @var[src]. Stops @var[snk] and @var[src] when 750 | it stops. Dies when both @var[snk] and @var[src] die. 751 | 752 | Commands: 753 | @itemlist[ 754 | @item{@racket['sink] -- returns @var[snk]} 755 | @item{@racket['source] -- returns @var[src]} 756 | ] 757 | 758 | @examples[ 759 | #:eval neuron-evaluator 760 | #:label "Example:" 761 | (define π-out (server add1)) 762 | (define π-in (sink (λ (x) (give π-out (* x 2))))) 763 | (call (stream π-in π-out) 3) 764 | ] 765 | } 766 | 767 | @defproc[ 768 | (service [key-proc (-> process? any/c)] 769 | [#:on-drop on-drop (-> any/c process? any) void]) 770 | process? 771 | ]{ 772 | 773 | Associates processes to keys generated by @var[key-proc]. When given 774 | @racket[(list #,(var key) #,(var v))], forwards @var[v] to the 775 | @tech{process} associated with @var[key]. Emits @racket[(list #,(var key) 776 | #,(var v))] when the @tech{process} associated with @var[key] emits @var[v]. 777 | Applies @var[on-drop] to each key--@tech{process} pair it drops. Drops each 778 | @tech{process} that dies. Drops every @tech{process} when it stops. 779 | 780 | Commands: 781 | 782 | @itemlist[ 783 | @item{@racket['peers] -- returns an alist of active peers} 784 | @item{@racket['add] @var[π] -- adds @tech{process} @var[π] to the set of 785 | active peers; returns the key associated with @var[π]} 786 | @item{@racket['get] @var[key] -- returns the @tech{process} associated 787 | with @var[key], or @racket[#f] if no such @tech{process} exists} 788 | @item{@racket['drop] @var[key] -- drops the @tech{process} associated with 789 | @var[key]; returns @racket[#t] if @var[key] was in use, @racket[#f] 790 | otherwise.} 791 | ] 792 | 793 | @examples[ 794 | #:eval neuron-evaluator 795 | #:label "Example:" 796 | (define times 797 | (let ([N -1]) 798 | (service 799 | (λ _ (set! N (add1 N)) N) 800 | #:on-drop (λ (k _) (displayln `(STOP ,k)))))) 801 | (for ([i 10]) 802 | (times `(add ,(server (curry * i))))) 803 | (writeln 804 | (for/list ([i 10]) 805 | (call times (list i 3)))) 806 | (for ([i 10] #:when (even? i)) 807 | (times `(drop ,i))) 808 | (writeln 809 | (for/list ([i 10] #:when (odd? i)) 810 | (call times (list i 4)))) 811 | (stop times) 812 | ] 813 | } 814 | 815 | @defproc[(simulator [proc (-> real? any)] [#:rate rate real? 10]) process?]{ 816 | 817 | Repeatedly calls @var[proc] at a frequency of up to @var[rate] times per 818 | second. Applies @var[proc] to the period corresponding to @var[rate] in 819 | milliseconds. 820 | 821 | @examples[ 822 | #:eval neuron-evaluator 823 | #:label "Example:" 824 | (define i 0) 825 | (define t (current-inexact-milliseconds)) 826 | (wait 827 | (simulator 828 | (λ (p) 829 | (printf "~a ~a\n" p (- (current-inexact-milliseconds) t)) 830 | (when (> i 2) (die)) 831 | (set! i (add1 i)) 832 | (sleep 0.25)))) 833 | ] 834 | } 835 | 836 | @defproc[(pipe [π process?] ...+) process?]{ 837 | 838 | Calls @var[π]s in series, implicitly starting with @racket[take] and ending 839 | with @racket[emit]. Stops all @var[π]s when it stops. Dies when any @var[π] 840 | dies. 841 | 842 | @examples[ 843 | #:eval neuron-evaluator 844 | #:label "Example:" 845 | (define π 846 | (pipe 847 | (server add1) 848 | (server (curry * 3)) 849 | (server sub1))) 850 | (call π 2) 851 | ] 852 | } 853 | 854 | @defproc[(bridge [π1 process?] [π2 process?]) process?]{ 855 | 856 | Forwards from @var[π1] to @var[π2], and vice versa. Stops @var[π1] and 857 | @var[π2] when it stops. Dies when @var[π1] or @var[π2] die. 858 | 859 | A bridge will attempt to forward unrecognized commands---first to 860 | @var[π1], then to @var[π2]---before raising 861 | @racket[unhandled-command]. 862 | 863 | @examples[ 864 | #:eval neuron-evaluator 865 | #:label "Example:" 866 | (wait 867 | (bridge 868 | (server add1) 869 | (process (λ () (emit 1) (writeln (take)))))) 870 | ] 871 | } 872 | 873 | @defproc[(managed [π process?]) process?]{ 874 | 875 | Forwards non-@racket[eof] values to and from @var[π]. Stops @var[π] when it 876 | stops. Dies when @var[π] dies. 877 | 878 | @examples[ 879 | #:eval neuron-evaluator 880 | #:label "Example:" 881 | (define π (managed (server add1))) 882 | (call π 1) 883 | (shutdown π) 884 | (dead? π) 885 | ] 886 | } 887 | 888 | @defproc[(shutdown [π process?]) void?]{ 889 | 890 | Gives @racket[eof] to @var[π] and blocks until it dies. 891 | 892 | } 893 | 894 | @defproc[(shutdown-evt [π process?]) evt?]{ 895 | 896 | Gives @racket[eof] to @var[π] and returns a @rtech{synchronizable event} 897 | that becomes @rtech{ready for synchronization} when @var[π] dies. The 898 | @rtech{synchronization result} is @var[π]. 899 | 900 | } 901 | --------------------------------------------------------------------------------