# $Id: wordfreq.pliant,v 1.1 2002/03/18 14:07:00 dada Exp $
# http://dada.perl.it/shootout/

module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/pipe.pli"

function heapsort n ra
  arg Int n ; arg_rw Array:Str ra
  var Str rra
  var Int i
  var Int j
  var Int l := (n\2) + 1
  var Int ir := n
  
  part heapsort_loop
    if l>1
      l := l - 1
      rra := ra:l
    else
      rra := ra:ir
      ra:ir := ra:1
      ir := ir - 1
      if ir=1
        ra:1 := rra
        leave heapsort_loop
    i := l
    j := l*2

    while j<=ir
      if j<ir and ra:j > ra:(j+1)
        j := j + 1
      if rra > ra:j
        ra:i := ra:j
        i := j
        j := j + i
      else
        j := ir + 1
    ra:i := rra
    restart heapsort_loop

gvar Stream stdin

gvar Str line := ""
gvar Str l
gvar Str word
gvar Address Buf
gvar Int ReadCount
gvar CBool ok
gvar Int ReadSize := 4096
gvar Int eolpos
gvar Int i
gvar Int nl := 0
gvar Int nw := 0
gvar Int nc := 0
gvar Char ch
gvar Int j
gvar Array:Str lines

gvar (Dictionary Str Int) count
gvar Pointer:Int v
gvar Str k

stdin open "handle:0" in

while not stdin:atend
  line := stdin readline
  i := 0
  while i<line:len
    ch := line:i
    if ch>="a" and ch<="z" or ch>="A" and ch<="Z"
      j := i+1
      part find_word
        if j<line:len
          ch := line:j
          if ch>="a" and ch<="z" or ch>="A" and ch<="Z"
            j += 1              
            restart find_word          
      word := lower (line i j-i)
      if (count exists word)
        count:word += 1
      else
        count insert word 1        
      i += j-i
    else
      i += 1

lines += ""
v :> count first
k := count key v    
while addressof:v<>null
  if addressof:(count first k)<>null
    l := (string count:k)
    l := (repeat 7-l:len " ")+l
    line := l+"[tab]"+k+"[lf]"
    lines += line
    # console k "=" count:k eol
  v :> count next v
  if addressof:v<>null
    k := count key v

heapsort lines:size-1 lines
for i 0 lines:size-1
  console lines:i