;;;;
;;;; A Common Lisp program to print the frequency that dictionary words
;;;; appear in a text file
;;;;

(defparameter *words-file* "/usr/share/dict/words")

(defparameter *whitespace-chars*
  '(#\Newline #\Space #\Tab #\Page #\Return #\Linefeed))

(defun present-in-hash (key hash)
  (second (multiple-value-list (gethash key hash))))

(defun read-word (stream)
  (with-output-to-string (s)
    (loop as c = (peek-char nil stream nil)
       while (and c (member c *whitespace-chars*))
       do (read-char stream))
    (loop as c = (peek-char nil stream nil)
       while (and c (not (member c *whitespace-chars*)))
       do (write-char (read-char stream) s))))

(defun find-word-counts (filename)
  (let ((words (with-open-file (words *words-file*
				      :direction :input
				      :external-format :latin-1)
		 (let ((hash (make-hash-table :test 'equal)))
		   (loop (let ((line (read-line words nil)))
			   (if line
			       (setf (gethash line hash) t)
			       (return))))
		   hash)))
	(word-count (make-hash-table :test 'equal)))
    (with-open-file (doc-stream filename :direction :input)
      ;; Count the words
      (loop as w = (string-downcase (read-word doc-stream))
	 while (not (string= w ""))
	 do (when (present-in-hash w words)
	      (if (present-in-hash w word-count)
		  (incf (gethash w word-count))
		  (setf (gethash w word-count) 1))))
      ;; Display the counts
      (maphash (lambda (key value) (format t "~a: ~a~%" key value))
	       word-count))))