41 lines
1.4 KiB
Racket
41 lines
1.4 KiB
Racket
|
#lang racket/base
|
||
|
|
;; Untyped struct definitions required to interoperate with marketplace's struct-map
|
||
|
|
;; See also Racket PR 13593.
|
||
|
|
|
||
|
|
(require marketplace/struct-map)
|
||
|
|
|
||
|
|
(provide (struct-out domain))
|
||
|
|
|
||
|
|
;; (These utilities need to be defined ahead of the domain struct
|
||
|
|
;; definition.)
|
||
|
|
(define (domain=? a b recursive-equal?)
|
||
|
|
(recursive-equal? (domain-downcased-labels a)
|
||
|
|
(domain-downcased-labels b)))
|
||
|
|
|
||
|
|
(define (domain-hash-1/2 d recursive-hash)
|
||
|
|
(recursive-hash (domain-downcased-labels d)))
|
||
|
|
|
||
|
|
(struct domain (labels downcased-labels)
|
||
|
|
#:transparent
|
||
|
|
#:property prop:equal+hash (list domain=? domain-hash-1/2 domain-hash-1/2)
|
||
|
|
#:property prop:struct-map (lambda (f seed x)
|
||
|
|
(let-values (((labels seed) (f (domain-labels x) seed)))
|
||
|
|
(values (make-domain labels) seed))))
|
||
|
|
|
||
|
|
;; ListOf<Bytes> -> ListOf<Bytes>
|
||
|
|
;; Converts the 7-bit ASCII bytes in the argument to lower-case
|
||
|
|
;; equivalents. Used to normalize case for domain-name comparisons.
|
||
|
|
(define (downcase-labels labels)
|
||
|
|
(for/list ([label labels])
|
||
|
|
(define b (make-bytes (bytes-length label)))
|
||
|
|
(for ([i (bytes-length label)])
|
||
|
|
(define v (bytes-ref label i))
|
||
|
|
(bytes-set! b i (if (<= 65 v 90) (+ 32 v) v)))
|
||
|
|
b))
|
||
|
|
|
||
|
|
;; ListOf<Bytes> -> DomainName
|
||
|
|
;; Replacement constructor for domain structs. Automatically downcases
|
||
|
|
;; labels appropriately.
|
||
|
|
(define (make-domain labels)
|
||
|
|
(domain labels (downcase-labels labels)))
|