s c h e m a t i c s : c o o k b o o k

(module hash mzscheme
  (require (lib "match.ss")
           (lib "contract.ss"))
  (require-for-syntax (lib "cut.ss" "srfi" "26"))

  (define-values (struct:hash make-hash hash? hash-rec-ref hash-rec-set!) 
    (make-struct-type 'hash #f 2 0 #f null #f 1))

  (define (hash . args)
    (define h (apply make-hash-table args))
    (make-hash h
      (case-lambda
        [(key) (hash-table-get h key)]
        [(key value) (hash-table-put! h key value)])))

  (define (prim hash) (hash-rec-ref hash 0))

  (define-syntax (provide-prims stx)
    (define (stx-prepend str stx)
      (datum->syntax-object stx
                            (string->symbol
                             (string-append str (symbol->string (syntax-e stx))))))
    (syntax-case stx ()
      [(_ prims ...)
       (let* ([prims (syntax->list #'(prims ...))]
              [mz-prims (map (cut stx-prepend "hash-table-" <>) prims)]
              [my-prims (map (cut stx-prepend "hash-" <>) prims)]
              [defs (map (lambda (my mz)
                           #`(begin
                               (define (#,my hash . args)
                                 (apply #,mz (prim hash) args))
                               (provide #,my)))
                         my-prims mz-prims)])
         #`(begin #,@defs))]))

  (provide-prims copy count for-each get
                 iterate-first iterate-key iterate-next iterate-value
                 map put! remove!)

  (provide/contract
    [hash ((symbols 'weak 'equal) . -> . hash?)]
    [hash? (any/c . -> . boolean?)]))

> (require hash)
> (define h (hash 'equal))
> (h "foo" 2)
> (h "foo")
2
> (hash-for-each h (lambda (k v) (printf "~a: ~a~n" k v)))
foo: 2