;;;; hash-let.scm  -*- Hen -*-
;;;; Kon Lovett, Aug '10

(module hash-let

  (;export
    hash-let)

  (import
    scheme
    chicken
    (only srfi-1 fold)
    (only srfi-69 hash-table-ref/default))

  (require-library (srfi 1) (srfi 69))

;;

(define-syntax (hash-let f r c)
  (##sys#check-syntax 'hash-let f '(_ #(_ 1) . _))
  (let ((?specs (cadr f))
        (?body (cddr f)) )
    (let ((refspecs
            (fold
              (lambda (tblspec ls)
                (##sys#check-syntax 'hash-let tblspec '(#(_ 1) _))
                (let ((tbl (cadr tblspec)))
                  (fold
                    (lambda (varspec ls)
                      (let* ((param? (pair? varspec))
                             (key? (and param? (not (null? (cdr varspec)))))
                             (var (if param? (car varspec) varspec))
                             (key (if key? (cadr varspec) var))
                             (def (and key? (not (null? (cddr varspec))) (caddr varspec)))
                             (key (if (symbol? key) `(,(r 'quote) ,key) key)) )
                        (cons
                          (cons var `(,(r 'hash-table-ref/default) ,tbl ,key ,def))
                          ls)) )
                    ls
                    (car tblspec)) ) )
              '()
              ?specs) ) )
      `((,(r 'lambda) ,(map car refspecs) ,@?body) ,@(map cdr refspecs)) ) ) )

) ;module hash-let