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

inbound* and outbound* are now match-expanders

This commit is contained in:
Tony Garnock-Jones 2016-07-30 14:14:09 -04:00
parent 07eb91b0d9
commit c7dae47210
1 changed files with 40 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
racket/syndicate/protocol/standard-relay.rkt
View File

@ -5,16 +5,35 @@
(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 (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))
@ -26,3 +45,22 @@
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)))