Ch6, Ex18

functor
import
   File %Dict, custom Dict module is no more needed
   QTk at 'x-oz://system/wp/QTk.ozf'
define
   fun {WordChar C}
      (&a=<C andthen C=<&z) orelse
      (&A=<C andthen C=<&Z) orelse (&0=<C andthen C=<&9) end
   fun {WordToAtom PW} {StringToAtom {Reverse PW}} end
   Put=Dictionary.put
   CondGet=Dictionary.condGet
   proc {IncWord D W}
      {Put D W {CondGet D W 0}+1}
   end
   fun {CharsToWords PW Cs}
      case Cs
      of nil andthen PW==nil then
         nil
      [] nil then
         [{WordToAtom PW}]
      [] C|Cr andthen {WordChar C} then
         {CharsToWords {Char.toLower C}|PW Cr}
      [] _|Cr andthen PW==nil then
         {CharsToWords nil Cr}
      [] _|Cr then
         {WordToAtom PW}|{CharsToWords nil Cr}
      end
   end
   proc {CountWords D Ws}
      case Ws
      of W|Wr then
         {IncWord D W}
         {CountWords D Wr}
      [] nil then skip
      end
   end
   fun {WordFreq Cs}
      D={NewDictionary}
   in
      {CountWords D {CharsToWords nil Cs}}
      D
   end
   fun {Entries D}
      Ws = {Arity {Dictionary.toRecord label D}}
      Ns = {Record.toList {Dictionary.toRecord label D}}
      proc {Iter Xs Ys ?A}
         case Xs#Ys of (X|Xr)#(Y|Yr) then Z in
            A = (X#Y)|Z
            {Iter Xr Yr Z}
         [] nil#nil then A=nil
         end
      end
   in
      {Iter Ws Ns $}
   end
   L={File.readList stdin}
   E={Entries {WordFreq L}}
   S={Sort E fun {$ A B} A.2>B.2 end}
   H Des=td(title:'Word frequency count'
            text(handle:H tdscrollbar:true glue:nswe))
   W={QTk.build Des} {W show}
   for X#Y in S do {H insert('end' X#': '#Y#' times\n')} end
end