signature HASHTABLE =
   sig
       type ('key, 'data) hash_table

       val mkTable     : ('key -> int) * ('key * 'key -> bool) -> int * exn 
                         -> ('key, 'data) hash_table
       val insert      : ('key, 'data) hash_table -> 'key * 'data -> unit
       val find        : ('key, 'data) hash_table -> 'key -> 'data
       val listItems   : ('key, 'data) hash_table -> ('key * 'data) list
   end

structure HashTable :> HASHTABLE =
struct

datatype ('key, 'data) bucket_t
  = NIL
  | B of int * 'key * 'data * ('key, 'data) bucket_t

datatype ('key, 'data) hash_table = 
    HT of {hashVal   : 'key -> int,
	   sameKey   : 'key * 'key -> bool,
	   not_found : exn,
	   table     : ('key, 'data) bucket_t Array.array ref,
	   n_items   : int ref}

fun index (i, sz) = Word.toIntX(Word.andb(Word.fromInt i, Word.fromInt sz - 0w1))

(* find smallest power of 2 (>= 32) that is >= n *)
fun roundUp n = 
    let fun f i = if (i >= n) then i else f(i * 2)
    in  f 32  end

(* Create a new table; the int is a size hint and the exception
 * is to be raised by find.
 *)
fun mkTable (hashVal, sameKey) (sizeHint, notFound) = 
    HT{hashVal=hashVal,
       sameKey=sameKey,
       not_found = notFound,
       table = ref (Array.array(roundUp sizeHint, NIL)),
       n_items = ref 0
       }

(* conditionally grow a table *)
fun growTable (HT{table, n_items, ...}) = let
    val arr = !table
    val sz = Array.length arr
in
    if (!n_items >= sz)
    then let
	    val newSz = sz+sz
	    val newArr = Array.array (newSz, NIL)
	    fun copy NIL = ()
	      | copy (B(h, key, v, rest)) = let
		    val indx = index (h, newSz)
		in
		    Array.update (newArr, indx,
			          B(h, key, v, Array.sub(newArr, indx)));
		    copy rest
		end
	    fun bucket n = (copy (Array.sub(arr, n)); bucket (n+1))
	in
	    (bucket 0) handle _ => ();
	    table := newArr
	end
    else ()
end (* growTable *)
    
(* Insert an item.  If the key already has an item associated with it,
 * then the old item is discarded.
 *)
fun insert (tbl as HT{hashVal, sameKey, table, n_items, ...}) (key, item) =
    let
	val arr = !table
	val sz = Array.length arr
	val hash = hashVal key
	val indx = index (hash, sz)
	fun look NIL = (
		        Array.update(arr, indx, B(hash, key, item, Array.sub(arr, indx)));
		        n_items := !n_items + 1;
		        growTable tbl;
		        NIL)
	  | look (B(h, k, v, r)) = if ((hash = h) andalso sameKey(key, k))
		                   then B(hash, key, item, r)
		                   else (case (look r)
		                          of NIL => NIL
		                           | rest => B(h, k, v, rest)
		                                     (* end case *))
    in
	case (look (Array.sub (arr, indx)))
	 of NIL => ()
	  | b => Array.update(arr, indx, b)
    end

(* find an item, the table's exception is raised if the item doesn't exist *)
fun find (HT{hashVal, sameKey, table, not_found, ...}) key = let
    val arr = !table
    val sz = Array.length arr
    val hash = hashVal key
    val indx = index (hash, sz)
    fun look NIL = raise not_found
      | look (B(h, k, v, r)) = if ((hash = h) andalso sameKey(key, k))
		               then v
		               else look r
in
    look (Array.sub (arr, indx))
end
    
(* return a list of the items in the table *)
fun listItems (HT{table = ref arr, n_items, ...}) = let
    fun f (_, l, 0) = l
      | f (~1, l, _) = l
      | f (i, l, n) = let
	    fun g (NIL, l, n) = f (i-1, l, n)
		  | g (B(_, k, v, r), l, n) = g(r, (k, v)::l, n-1)
	in
	    g (Array.sub(arr, i), l, n)
	end
in
    f ((Array.length arr) - 1, [], !n_items)
end (* listItems *)

end

structure Main =
struct
fun getWords tab src =
    let fun update s =
            let val r = (HashTable.find tab s) 
                         handle Domain => let val new = ref 0
                                          in  HashTable.insert tab (s^"", new)
                                            ; new end
            in  r := !r + 1 end
        fun notAlpha c = (#"a" > c orelse c > #"z") andalso 
                         (#"A" > c orelse c > #"Z")
	fun ss_copy ss = 
	  Substring.substring (Substring.base ss)
        fun loop src =
	  if Substring.isEmpty src then NONE
	  else loop (if false then src
		     else let val src = Substring.dropl notAlpha src
			      val (s, src) = Substring.splitl Char.isAlpha src
			      val word     = CharVector.map Char.toLower (Substring.string s)
			  in 
			    update word; ss_copy src 
			  end)
    in  loop src 
    end


fun output (s, n) =
    app print [ StringCvt.padLeft #" " 7 (Int.toString(!n))
              , "\t", s, "\n"]


fun hashString s = 
    let fun charToWord c = Word.fromInt(Char.ord c)
        fun hashChar (c, h) = Word.<<(h, 0w5) + h + 0w720 + (charToWord c)
    in  Word.toIntX(CharVector.foldl hashChar 0w0 s) end

val main =
    let val _     = print "Building hashtable\n"
        val tab   = HashTable.mkTable(hashString, op=) (75000, Domain)
	val _     = print "Reading\n"
	val ss    = Substring.all(TextIO.inputAll TextIO.stdIn)
	val _     = print "Processing\n"
        val _     = getWords tab ss
	val _     = print "Sorting\n"
        val words = HashTable.listItems tab
        fun compare((s1, n1), (s2, n2)) = 
            case Int.compare(!n2, !n1) of
                EQUAL => String.compare(s2,s1)
              | order => order
        val sorted = Listsort.sort compare words
    in  app output sorted end

end