[plt-scheme] Convenient (?) hash-tables - an example of attaching compile time information to identifiers

Inspired by David's question on attaching compile time information to
identifiers, I have put together a simple example than last time.

Whether the new syntax is a good idea or not, I'll leave for you
to decide.

However, since the intention of this example is to show
good macro writing style, comments on the code is welcome.


/Jens Axel Søgaard


;;; mzscheme-ht.scm  --  Jens Axel Søgaard

;;; The MzScheme language extended with convenient syntax
;;; for accessing hash-tables.

;;; A small example of handling compile time information.

;;; Usage example:

; (require mzscheme-ht)
; (define ht (make-hash-table 'equal))
; (declare-hash-table ht)
; (ht 'a 1)
; (ht 'b 2)
; (ht 'a)   ; => 1
; (ht 'b)   ; => 2
; (map ht (lambda (key val) (list key val)))  ; => ((b 2) (a 1))

;;; Explanation:

; When ht is bound to a hash-table, we want to write
;      (ht key)      instead of (hash-table-ref ht key)
; and  (ht key val)  instead of (hash-table-ref ht key val) .

; [And a few other conveniences, since they are easy to add]

; Since the syntax (<expr> ...), where <expr> is not
; an identifier bound to a hash-table, is the syntax for
; normal syntax application, we need to keep track of the
; identifiers known to be bound to hash-tables.

; The (declare-hash-table ht) registers the variable name ht
; as being bound to a hash-table.

; Since (ht key) is the syntax of an application, we
; must define our own version of application app/ht
; and export it as #%app.

; The expansion of (<name> <expr>) is
;      (hash-table-ref <name> <expr>)  when <name> is
; registed as bound to a hash-table, and the
; expansion is
;      (#%app <name> <expr>)           otherwise.

(module mzscheme-ht mzscheme
   (provide (all-from-except mzscheme #%app)
            (rename app/ht #%app)
            declare-hash-table)

   (require-for-syntax (lib "boundmap.ss" "syntax"))
   ; The library (lib "boundmap.ss" "syntax") is used
   ; by the syntax transformers, so it is required
   ; using require-syntax. The library provides
   ; hashtables from identifiers to values (in our
   ; case #t and #f).

   (begin-for-syntax
     ; The register functions are also used by the
     ; syntax transformers, so to define them in the
     ; transformer environment, they are wrapped in
     ; a begin-for-syntax.

     (define registered-ht-names
       (make-module-identifier-mapping))

     (define (registered? ht-name)
       (and (identifier? ht-name)
            (module-identifier-mapping-get registered-ht-names
                                           ht-name (lambda() #f))))
     (define (register ht-name)
       (module-identifier-mapping-put! registered-ht-names
                                       ht-name #t)))

   (define-syntax (declare-hash-table stx)
     (syntax-case stx ()
       [(_ ht-name)
        (identifier? #'ht-name)
        (begin
          ; Register ht-name as bound to a hash-table
          (register #'ht-name)
          ; Expand to (begin) but remember to tell DrScheme
          ; that the use of ht-name disappeared: then
          ; the DrScheme Check Syntax tool knows to draw an
          ; arrow from ht in (declare-hash-table ht)
          ; to where ht is bound).
          (syntax-property
           #'(begin)
           'disappeared-use #'ht-name))]
       [_
        ; *Always* signal an error, when syntax is used incorrectly.
        (raise-syntax-error
         'declare-hash-table
         (string-append
          "Use (declare-hash-table <id>), where <id> is an "
          "identifier bound to a hash-table.")
         stx)]))  ; <= this makes DrScheme highlight the error

   (define-syntax (app/ht stx)
     (with-syntax
         ([result-stx
           (syntax-case stx (copy map for-each count remove!)
             [(_ ht-name key)
              (registered? #'ht-name)
              #'(hash-table-get ht-name key)]
             [(_ ht-name key val)
              (registered? #'ht-name)
              #'(hash-table-put! ht-name key val)]
             [(_ copy ht-name)
              (registered? #'ht-name)
              #'(hash-table-copy ht-name)]
             [(_ map ht-name proc)
              (registered? #'ht-name)
              #'(hash-table-map ht-name proc)]
             [(_ for-each ht-name proc)
              (registered? #'ht-name)
              #'(hash-table-for-each ht-name proc)]
             [(_ count ht-name)
              (registered? #'ht-name)
              #'(hash-table-count ht-name)]
             [(_ remove! ht-name key)
              (registered? #'ht-name)
              #'(hash-table-remove! ht-name key)]
             [(_ . more)
              (syntax/loc stx (#%app . more))])])
       ; use original source location
       (syntax/loc stx result-stx)))
       ; Note: The normal #%app will signal any errors,
       ;       so we don't need to worry about error handling
       ;       in this macro.
       ;       However, in return it is important to
       ;       transfer the source location information, so
       ;       the error will be reported in the user code,
       ;       and not here.
   )


(require mzscheme-ht)
(define ht (make-hash-table 'equal))
(declare-hash-table ht)
(ht 'a 1)
(ht 'b 2)
(ht 'a)
(ht 'b)
(map ht (lambda (key val) (list key val)))
(count ht)
(for-each ht (lambda (key val) (display key))) (newline)
(define ht2 (copy ht))
(declare-hash-table ht2)
(count ht2)