diff --git a/pkgs/redex/private/lang-struct.rkt b/pkgs/redex/private/lang-struct.rkt index 9a4605df18..9428c59c76 100644 --- a/pkgs/redex/private/lang-struct.rkt +++ b/pkgs/redex/private/lang-struct.rkt @@ -14,16 +14,23 @@ (define-struct rhs (pattern) #:transparent) (define-values (the-hole the-not-hole hole?) (let () - (define-struct hole () - #:property prop:equal+hash (list (λ (x y recur) #t) (λ (v recur) 255) (λ (v recur) 65535)) + (struct hole (which) + #:property prop:equal+hash (list (λ (x y recur) #t) + (λ (v recur) 255) + (λ (v recur) 65535)) + #:methods gen:custom-write + [(define (write-proc a-hole port mode) + (define str (if (equal? (hole-which a-hole) 'the-hole) + "hole" + "not-hole")) + (cond + [(or (equal? mode 0) (equal? mode 1)) + (write-string str port)] + [else + (write-string "#<" port) + (write-string str port) + (write-string ">" port)]))] #:inspector #f) - (define-struct not-hole () - #:property prop:equal+hash (list (λ (x y recur) #t) (λ (v recur) 254) (λ (v recur) 65534)) - #:inspector #f) - (define the-hole (make-hole)) - (define the-not-hole (make-not-hole)) - (define -hole? - (let ([hole? - (λ (x) (or (hole? x) (not-hole? x)))]) - hole?)) - (values the-hole the-not-hole -hole?))) + (define the-hole (hole 'the-hole)) + (define the-not-hole (hole 'the-not-hole)) + (values the-hole the-not-hole hole?)))