Use matcher-key-set/single and set-first

This commit is contained in:
Tony Garnock-Jones 2014-06-17 17:01:22 -04:00
parent c5530c7b9c
commit ccc5775f00
2 changed files with 13 additions and 14 deletions

View File

@ -122,15 +122,14 @@
(compile-gestalt-projection (ethernet-packet (ethernet-interface interface-name (?!)) ? ? ? ? ?))) (compile-gestalt-projection (ethernet-packet (ethernet-interface interface-name (?!)) ? ? ? ? ?)))
(define (gestalt->hwaddr g interface-name) (define (gestalt->hwaddr g interface-name)
(define hwaddrs (matcher-key-set (gestalt-project g 0 0 #t (hwaddr-projection interface-name)))) (define hwaddrs
(match (set->list hwaddrs) (matcher-key-set/single (gestalt-project g 0 0 #t (hwaddr-projection interface-name))))
['() #f] (case (set-count hwaddrs)
[(list (list h)) h] [(0) #f]
[(and hs (list* (list h) _)) [(1) (set-first hwaddrs)]
(log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v" [else
interface-name (log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v" interface-name hwaddrs)
hs) (set-first hwaddrs)]))
h]))
(define (ethernet-packet-pattern interface-name from-wire? ethertype) (define (ethernet-packet-pattern interface-name from-wire? ethertype)
(ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?)) (ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))

10
ip.rkt
View File

@ -141,13 +141,13 @@
(match e (match e
[(routing-update g) [(routing-update g)
(define all-results (define all-results
(set->list (matcher-key-set (gestalt-project g 0 0 #t arp-result-projection)))) (matcher-key-set/single (gestalt-project g 0 0 #t arp-result-projection)))
(match all-results (match all-results
[#f (error 'ip "Someone has published a wildcard arp result")] [#f (error 'ip "Someone has published a wildcard arp result")]
['() ;; no results yet, keep waiting [(? set-empty?) #f] ;; no results yet, keep waiting
#f] [_
[(list* (list remote-hwaddr) rest) (define remote-hwaddr (set-first all-results))
(unless (null? rest) (unless (= 1 (set-count all-results))
(log-warning "Ambiguous arp result for ~a: ~v" (log-warning "Ambiguous arp result for ~a: ~v"
(ip-address->hostname remote-ip) (ip-address->hostname remote-ip)
all-results)) all-results))