From a1293d4284a841d2823dc885ba544ace7ab0bd57 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 7 Feb 2014 23:17:46 -0600 Subject: [PATCH] add forgotten file --- .../collects/racket/private/class-wrapped.rkt | 46 +++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 racket/collects/racket/private/class-wrapped.rkt diff --git a/racket/collects/racket/private/class-wrapped.rkt b/racket/collects/racket/private/class-wrapped.rkt new file mode 100644 index 0000000000..d998a370a5 --- /dev/null +++ b/racket/collects/racket/private/class-wrapped.rkt @@ -0,0 +1,46 @@ +#lang racket/base +(provide (struct-out wrapped-class-info) + (struct-out wrapped-class) + (struct-out wrapped-object) + unwrap-class + unwrap-object) + +(struct wrapped-class-info (class blame + neg-extra-arg-vec ;; vector that parallels the class's vector of methods + neg-acceptors-ht ;; range of ht has curried (neg-pary -> mth) fns + pos-field-projs neg-field-projs + init-proj-pairs) + #:transparent) +(struct wrapped-class (the-info neg-party) + #:property prop:custom-write + (λ (stct port mode) + (do-custom-write (wrapped-class-info-class (wrapped-class-the-info stct)) port mode)) + #:transparent) + +(struct wrapped-object (object neg-extra-arg-vec pos-field-projs neg-field-projs neg-party) + #:transparent + #:property prop:custom-write + (λ (stct port mode) + (do-custom-write (wrapped-object-object stct) port mode))) + +(define (do-custom-write v port mode) + (cond + [(custom-write? v) + ((custom-write-accessor v) v port mode)] + [(equal? mode #t) + (write v port)] + [(equal? mode #f) + (display v port)] + [else + (print v port mode)])) + + +(define (unwrap-object o) + (cond + [(wrapped-object? o) (wrapped-object-object o)] + [else o])) + +(define (unwrap-class cls) + (cond + [(wrapped-class? cls) (wrapped-class-info-class (wrapped-class-the-info cls))] + [else cls]))