diff --git a/collects/data/gvector.rkt b/collects/data/gvector.rkt index 6a315fc5d6..140c68bdda 100644 --- a/collects/data/gvector.rkt +++ b/collects/data/gvector.rkt @@ -4,8 +4,7 @@ unstable/wrapc) racket/contract/base racket/dict - racket/vector - racket/struct) + racket/vector) (define (make-gvector #:capacity [capacity 10]) (gvector (make-vector capacity #f) 0)) diff --git a/collects/racket/main.rkt b/collects/racket/main.rkt index eb9dba86da..71a6329147 100644 --- a/collects/racket/main.rkt +++ b/collects/racket/main.rkt @@ -27,7 +27,6 @@ racket/promise racket/bool racket/stream - racket/struct racket/sequence racket/local racket/system @@ -60,7 +59,6 @@ racket/promise racket/bool racket/stream - racket/struct racket/sequence racket/local racket/system) diff --git a/collects/racket/private/base.rkt b/collects/racket/private/base.rkt index fa33ec15fb..1c842b8a5e 100644 --- a/collects/racket/private/base.rkt +++ b/collects/racket/private/base.rkt @@ -11,6 +11,7 @@ "struct.rkt" "cert.rkt" "submodule.rkt" + "generic-interfaces.rkt" (for-syntax "stxcase-scheme.rkt")) (#%provide (all-from-except "pre-base.rkt" @@ -36,6 +37,7 @@ (all-from "namespace.rkt") (all-from "cert.rkt") (all-from "submodule.rkt") + (all-from "generic-interfaces.rkt") (for-syntax syntax-rules syntax-id-rules ... _) (rename -open-input-file open-input-file) (rename -open-output-file open-output-file) diff --git a/collects/racket/private/dict.rkt b/collects/racket/private/dict.rkt index e189e8ff7a..c15bb11bc0 100644 --- a/collects/racket/private/dict.rkt +++ b/collects/racket/private/dict.rkt @@ -1,7 +1,6 @@ #lang racket/base (require racket/private/generics ; to avoid circular dependencies - racket/struct (for-syntax racket/base)) (define-generics (dict gen:dict prop:dict dict? #:defined-table dict-def-table diff --git a/collects/racket/private/generic-interfaces.rkt b/collects/racket/private/generic-interfaces.rkt new file mode 100644 index 0000000000..5394ae50ee --- /dev/null +++ b/collects/racket/private/generic-interfaces.rkt @@ -0,0 +1,56 @@ +(module generic-interfaces "pre-base.rkt" + + ;; Defines (forgeries of) generic interfaces that correspond to struct + ;; properties that come from racket/base. + ;; Since racket/base can't depend on racket/generics, we can't use + ;; `define-generics' to build these generic interfaces. Thus we must + ;; forge them. + + (#%require (for-syntax '#%kernel)) + + (#%provide gen:equal+hash gen:custom-write) + + (define-values (prop:gen:equal+hash equal+hash? gen:equal+hash-acc) + (make-struct-type-property + 'prop:gen:equal+hash + (lambda (v si) + (if (and (vector? v) + (= 3 (vector-length v)) + (procedure? (vector-ref v 0)) + (procedure-arity-includes? (vector-ref v 0) 3) + (procedure? (vector-ref v 1)) + (procedure-arity-includes? (vector-ref v 1) 2) + (procedure? (vector-ref v 2)) + (procedure-arity-includes? (vector-ref v 2) 2)) + v + (raise-type-error 'guard-for-prop:gen:equal+hash + "vector of three procedures (arities 3, 2, 2)" + v))) + (list (cons prop:equal+hash vector->list)))) + + (define-syntax gen:equal+hash + (list (quote-syntax prop:gen:equal+hash) + (quote-syntax equal-proc) + (quote-syntax hash-proc) + (quote-syntax hash2-proc))) + + + (define-values (prop:gen:custom-write gen:custom-write? gen:custom-write-acc) + (make-struct-type-property + 'prop:gen:custom-write + (lambda (v si) + (if (and (vector? v) + (= 1 (vector-length v)) + (procedure? (vector-ref v 0)) + (procedure-arity-includes? (vector-ref v 0) 3)) + v + (raise-type-error 'guard-for-prop:gen:custom-write + "vector of one procedure (arity 3)" + v))) + (list (cons prop:custom-write (lambda (v) (vector-ref v 0)))))) + + (define-syntax gen:custom-write + (list (quote-syntax prop:gen:custom-write) + (quote-syntax write-proc))) + + ) diff --git a/collects/racket/struct.rkt b/collects/racket/struct.rkt deleted file mode 100644 index 1069aa54cc..0000000000 --- a/collects/racket/struct.rkt +++ /dev/null @@ -1,56 +0,0 @@ -#lang racket/base - -;; Provides generic interfaces that correspond to struct properties -;; that live in racket/base - -(require racket/private/generics) - -(provide gen:equal+hash) - -(define-values (prop:gen:equal+hash equal+hash? gen:equal+hash-acc) - (make-struct-type-property - 'prop:gen:equal+hash - (lambda (v si) - (unless (and (vector? v) - (= 3 (vector-length v)) - (procedure? (vector-ref v 0)) - (procedure-arity-includes? (vector-ref v 0) 3) - (procedure? (vector-ref v 1)) - (procedure-arity-includes? (vector-ref v 1) 2) - (procedure? (vector-ref v 2)) - (procedure-arity-includes? (vector-ref v 2) 2)) - (raise-type-error 'guard-for-prop:gen:equal+hash - "vector of three procedures (arities 3, 2, 2)" - v)) - v) - (list (cons prop:equal+hash vector->list)))) - -(define-generics (equal+hash gen:equal+hash prop:gen:equal+hash equal+hash? - #: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)) diff --git a/collects/scribblings/reference/booleans.scrbl b/collects/scribblings/reference/booleans.scrbl index 037f5a94b9..84436bc143 100644 --- a/collects/scribblings/reference/booleans.scrbl +++ b/collects/scribblings/reference/booleans.scrbl @@ -4,9 +4,6 @@ @(define bool-eval (make-base-eval)) @(bool-eval '(require racket/bool)) -@(define struct-eval (make-base-eval)) -@(struct-eval '(require racket/struct)) - @title[#:tag "booleans"]{Booleans and Equality} True and false @deftech{booleans} are represented by the values @@ -135,10 +132,6 @@ type. @racket[gen:equal+hash] should be used instead. Accepts a list of three procedures that correspond to the methods of @racket[gen:equal+hash]. } -@section{Extensible Equality and Hashing} - -@note-lib[racket/struct] - @defthing[gen:equal+hash any/c]{ A @tech{generic interface} (see @secref["struct-generics"]) that supplies an equality predicate and hashing functions for a structure @@ -208,7 +201,7 @@ property, then the @racket[prop:impersonator-of] property takes precedence over @racket[gen:equal+hash] if the property value's procedure returns a non-@racket[#f] value when applied to the structure. -@examples[ #:eval struct-eval +@examples[ (define (farm=? farm1 farm2 recursive-equal?) (and (= (farm-apples farm1) (farm-apples farm2)) diff --git a/collects/tests/generics/custom-hash.rkt b/collects/tests/generics/custom-hash.rkt index f15fd3a748..6e2cd79da5 100644 --- a/collects/tests/generics/custom-hash.rkt +++ b/collects/tests/generics/custom-hash.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/generics racket/struct +(require racket/generics (only-in racket/dict gen:dict prop:dict dict? diff --git a/collects/tests/generics/custom-write.rkt b/collects/tests/generics/custom-write.rkt index 97f82f5cd5..6fc7e4d770 100644 --- a/collects/tests/generics/custom-write.rkt +++ b/collects/tests/generics/custom-write.rkt @@ -1,6 +1,6 @@ -#lang racket +#lang racket/base -(require racket/struct) +(require racket/port) (struct loud (v) #:methods gen:custom-write diff --git a/collects/tests/generics/equal+hash.rkt b/collects/tests/generics/equal+hash.rkt index 1e7da75f4f..b6a765cda4 100644 --- a/collects/tests/generics/equal+hash.rkt +++ b/collects/tests/generics/equal+hash.rkt @@ -1,6 +1,4 @@ -#lang racket - -(require racket/struct) +#lang racket/base ;; vectors as method tables (struct kons (kar kdr)