(module hash (lib "swindle.ss" "swindle")
  #|(hash-collapse hash-reduce has-key hash-table->alist
                 hash-table-values hash-table-keys
                 items keys in-hash-keys? value)
  (import etc)|#
;  (require (lib "etc.ss"))
  (require (rename (lib "cl.ss" "util") map~ map))
  (require (rename (lib "cl.ss" "util") filter~ filter))
  (provide (all-defined))
  "hash.ss -- hash things that are missing from the fabulously incomplete
  and proprietary PLT Scheme hashes. Also included are some equivalencies for
  a-lists, which ought to make the transition easier.
Later:Hmmm...this exports map, so it should load after (?) cl.ss
 (it does, I think, you just have to import from cl judiciously. don't get fn)"
  ; this naming scheme stinks if you have namespaces, or even if you
  ; just have import+rename. So I'll probably shave it down just to collapse
  ; reduce etc and make them generic if other datatypes want to use the names
(define (make-hash alist &opt (equal #t))
  (let ((h (if equal (make-hash-table 'equal) (make-hash-table))))
    (for-each (lambda (p) (set! (ref h (car p)) (cdr p))) alist)
    h))
(define (map-keys f h &opt (equal #t))
  ; TODO:Make all these take more than one parameter
  (let ((i (make-hash '() equal)))
    (hash-table-for-each h
                         (lambda (k v) (set! (ref i (f k)) v)))
    i))
(define (map-values f h &opt (equal #t))
  (let ((i (make-hash '() equal)))
    (hash-table-for-each h
                         (lambda (k v) (set! (ref i k) (f v))))
    i))
(define (map-items key val h &opt (equal #t))
  (let ((i (make-hash '() equal)))
    (hash-table-for-each h
                         (lambda (k v) (set! (ref i (key k v)) (val k v))))
    i))
(defmethod (map~ f (h <hash-table>) . hs)
  "WARNING: hs are ignored right now. They need not be."
  (map-values f h))
(define (filter-keys f h &opt (equal #t))
  (let ((i (make-hash '() equal)))
    (hash-table-for-each h
                         (lambda (k v) (if (f k)
                                           (set! (ref i k) v))))
    i))
(define (filter-values f h &opt (equal #t))
  (let ((i (make-hash '() equal)))
    (hash-table-for-each h
                         (lambda (k v) (if (f v)
                                           (set! (ref i k) v))))
    i))
(define (filter-items f h &opt (equal #t))
  (let ((i (make-hash '() equal)))
    (hash-table-for-each h
                         (lambda (k v) (if (f k v)
                                           (set! (ref i k) v))))
    i))
(defmethod (filter~ f (h <hash-table>) . hs)
  "WARNING: hs are ignored right now. They need not be"
  (filter-keys f h))
;TODO:Make zip/except/extract into methods
;TODO:Write tests for everything here below
(define (zip~ . hs) ; zip~ isn't a method yet. FIX THIS!
  (let ((i (make-hash '())))
    (hash-table-for-each (car hs)
                         (lambda (k _)
                           (if (every (lambda (h) (has-key? h k)) hs)
                               (set! (ref i k)
                                     (map (lambda (h) (ref h k)) hs)))))
    i))
(define (extract~ h . xs) ; these aren't methods yet!
  (let ((i (make-hash '())))
    (for-each (lambda (k)
                (set! (ref i k) (ref h k)))
              xs)
    i))
(define (except~ h . xs)
    (filter-keys (lambda (k) (not (member k xs))) h))
;;; hash folders...sort of;;;
;; the first two are related in odd and confusing ways
;; the last two are the only real uses I've seen of these functions
(define (fold/hash key val/key-present val/key-absent h &opt (equal #t))
  "fn*fn*fn*hash->hash"
    (let ((i (make-hash '() equal)))
      (hash-table-for-each
       h
       (lambda (k v)
         (let ((new-k (key k)))
           (set! (ref i new-k)
                 (if (has-key? i k)
                     (val/key-present k v (ref i new-k))
                     (val/key-absent k v))))))
      i))
(define (fold/list val/key-present val/key-absent l
                   &opt (keymap identity) (equal #t))
  "fn*fn*list->list"
  (let ((h (make-hash '() equal)))
    (for-each
     (lambda (k)
       (let ((j (keymap k)))
         (set! (ref h j) (if (has-key? h j)
                             (val/key-present k (hash-table-get h j))
                             (val/key-absent k)))))
     l)
    h))
(define (collapse l &opt (keymap identity) (valuemap identity))
  "fn*fn*list->hash -- An easy interface for the only thing you really need
fold/list for."
  (fold/list (lambda (k v) (append v (list (valuemap k))))
             (lambda (k) (list (valuemap k)))
             l
             keymap))
(define (pair-collapse pairs)
  "Like make-hash, except that duplicate keys have their values
collected in a list instead of overwritten."
  (hash-collapse pairs car cdr))
(define (count/hash l)
  (fold/list (lambda (k v) (add1 v)) (lambda (_) 1) l))
(define (from-keys l &opt (val #f) (equal #t))
  (make-hash (map (lambda (k) (cons k val)) l) equal))
(define (has-key? h k)
  (let/ec ret
    (hash-table-get h k (lambda () (ret #f)))
    #t))
(define (hash->alist h)
    (hash-table-map h cons))
(define (hash-values h)
    (hash-table-map h (lambda (k v) v)))
(define (hash-keys h) ;this is stupid and probably quite inefficient
    (hash-table-map h (lambda (k v) k))) ;but I wrote it myself..
  (define items hash->alist)
  (define keys hash-keys)
  (define vals hash-values)
;;; a-list functions ;;;
  (define (value a k &opt
                 [error-thunk (thunk (error "Key not found in a-list: " k))])
    (let ((result (assoc k a)))
      (if result
          (cdr result)
          (error-thunk))))
  (define (valq a k &opt
                [error-thunk (thunk (error "Key not found in a-list: " k))])
    (let ((result (assq k a)))
      (if result
          (cdr result)
          (error-thunk)))))