fixup rackets

This commit is contained in:
Milo 2020-01-30 18:09:05 -05:00
parent 2ba395aad1
commit 64ebb92ead
1 changed files with 29 additions and 31 deletions

View File

@ -2,7 +2,7 @@
(require racket/struct) (require racket/struct)
(provide peer subnet (provide (struct-out peer) (struct-out subnet)
string->ip string->ip
ip->string ip->string
string->subnet string->subnet
@ -10,45 +10,43 @@
string->peer) string->peer)
(struct peer [ip type] (struct peer [ip type]
#:methods gen:custom-write #:methods gen:custom-write
[(define write-proc [(define write-proc
(make-constructor-style-printer (make-constructor-style-printer
(lambda (x) 'peer) (lambda (x) 'peer)
(lambda (x) (list (ip->string (peer-ip x)) (peer-type x)))))]) (lambda (x) (list (ip->string (peer-ip x)) (peer-type x)))))])
(struct subnet [ip mask] (struct subnet [ip mask]
#:methods gen:custom-write #:methods gen:custom-write
[(define write-proc [(define write-proc
(make-constructor-style-printer (make-constructor-style-printer
(lambda (x) 'subnet) (lambda (x) 'subnet)
(lambda (x) (list (subnet->string x)))))]) (lambda (x) (list (subnet->string x)))))])
(define (string->ip str) (define (string->ip str)
(let ([parts (reverse (string-split str "."))]) (define parts (reverse (string-split str ".")))
(for/sum ([i (in-range 4)] (for/sum ([part (in-list parts)]
[part parts]) [i (in-naturals)])
(arithmetic-shift (string->number part) (* i 8))))) (arithmetic-shift (string->number part)
(* i 8))))
(define (ip->string ip) (define (ip->string ip)
(string-join (define parts
(reverse (reverse (for/list ([i (in-range 4)])
(for/list ([i (in-range 4)]) (number->string (bitwise-and (arithmetic-shift ip (* i -8))
(number->string (bitwise-and 255)))))
(arithmetic-shift ip (* i -8)) 255)))) (string-join parts "."))
"."))
(define (string->subnet str) (define (string->subnet str)
(match (string-split str "/") (match-define (list ipstr maskstr) (string-split str "/"))
[(list ipstr maskstr) (subnet (string->ip ipstr) (subnet (string->ip ipstr)
(string->number maskstr))])) (string->number maskstr)))
(define (subnet->string sub) (define (subnet->string sub)
(string-append (format "~a/~a"
(ip->string (subnet-ip sub)) (subnet-ip sub)
"/" (subnet-mask sub)))
(number->string (subnet-mask sub))))
(define (string->peer str) (define (string->peer str)
(match (string-split str "-") (match-define (list ip type) (string-split str "-"))
[(list ip type) (peer (string->ip ip) (string->symbol type)))
(peer (string->ip ip) (string->symbol type))]))