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