words.ml

open Lwt
open Lwt_io

let adjust ht f k v =
  Hashtbl.(replace ht k @@ try f (find ht k) v with Not_found -> v)

let histo stream =
  let ht = Hashtbl.create 16 in
  Lwt_stream.iter (fun x -> adjust ht (+) x 1) stream
  >|= fun () -> Hashtbl.fold (fun k v xs -> (k, v)::xs) ht []

let words = Lwt_stream.map_list Re_pcre.(split ~rex:(regexp "\\s+"))

let count ic =
  histo (words @@ read_lines ic)
  >|= List.sort (fun (_, a) (_, b) -> compare b a)
  >>= Lwt_list.iter_s (fun (w, n) -> printf "- %s : %d\n" w n)

let _ = Lwt_main.run @@ count stdin

(*

$ ocamlfind ocamlopt -linkpkg -syntax camlp4o -package lwt,lwt.syntax,lwt.unix,re,
re.pcre words.ml -o words

*)

Depressing.