Add gen:custom-write.

No docs yet.

collects/racket/struct.rkt

@@ -26,8 +26,31 @@
    (list (cons prop:equal+hash vector->list))))
 
 (define-generics (equal+hash gen:equal+hash prop:gen:equal+hash equal+hash?
-                             #:defined-table dummy
+                             #:defined-table equal+hash-def-table
                              #:prop-defined-already? gen:equal+hash-acc)
   (equal-proc equal+hash rhs equal?/recur)
   (hash-proc  equal+hash equal-hash-code/recur)
   (hash2-proc equal+hash equal-secondary-hash-code/recur))
+
+
+(provide gen:custom-write)
+
+(define-values (prop:gen:custom-write gen:custom-write? gen:custom-write-acc)
+  (make-struct-type-property
+   'prop:gen:custom-write
+   (lambda (v si)
+     (unless (and (vector? v)
+                  (= 1 (vector-length v))
+                  (procedure? (vector-ref v 0))
+                  (procedure-arity-includes? (vector-ref v 0) 3))
+       (raise-type-error 'guard-for-prop:gen:custom-write
+                         "vector of one procedure (arity 3)"
+                         v))
+     v)
+   (list (cons prop:custom-write (lambda (v) (vector-ref v 0))))))
+
+(define-generics (custom-write gen:custom-write prop:gen:custom-write
+                               gen:custom-write?
+                               #:defined-table custom-write-def-table
+                               #:prop-defined-already? gen:custom-write-acc)
+  (write-proc custom-write port mode))

collects/tests/generics/custom-write.rkt

@@ -0,0 +1,22 @@
+#lang racket
+
+(require racket/struct)
+
+(struct loud (v)
+        #:methods gen:custom-write
+        [(define (write-proc x port mode)
+           (displayln "writing!" port)
+           (case mode
+             [(#t) (write (loud-v x) port)]
+             [(#f) (display (loud-v x) port)]
+             [else (print (loud-v x) port mode)]))])
+
+(module+ test
+ (require rackunit)
+
+ (check-equal? (with-output-to-string (lambda () (write (loud 1))))
+               "writing!\n1")
+ (check-equal? (with-output-to-string (lambda () (display (loud 1))))
+               "writing!\n1")
+ (check-equal? (with-output-to-string (lambda () (print (loud 1))))
+               "writing!\n1"))

collects/tests/generics/tests.rkt

@@ -7,4 +7,5 @@
          (submod "iterator.rkt" test)
          (submod "struct-form.rkt" test)
          (submod "equal+hash.rkt" test)
+         (submod "custom-write.rkt" test)
          "from-unstable.rkt")