XPost: comp.lang.scheme

Nicolas Neuss wrote:

(defun wordcount (&optional (stream *standard-input*)
&aux (*readtable* (copy-readtable)) (table (make-hash-table)))
;; tweak readtable
(loop for char across "\".;,#:()[]{}" do
(set-syntax-from-char char #\Space))
;; count
(loop for word = (read stream nil #\.) until (eq word #\.)
do (incf (gethash word table 0)))
;; output
(let ((*print-pretty* nil))
(loop for (word . count) in
(sort (loop for a being the hash-keys of table using (hash-value b)
collect (cons a b))
#'(lambda (a b)
(or (> (cdr a) (cdr b))
(string<= (car a) (car b)))))
do (format t "~D : ~A~%" count (string-downcase word)))))

;;; Testing:
(wordcount (make-string-input-stream "A b a hello.B, a Hello b"))

Gauche Scheme

(use srfi-13) ; string-tokenize string-upcase
(use srfi-14) ; char. sets
(use srfi-42) ; do-ec

(define (wordcount :optional (port (current-input-port)))
(rlet1 al '()
(do-ec
(:port line port read-line)
(:list word (string-tokenize line char-set:letter))
(ainc! al (string-upcase word)))))

(call-with-input-string
"Foo.b,a:e c(d)e d
c b a[foo]FOO"
wordcount)

===>
(("D" . 2) ("C" . 2) ("E" . 2) ("A" . 2) ("B" . 2) ("FOO" . 3))

Given:

(define-syntax ainc!
(syntax-rules ()
[(_ alist key val func default)
(let ((pair (assoc key alist)))
(if pair
(set-cdr! pair (func val (cdr pair)))
(set! alist (cons (cons key (func val default)) alist))))]
[(_ alist key val func)
(ainc! alist key val func 0)]
[(_ alist key val)
(ainc! alist key val +)]
[(_ alist key)
(ainc! alist key 1)]))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)