adjust hole structs to print better while still

preserving proper equality

fix 1384d2d277
This commit is contained in:
Robby Findler 2013-06-30 05:21:36 -05:00
parent a8731609f1
commit ee780a20b4

View File

@ -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?)))