67 lines
2.2 KiB
Racket
67 lines
2.2 KiB
Racket
#lang racket/base
|
|
;; Relaying of inbound and outbound assertions between adjacent dataspaces.
|
|
|
|
(provide (struct-out inbound)
|
|
(struct-out outbound)
|
|
inbound*
|
|
outbound*
|
|
inbound**
|
|
outbound**
|
|
uninbound**
|
|
unoutbound**
|
|
spawn-standard-relay)
|
|
|
|
(require racket/match)
|
|
(require "../trie.rkt")
|
|
(require "../relay.rkt")
|
|
|
|
(struct inbound (assertion) #:prefab)
|
|
(struct outbound (assertion) #:prefab)
|
|
|
|
(define (inbound** n x) (if (zero? n) x (inbound (inbound** (- n 1) x))))
|
|
(define (outbound** n x) (if (zero? n) x (outbound (outbound** (- n 1) x))))
|
|
|
|
(define (uninbound** n x) (cond [(zero? n) (values #t x)]
|
|
[(inbound? x) (uninbound** (- n 1) (inbound-assertion x))]
|
|
[else (values #f #f)]))
|
|
(define (unoutbound** n x) (cond [(zero? n) (values #t x)]
|
|
[(outbound? x) (unoutbound** (- n 1) (outbound-assertion x))]
|
|
[else (values #f #f)]))
|
|
|
|
(define-match-expander inbound*
|
|
(syntax-rules () [(_ n x) (app (lambda (v) (uninbound** n v)) #t x)])
|
|
(syntax-rules () [(_ n x) (inbound** n x)]))
|
|
(define-match-expander outbound*
|
|
(syntax-rules () [(_ n x) (app (lambda (v) (unoutbound** n v)) #t x)])
|
|
(syntax-rules () [(_ n x) (outbound** n x)]))
|
|
|
|
(define inbound-parenthesis (open-parenthesis 1 struct:inbound))
|
|
(define outbound-parenthesis (open-parenthesis 1 struct:outbound))
|
|
|
|
(define (spawn-standard-relay inner-spawn)
|
|
(spawn-relay outbound?
|
|
outbound-assertion
|
|
outbound-parenthesis
|
|
inbound
|
|
inbound-parenthesis
|
|
inner-spawn))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
|
|
(define (i* v)
|
|
(match v
|
|
[(inbound* 0 'hi) 'hi0]
|
|
[(inbound* 1 'hi) 'hi1]
|
|
[(inbound* 2 'there) 'there2]
|
|
[(inbound* 2 'hi) 'hi2]
|
|
[(inbound* 3 'hi) 'hi3]
|
|
[other (list 'other other)]))
|
|
|
|
(check-equal? (i* (inbound* 2 'hi)) 'hi2)
|
|
(check-equal? (i* (inbound* 2 'there)) 'there2)
|
|
(check-equal? (i* 'hi) 'hi0)
|
|
(check-equal? (i* 'there) (list 'other 'there)))
|