#lang racket/base (require racket/generic (prefix-in b: racket/base) racket/dict racket/class racket/match) (provide (all-defined-out)) (define-generics indexable (ref indexable i [thunk]) (ref! indexable i [thunk]) (ref-set! indexable i v) (ref-keys indexable) #:defaults ([hash? (define (ref o i [thunk #f]) (hash-ref o i thunk)) (define (ref! o i [thunk #f]) (hash-ref! o i thunk)) (define ref-set! hash-set!) (define ref-keys hash-keys)] [dict? (define (ref o i [thunk #f]) (dict-ref o i thunk)) (define (ref! o i [thunk #f]) (dict-ref o i thunk)) (define ref-set! dict-set!) (define ref-keys dict-keys)] [object? (define (ref o i [thunk #f]) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i thunk))]) (dynamic-get-field i o))) (define (ref-set! o i v) (with-handlers ([exn:fail:object? (λ (exn) (hash-set! (get-field _hash o) i v))]) (dynamic-set-field! i o v))) (define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))])) (module+ test (require rackunit racket/set) (define h (make-hash '((foo . 42)))) (check-equal? (ref h 'foo) 42) (ref-set! h 'foo 85) (check-equal? (ref h 'foo) 85) (ref-set! h 'bar 121) (check-equal? (ref h 'bar) 121) (check-equal? (apply set (ref-keys h)) (apply set '(foo bar))) (define o (make-object (class object% (super-new) (field [_hash (make-hash)][foo 42])))) (check-equal? (ref o 'foo) 42) (ref-set! o 'foo 100) (check-equal? (ref o 'foo) 100) (ref-set! o 'bar 121) (check-equal? (ref o 'bar) 121) (check-equal? (apply set (ref-keys o)) (apply set '(foo bar)))) (define (ref* c . is) (for/fold ([c c]) ([i (in-list is)]) (ref c i))) (define (ref*-set! c . is+val) (match-define (list is ... i val) is+val) (ref-set! (apply ref* c is) i val)) (require sugar/debug) (define (ref-set*! c . kvs) (for ([k (in-list kvs)] [v (in-list (cdr kvs))] [i (in-naturals)] #:when (even? i)) (ref-set! c k v))) (module+ test (define h2 (make-hash (list (cons 'foo (make-hash (list (cons 'bar (make-hash '((zam . 42)))))))))) (check-equal? (ref* h2 'foo 'bar 'zam) 42) (ref*-set! h2 'foo 'bar 'zam 89) (check-equal? (ref* h2 'foo 'bar 'zam) 89) (ref-set*! h2 'hi 1 'there 2) (check-equal? (ref h2 'hi) 1) (check-equal? (ref h2 'there) 2)) (define-generics countable (length countable) (countable->list countable) #:defaults ([list? (define length b:length) (define countable->list (λ (x) x))] [vector? (define length vector-length) (define countable->list vector->list)] [string? (define length string-length) (define countable->list string->list)] [bytes? (define length bytes-length) (define countable->list bytes->list)] [dict? (define length dict-count) (define countable->list (λ (x) x))] [object? (define (length o) (b:length (get-field _list o))) (define (countable->list o) (get-field _list o))])) (module+ test (require racket/list) (check-equal? (length (make-list 42 #f)) 42) (check-equal? (length (make-vector 42 #f)) 42) (check-equal? (length (make-string 42 #\x)) 42) (check-equal? (length (make-bytes 42 0)) 42) (check-equal? (length (map cons (range 42) (range 42))) 42) (check-equal? (length (make-object (class object% (super-new) (field [_list (make-list 42 #f)])))) 42)) (define-generics pushable (push-end pushable xs) #:defaults ([list? (define push-end b:append)] [object? (define (push-end o xs) (append (get-field _list o) xs))])) (module+ test (check-equal? (push-end (range 3) '(3 4 5)) (range 6)) (define o2 (make-object (class object% (super-new) (field [_list (range 3)])))) (ref-set! o2 '_list (push-end o2 '(3 4 5))) (check-equal? (ref o2 '_list) (range 6)))