Forge non-existent generic functions like write-proc

Closes PR 13014

collects/racket/private/generic-interfaces.rkt

@@ -31,6 +31,11 @@
                                  v)))
      (list (cons prop:equal+hash vector->list))))
 
+  ;; forgeries of generic functions that don't exist
+  (define (equal-proc a b e) (equal? a b))
+  (define (hash-proc x h)  (equal-hash-code x))
+  (define (hash2-proc x h) (equal-secondary-hash-code x))
+
   (define-syntax gen:equal+hash
     (list (quote-syntax prop:gen:equal+hash)
           (quote-syntax equal-proc)
@@ -52,6 +57,14 @@
                                  v)))
      (list (cons prop:custom-write (lambda (v) (vector-ref v 0))))))
 
+  ;; see above for equal+hash
+  (define (write-proc v p w)
+    (case w
+      [(#t) (write v p)]
+      [(#f) (display v p)]
+      [(0 1) (print v p w)]
+      [else (error 'write-proc "internal error; should not happen")]))
+
   (define-syntax gen:custom-write
     (list (quote-syntax prop:gen:custom-write)
           (quote-syntax write-proc)))

collects/tests/generic/base-interfaces.rkt

@@ -0,0 +1,28 @@
+#lang racket/base
+
+;; Test the existence of forged generic functions for
+;; gen:custom-write and gen:equal+hash
+
+(require racket/generic)
+
+(struct tuple (ref)
+  #:methods gen:custom-write
+  [(define/generic super write-proc)
+   (define (write-proc v p w)
+     (super v p w))]
+  #:methods gen:equal+hash
+  [(define/generic super-eq equal-proc)
+   (define/generic hash1 hash-proc)
+   (define/generic hash2 hash2-proc)
+   (define (equal-proc a b e)
+     (super-eq (tuple-ref a) (tuple-ref b) e))
+   (define (hash-proc a h)
+     (hash1 (tuple-ref a) h))
+   (define (hash2-proc a h)
+     (hash2 (tuple-ref a) h))])
+
+;; ok if these don't raise unbound id errors
+(write (tuple 5))
+(equal? (tuple 5) (tuple 5))
+(equal-hash-code (tuple 5))
+(equal-secondary-hash-code (tuple 5))

collects/tests/generic/tests.rkt

@@ -8,5 +8,6 @@
          (submod "struct-form.rkt" test)
          (submod "equal+hash.rkt" test)
          (submod "custom-write.rkt" test)
+         "base-interfaces.rkt"
          "contract.rkt"
          "from-unstable.rkt")