;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of ICCLE2.
;
; ICCLE2 is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; ICCLE2 is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with ICCLE2.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro dohash ((key value hash &optional end) &body body)
  `(progn (maphash #'(lambda (,key ,value) ,@body) ,hash)
         ,end))

(defmacro dovalues ((value hash &optional end) &body body)
  (let ((key (gensym)))
    `(progn (maphash #'(lambda (,key ,value) ,@body) ,hash)
            ,end)))

(defmacro dokeys ((key hash &optional end) &body body)
  (let ((value (gensym)))
    `(progn (maphash #'(lambda (,key ,value) ,@body) ,hash)
            ,end)))
 
(defun showh (h &key
              (indent 0) (stream t) (before "") (after "")
              (if-empty "empty")
              (show #'(lambda (x)
                        (format stream "~a~a = ~a~%"
                           (nchars indent) (first x) (rest x))))
              (lt #'lt))
  (if (zerop (hash-table-count h))
      (format stream "~a~a~a" before if-empty after)
      (let (l)
        (format stream "~a" before) 
        (maphash #'(lambda (k v) (push (cons k v) l)) h)
        (mapc show 
              (sort l #'(lambda (a b)
                          (funcall lt (car a) (car b)))))
        (format stream "~a" after)
        h)))

(deftest test-showh ()
  (let ((h (make-hash-table)))
    (dolist (one '(apple pear banana))
      (setf (gethash (length (string one)) h) one))
   (check
     (samep (with-output-to-string (s) (showh h  :stream s))
            "4 = PEAR
             5 = APPLE
             6 = BANANA"))))

(deftest test-dovalues ()
  (let (all
        (h (make-hash-table)))
    (dolist (one '(apple pear banana))
      (setf (gethash (length (string one)) h) one))
    (dovalues (value h)
      (push value all))
    (check
      (equal '(banana pear apple) all))))

(defun keys2sorted-alist (h ranker)
  (labels ((car-string-lessp (x y) 
             (string-lessp (rest x) (rest y))))
    (let (all (n -1))
      (dohash (key value h)
        (push (cons key
                    (format nil (if (numberp key) ranker "~a") key))
              all))
      (mapcar #'(lambda (one) `(,(first one) . ,(incf n)))
              (sort all #'car-string-lessp)))))

(defmethod print-object ((object hash-table) stream) 
  (format stream "#<HT ~a>" (hash-table-count object)))