(* -*- mode: sml -*-
 * $Id: ackermann.smlnj,v 1.5 2001/07/09 00:25:27 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun ack(0,n) = n+1
  | ack(m,0) = ack(m-1,1)
  | ack(m,n) = ack(m-1,ack(m,(n-1)));

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t );

fun main(name, args) = 
  let
    val arg = hd(args @ ["1"]);
    val num = atoi arg;
    val ack = ack(3, num);
    val result = Int.toString ack;
  in
      printl ["Ack(3,", arg, "): ", result];
      OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("ackermann", Test.main);

(* -*- mode: sml -*-
 * $Id: ary3.smlnj,v 1.2 2001/07/09 00:25:27 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun index i = i;

fun ary n =
    let
    val x = Array.array(n, 0)
    val y = Array.array(n, 0)
    fun xinit i =
        if i = n then ()
        else (Array.update(x, i, i + 1) ; xinit (i + 1))
    fun xtoy i =
        if i < 0 then ()
        else (Array.update(y, i, Array.sub(x, i) + Array.sub(y, i)) ; xtoy (i - 1))
        fun aryloop i =
        if i < 0 then ()
        else (xtoy(n-1); aryloop (i-1))
    in
    xinit 0;
    aryloop 999;
    print (Int.toString (Array.sub(y, 0)));
    print " ";
    print (Int.toString (Array.sub(y, (n-1))));
    print "\n"
    end;

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
    let
    val arg = hd(args @ ["1"])
    val num = atoi arg
    in
    ary num;
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("ary3", Test.main);

(* -*- mode: sml -*-
 * $Id: wc.smlnj,v 1.2 2001/07/09 00:25:29 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 *)


structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun incr r = r := !r + 1
   
val nl = ref 0
val nw = ref 0
val nc = ref 0
val max = 4096
val buf = Word8Array.array (max, 0w0)
val sub = Word8Array.sub

fun readblock scanfun =
   let
      val nread = Posix.IO.readArr (Posix.FileSys.stdin,
                    {buf = buf, i =  0, sz = NONE})
   in
      if nread = 0
     then ()
      else (nc := !nc + nread;
        scanfun (0, nread))
   end

val c2b = Byte.charToByte
val newline = c2b #"\n"
val space = c2b #" "
val tab = c2b #"\t"

fun scan_out_of_word (i, n) =
   if i < n
      then
     let
        val c = sub (buf, i)
     in
        if c = newline
           then (incr nl; scan_out_of_word (i + 1, n))
        else if c = space orelse c = tab
            then scan_out_of_word (i + 1, n)
         else (incr nw; scan_in_word (i + 1, n))
     end
   else readblock scan_out_of_word

and scan_in_word (i, n) =
  if i < n then
     let
    val c = sub (buf, i)
     in
    if c = newline
       then (incr nl; scan_out_of_word (i + 1, n))
    else if c = space orelse c = tab
        then scan_out_of_word (i + 1, n)
         else scan_in_word (i + 1, n)
     end
  else readblock scan_in_word

fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )
   
fun main (name, args) =
  let
    val _ =
        (scan_out_of_word (0, 0);
    printl [Int.toString (!nl), " ", Int.toString (!nw), " ", Int.toString (!nc)])
  in
    OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("wc", Test.main);

(* -*- mode: sml -*-
 * $Id: echo.smlnj,v 1.1 2001/07/10 00:47:14 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Daniel Wang
 *)
structure Test : sig
 val main : (string * string list) -> OS.Process.status
end =     
 struct        
   exception Error of string
    
   val data = "Hello there sailor\n"

   fun mkSocks () = let
     val server = INetSock.TCP.socket()
     val client = INetSock.TCP.socket()
     val _ = Socket.bind(server,INetSock.any 0)
     val saddr = INetSock.fromAddr(Socket.Ctl.getSockName server)
     val _ = Socket.listen(server,2)
     val _ = Socket.connect(client,INetSock.toAddr saddr)
     val _ = INetSock.TCP.setNODELAY(server,true)
     val _ = INetSock.TCP.setNODELAY(client,true)
   in {client=client,server=server}
   end

   fun readString (s,n) = let
     fun loop(0) = []
       | loop(n) = let
       val data = Byte.bytesToString(Socket.recvVec(s,n))
       val len = String.size data
     in if len = 0 then []
        else (data::(loop(n - len)))
     end
   in String.concat (loop n)
   end
 
   fun writeString (out,str) = 
     Socket.sendVec(out,{buf=Byte.stringToBytes str,i=0,sz=NONE})

   fun closeSock s =
     (Socket.shutdown(s,Socket.NO_RECVS_OR_SENDS);
      Socket.close s)

  fun main (_,args) = let
    val num =
      case args of
    nil => 1
      | n::_ => valOf (Int.fromString n)
    val {client=client_sock,server=server_sock} = mkSocks()
    fun server () = let
      val (sock,_) = Socket.accept(server_sock)
      fun s b = 
    case readString(sock,19) of
       "" => (Posix.Process.wait ();
          TextIO.output(TextIO.stdOut,
                concat ["server processed ",
                    Int.toString b,
                    " bytes\n"]);
          TextIO.flushOut(TextIO.stdOut))
     | i =>(writeString(sock,i);
        s (b + 19))
    in s 0
    end
    fun client () = let
      fun c 0 = closeSock(client_sock)
    | c n = let
        val _ = writeString(client_sock,data);
        val reply = readString(client_sock,19)
      in if reply = data then c(n - 1)
         else raise Error "Didn't receive the same data"
      end
    in c num
    end
  in
    case Posix.Process.fork () of
      SOME pid => server ()
    | NONE => client ();
     OS.Process.success
  end 
end

val _ = SMLofNJ.exportFn("echo",Test.main);

(* -*- mode: sml -*-
 * $Id: except.smlnj,v 1.2 2001/07/09 00:25:27 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * Translated from except.ocaml by Stephen Weeks
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun incr r = r := !r + 1
fun print_endline s = (print s; print "\n")
fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end
   
exception HiException of int
exception LoException of int

val hi = ref 0
val lo = ref 0

fun blowup n =
  if n mod 2 = 0 then raise (LoException n)
  else raise (HiException n)

fun lo_fun n =
  blowup n
  handle LoException ex => incr lo

fun hi_fun n =
  lo_fun n
  handle HiException ex => incr hi

fun some_fun n =
  hi_fun n
  handle x =>
     (print_endline "Should not get here.";
      raise x)

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t );
   
fun main (name, args) =
   let
      val n = atoi (hd (args @ ["1"]))
      val _ = for (1, n, some_fun)
   in
      printl ["Exceptions: HI=",
          Int.toString (!hi),
          " / LO=",
          Int.toString (!lo)];
      OS.Process.success
   end
end

val _ = SMLofNJ.exportFn("except", Test.main);

(* -*- mode: sml -*-
 * $Id: fibo.smlnj,v 1.5 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun fib 0 = 1
  | fib 1 = 1
  | fib n = fib (n-2) + fib (n-1);

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
  let
    val arg = hd(args @ ["1"]);
    val num = atoi arg;
    val fib = fib num;
    val result = Int.toString fib;
  in
      print result; print "\n";
      OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("fibo", Test.main);

(* -*- mode: sml -*-
 * $Id: hash.smlnj,v 1.3 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

open HashTable;

fun hashtest n =
    let
    val hx = mkTable (HashString.hashString, op =) (n, (Fail "not found"))
    fun doinserts i n =
        if i < n then (
        insert hx ((Int.fmt StringCvt.HEX i), i);
        doinserts (i+1) n
        ) else ()
    fun dolookups i c =
        if i > 0 then
        case find hx (Int.toString i) of
            SOME key => dolookups (i-1) (c+1)
          | _ => dolookups (i-1) c
        else c
    in (
    doinserts 0 n;
    dolookups n 0
    ) end;

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
    let
    val arg = hd(args @ ["1"])
    val num = atoi arg
    val result = hashtest num
    in
    print (Int.toString result) ; print "\n" ;
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("hash", Test.main);

(* -*- mode: sml -*-
 * $Id: hash2.smlnj,v 1.3 2001/07/10 13:01:54 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * Modified by Daniel Wang
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

open HashTable;

fun hashtest2 n =
    let
    exception NotFound
    val h1 = mkTable (HashString.hashString, op =) (10000, NotFound)
    val h2 = mkTable (HashString.hashString, op =) (10000, NotFound)
    fun doinserts1 i =
        if i < 10000 then (
        insert h1 ("foo_" ^ (Int.toString i), i);
        doinserts1 (i+1)
        ) else ()
    fun addinto h k v1 =
        case find h k of
        SOME valref => valref := (!valref) + v1
          | NONE => insert h (k, ref v1)
    fun doinserts2 i =
        if i < n then (
        appi (fn (k,v) => (addinto h2 k v)) h1;
        doinserts2 (i+1)
        ) else ()
    in (
    doinserts1 0;
    doinserts2 0;
    print (Int.toString (lookup h1 "foo_1")); print " ";
    print (Int.toString (lookup h1 "foo_9999")); print " ";
    print (Int.toString (!(lookup h2 "foo_1"))); print " ";
    print (Int.toString (!(lookup h2 "foo_9999")));
    print "\n"
    ) end;

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
    let
    val arg = hd(args @ ["1"])
    val num = atoi arg
    in
    hashtest2 num;
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("hash2", Test.main);

(* -*- mode: sml -*-
 * $Id: heapsort.smlnj,v 1.3 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * Based on cdoe from Stephen Weeks, improved by Henry Cejtin.
*)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

val sub = Array.sub
val update = Array.update
   
local
   val im = 139968
   val ia =   3877
   val ic =  29573
   val last = ref 42
   val scale = 1.0 / Real.fromInt im
in
   fun gen_random max =
      let val last' = (! last * ia + ic) mod im
      in last := last';
         max * scale * Real.fromInt last'
      end
end

fun heapSort (n, ra: real array) =
       let fun inner (l, ir, rra) =
                  let fun loop (i, j) =
                             if j <= ir
                                then let val j =
                                                if j < ir
                                                andalso sub (ra, j) < sub (ra, j + 1)
                                                   then j + 1
                                                   else j
                                         val (i, j) =
                                                if rra < sub (ra, j)
                                                   then (update (ra, i, sub (ra, j));
                                                         (j, j + j))
                                                   else (i, ir + 1)
                                     in loop (i, j)
                                     end
                                else update (ra, i, rra)
                  in loop (l, l + l)
                  end
           fun outer1 l =
                  let val l' = l - 1
                  in if l' > 0
                        then (inner (l', n, sub (ra, l'));
                              outer1 l')
                        else ()
                  end
           fun outer2 ir =
                  let val rra = sub (ra, ir)
                      val _ = update (ra, ir, sub (ra, 1))
                      val ir = ir - 1
                  in if ir = 1
                        then update (ra, 1, rra)
                        else (inner (1, ir, rra);
                              outer2 ir)
                  end
       in outer1 (n div 2 + 1);
          outer2 n
       end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t );

fun main (name, args) =
    let val n = atoi (hd (args @ ["1"]))
    val ary = Array.tabulate (n + 1, fn _ => gen_random 1.0)
    in
    heapSort (n, ary);
    print (concat [Real.fmt (StringCvt.FIX (SOME 10)) (sub (ary, n)),
               "\n"]);
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("heapsort", Test.main);

(* -*- mode: sml -*-
 * $Id: hello.smlnj,v 1.2 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun main(name, args) = 
  let in print "hello world\n"; OS.Process.success end;

end

val _ = SMLofNJ.exportFn("hello", Test.main);

(* -*- mode: sml -*-
 * $Id: lists.smlnj,v 1.2 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 *)

 
structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

val sub = Array.sub
val update = Array.update
fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end
fun failwith s = raise Fail s

structure Deque:
  sig
    type 'a t
    exception Empty

    val make: int * 'a -> 'a t
    val iota: int -> int t

    val is_empty: 'a t -> bool
    val equal: ''a t * ''a t -> bool
    val length: 'a t -> int
    val nth: 'a t * int -> 'a

    val push_front: 'a * 'a t -> unit
    val push_back: 'a t * 'a -> unit

    val take_front: 'a t -> 'a
    val take_back: 'a t -> 'a

    val copy: 'a t -> 'a t
    val reverse: 'a t -> 'a t
  end =
  struct
     type 'a t = {size: int ref,
          first: int ref,
          last: int ref,
          field: 'a array ref,
          fill: 'a}

     local
    fun make sel (d: 'a t) = sel d
     in
    fun fill z = make #fill z
     end

     local
    fun make sel (d: 'a t) = !(sel d)
     in
    fun field z = make #field z
    fun first z = make #first z
    fun last z = make #last z
    fun size z = make #size z
     end

     exception Empty

     fun make (n, dummy) =
    let
       val n = Int.max (n, 0)
       val nplus = Int.max (1, n)
    in
       {size = ref nplus,
        first = ref (Int.quot (nplus, 2)),
        last = ref (Int.quot (nplus, 2) - 1),
        field = ref (Array.array (nplus, dummy)),
        fill = dummy}
    end

     fun iota i =
    let
       val i = Int.max (0, i)
       val iplus = Int.max (1, i)
    in
       {size = ref iplus,
        first = ref 0,
        last = ref (i - 1),
        field = ref (Array.tabulate (iplus, fn n => n + 1)),
        fill = i}
    end

     fun length buf = last buf - first buf + 1

     fun is_empty buf = last buf < first buf

     fun array_eq (arr1, off1, arr2, off2, i) =
    let
       fun loop (off1, off2, i) =
          case i of
         0 => true
           | n =>
            sub (arr1, off1) = sub (arr2, off2)
            andalso loop (off1 + 1, off2 + 1, n - 1)
    in loop (off1, off2, i)
    end

     fun equal (buf1, buf2) =
    let
       val len = length buf1
    in
       len = length buf2
       andalso array_eq (field buf1, first buf1,
                 field buf2, first buf2,
                 len)
    end

     fun nth (buf, n) =
    if n < 0 orelse n >= length buf
       then failwith "nth"
    else sub (field buf, first buf + n)

     fun double_shift buf = 
    let
       val new_size = size buf * 2
       val len = length buf
       val new_first = Int.quot (new_size - len, 2)
       val new_field = Array.array (new_size, fill buf)
       val _ = Array.copy {src = field buf,
                   si = first buf,
                   dst = new_field,
                   di = new_first,
                   len = SOME len}
    in
       #size buf := new_size;
       #field buf := new_field;
       #first buf := new_first;
       #last buf := new_first + len - 1
    end

     fun push_front (elem, buf) =
    let
       val _ = if first buf = 0 then double_shift buf else ()
       val new_first = first buf - 1
    in
       update (field buf, new_first, elem);
       #first buf := new_first
    end

     fun push_back (buf, elem) =
    let
       val _ = if last buf = size buf - 1 then double_shift buf else ()
       val new_last = last buf + 1
    in
       update (field buf, new_last, elem);
       #last buf := new_last
    end

     fun take_front buf =
    if is_empty buf
       then raise Empty
    else
       let
          val old_first = first buf
       in
          #first buf := old_first + 1;
          sub (field buf, old_first)
       end

     fun take_back buf =
    if is_empty buf
       then raise Empty
    else
       let
          val old_last = last buf
       in
          #last buf := old_last - 1;
          sub (field buf, old_last)
       end

     fun copy buf =
    let
       val len = length buf
       val new_buf = make (len, fill buf)
       val _ = Array.copy {src = field buf,
                   si = first buf,
                   dst = field new_buf,
                   di = 0,
                   len = SOME len}
    in
       #first new_buf := 0;
       #last new_buf := len - 1;
       new_buf
    end

     fun reverse buf =
    let
       val len = length buf 
       val fst = first buf
       val fld = field buf
       val new_buf = make (len, fill buf)
       val new_fld = field new_buf
       val _ = 
          for (0, len - 1, fn i =>
           update (new_fld, len - i - 1, sub (fld, fst + i)))
    in
       #first new_buf := 0;
       #last new_buf := len - 1;
       new_buf
    end
end

open Deque

fun empty () = iota 0

val size = 10000

fun test_lists () =
  let
     val d1 = iota size
     val d2 = copy d1
     val d3 = empty ()
     val _ = for (1, length d2, fn _ => push_back (d3, take_front d2))
     val _ = for (1, length d3, fn _ => push_back (d2, take_back d3))
     val d1 = reverse d1
     val _ = if size <> nth (d1, 0) then failwith "First test failed" else ()
     val _ = if length d1 <> length d2 then failwith "Second test failed" else ()
     val _ = if not (equal (d1, d2)) then failwith "Third test failed" else ()
  in
     length d1
  end

fun main (name, args) =
  let
     val n =
    case Int.fromString (hd (args @ ["1"])) of
       NONE => 1
     | SOME n => n
     val result = ref 0
     val _ = for (1, n, fn _ => result := test_lists ())
  in
     print (concat [Int.toString (!result), "\n"]);
     OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("lists", Test.main);

(* -*- mode: sml -*-
 * $Id: matrix.smlnj,v 1.3 2001/07/11 01:40:04 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 *)


structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun incr r = r := !r + 1
fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end

structure Array2 =
   struct
      datatype 'a t = T of 'a array array

      fun sub (T a, r, c) = Array.sub (Array.sub (a, r), c)
      fun subr (T a, r) =
     let val a = Array.sub (a, r)
     in fn c => Array.sub (a, c)
     end
      fun update (T a, r, c, x) = Array.update (Array.sub (a, r), c, x)
      fun array (r, c, x) =
     T (Array.tabulate (r, fn _ => Array.array (c, x)))
   end
val sub = Array2.sub
val update = Array2.update
   
val size = 30

fun mkmatrix (rows, cols) =
   let
      val count = ref 1
      val last_col = cols - 1
      val m = Array2.array (rows, cols, 0)
   in
      for (0, rows - 1, fn i =>
       for (0, last_col, fn j =>
        (update (m, i, j, !count)
         ; incr count)));
      m
   end

fun mmult (rows, cols, m1, m2, m3) =
   let
      val last_col = cols - 1
      val last_row = rows - 1
   in
      for (0, last_row, fn i =>
       for (0, last_col, fn j =>
        update (m3, i, j,
            let
               val m1i = Array2.subr (m1, i)
               fun loop (k, sum) =
                  if k < 0
                 then sum
                  else loop (k - 1,
                     sum + m1i k * sub (m2, k, j))
            in loop (last_row, 0)
            end)))
   end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t );

fun main (name, args) =
  let
     val n = atoi (hd (args @ ["1"]))
     val m1 = mkmatrix (size, size)
     val m2 = mkmatrix (size, size)
     val m3 = Array2.array (size, size, 0)
     val _ = for (1, n - 1, fn _ => mmult (size, size, m1, m2, m3))
     val _ = mmult (size, size, m1, m2, m3)
  in
     printl [Int.toString (sub (m3, 0, 0)),
         " ",
         Int.toString (sub (m3, 2, 3)),
         " ",
         Int.toString (sub (m3, 3, 2)),
         " ",
         Int.toString (sub (m3, 4, 4))];
     OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("matrix", Test.main)

(* -*- mode: sml -*-
 * $Id: methcall.smlnj,v 1.2 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 *)


structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end

structure Toggle =
   struct
      datatype 'a t = T of {
                state: 'a ref,
                value: 'a t -> 'a,
                activate: 'a t -> 'a t
                }

      fun new state =
     T {state = ref state,
        value = fn T {state, ...} => !state,
        activate = fn this as T {state, ...} => (state := not(!state); this)}

      fun activate (this as T {activate, ...}) = activate this
      fun value (this as T {value, ...}) = value this
   end

structure Ntoggle =
   struct
      datatype 'a t = T of {
                state: 'a ref,
                value: 'a t -> 'a,
                activate: 'a t -> 'a t,
                countMax: int,
                counter: int ref
                }

      fun new (state, countMax) =
     T {
        state = ref state,
        value = fn T {state, ...} => !state,
        activate = (fn this as T {state, counter, countMax, ...} =>
            let
               val newCounter = 1 + !counter
               val _ = counter := newCounter
               val _ = 
                  if !counter >= countMax
                 then (state := not(!state);
                       counter := 0)
                  else ()
            in
               this
            end),
        countMax = countMax,
        counter = ref 0
        }

      fun activate (this as T {activate, ...}) = activate this
      fun value (this as T {value, ...}) = value this
   end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )
   
fun main (name, args) =
   let
      val n = atoi (hd (args @ ["1"]))
      val v = ref true
      val tog = Toggle.new true
      val _ = for (0, n - 1, fn _ => v := Toggle.value (Toggle.activate tog))
      val _ = print (if !v then "true\n" else "false\n")
      val _ = v := true
      val ntog = Ntoggle.new (!v, 3)
      val _ = for (0, n - 1, fn _ => v := Ntoggle.value (Ntoggle.activate ntog))
      val _ = print (if !v then "true\n" else "false\n")
   in
      OS.Process.success
   end
end

val _ = SMLofNJ.exportFn("methcall", Test.main);

(* -*- mode: sml -*-
 * $Id: nestedloop.smlnj,v 1.3 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun loopF 0 x = x
  | loopF n x = loopF (n-1) (x+1)

fun loopE 0 m x = x
  | loopE n m x = loopE (n-1) m (loopF m x);

fun loopD 0 m x = x
  | loopD n m x = loopD (n-1) m (loopE m m x);

fun loopC 0 m x = x
  | loopC n m x = loopC (n-1) m (loopD m m x);

fun loopB 0 m x = x
  | loopB n m x = loopB (n-1) m (loopC m m x);

fun loopA 0 m x = x
  | loopA n m x = loopA (n-1) m (loopB m m x);


fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
  let
    val arg = hd(args @ ["1"]);
    val num = atoi arg;
    val result = loopA num num 0
  in
      print (Int.toString result); print "\n";
      OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("nestedloop", Test.main);

(* -*- mode: sml -*-
 * $Id: objinst.smlnj,v 1.3 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 *)


structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end

structure Toggle =
   struct
      datatype 'a t = T of {
                state: 'a ref,
                value: 'a t -> 'a,
                activate: 'a t -> 'a t
                }

      fun new state =
     T {state = ref state,
        value = fn T {state, ...} => !state,
        activate = fn this as T {state, ...} => (state := not(!state); this)}

      fun activate (this as T {activate, ...}) = activate this
      fun value (this as T {value, ...}) = value this
   end

structure Ntoggle =
   struct
      datatype 'a t = T of {
                state: 'a ref,
                value: 'a t -> 'a,
                activate: 'a t -> 'a t,
                countMax: int,
                counter: int ref
                }

      fun new (state, countMax) =
     T {
        state = ref state,
        value = fn T {state, ...} => !state,
        activate = (fn this as T {state, counter, countMax, ...} =>
            let
               val newCounter = 1 + !counter
               val _ = counter := newCounter
               val _ = 
                  if !counter >= countMax
                 then (state := not(!state);
                       counter := 0)
                  else ()
            in
               this
            end),
        countMax = countMax,
        counter = ref 0
        }

      fun activate (this as T {activate, ...}) = activate this
      fun value (this as T {value, ...}) = value this
   end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )
   
fun main (name, args) =
   let
      val n = atoi (hd (args @ ["1"]))
      val v = ref true
      val tog = Toggle.new true
      val _ = for (0, 4, fn _ =>
           print (if Toggle.value (Toggle.activate tog)
                 then "true\n"
              else "false\n"))

          
      val r = ref (Toggle.new false)
      val _ = for (0, n - 1, fn _ => r := Toggle.new true)
      val _ = Toggle.activate (!r)


      val _ = print "\n"
      val ntog = Ntoggle.new (true, 3)
      val _ = for (0, 7, fn _ =>
           print (if Ntoggle.value (Ntoggle.activate ntog)
                 then "true\n"
              else "false\n"))


      val r2 = ref (Ntoggle.new (true, 3))
      val _ = for (0, n - 1, fn _ => r2 := Ntoggle.new (true, 3))
      val _ = Ntoggle.activate (!r2)

   in
      OS.Process.success
   end
end

val _ = SMLofNJ.exportFn("objinst", Test.main);

(* -*- mode: sml -*-
 * $Id: prodcons.smlnj,v 1.1 2001/09/01 01:40:21 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Matthias Blume
 *)

(* producer-consumer threads in SML/NJ
 * (concurrency primitives re-implemented "by hand" on top of call/cc
 * using the code in John Reppy's book "Concurrent Programming in ML")
 *
 * (C) 2001 Lucent Technologies, Bell Labs
 * written by Matthias Blume
 *)

structure Queue :> sig
    exception Empty
    type tt = unit SMLofNJ.Cont.cont
    type q
    val new : unit -> q
    val enqueue : q * tt -> unit
    val dequeue : q -> tt
    val empty : q -> bool
end = struct

    exception Empty

    type tt = unit SMLofNJ.Cont.cont
    type q = tt list ref * tt list ref

    fun new () : q = (ref [], ref [])

    fun enqueue ((f as ref [], ref []) : q, x) = f := [x]
      | enqueue ((_, b as ref xs), x) = b := x :: xs

    fun dequeue ((f, b) : q) =
    case !f of
        [] => (case rev (!b) of
               x :: xs => (f := xs; b := []; x)
             | [] => raise Empty)
      | x :: xs => (f := xs; x)

    fun empty ((ref [], ref []) : q) = true
      | empty _ = false

end

structure Mutex :> sig

    val yield : unit -> unit
    val fork : (unit -> unit) -> unit
    val exit : unit -> 'a

    type mutex
    type condition

    val mutex : unit -> mutex
    val lock : mutex -> unit
    val unlock : mutex -> unit

    val condition : mutex -> condition
    val wait : condition -> unit
    val signal : condition -> unit

    val run : (unit -> unit) * Time.time -> unit

end = struct

    local
    structure C = SMLofNJ.Cont
    structure Q = Queue
    type tt = unit C.cont

    (* We take the easy way out: Simply drop signals that
     * arrive during an atomic section on the floor.  This is
     * enough for our purpose and simplifies the coding... *)
    val atomicState = ref false
    fun atomicBegin () = atomicState := true
    fun atomicEnd () = atomicState := false
    val readyQ : Q.q = Q.new ()

    fun dispatch () = C.throw (Q.dequeue readyQ) ()

    fun sigH (_: Signals.signal, _: int, k: tt) =
        if !atomicState then k
        else (Q.enqueue (readyQ, k); Q.dequeue readyQ)
    in
        
        fun yield () =
        (atomicBegin ();
         C.callcc (fn k => (Q.enqueue (readyQ, k); dispatch ()));
         atomicEnd ())

    fun exit () = (atomicBegin (); dispatch ())

    fun fork f = let
        val k = C.isolate (fn () => (atomicEnd ();
                     f () handle _ => ();
                     exit ()))
    in
        atomicBegin ();
        Q.enqueue (readyQ, k);
        atomicEnd ()
    end

    
        datatype mutex = Mutex of { locked : bool ref, blocked : Q.q }

    fun mutex () = Mutex { locked = ref false, blocked = Q.new () }

    fun lock (Mutex { locked, blocked }) =
        (atomicBegin ();
         if !locked then
         C.callcc (fn k => (Q.enqueue (blocked, k);
                    dispatch ()))
         else locked := true;
         atomicEnd ())

    fun unlock (Mutex { locked, blocked }) =
        (atomicBegin ();
         if Q.empty blocked then locked := false
         else C.callcc (fn k => (Q.enqueue (readyQ, k);
                     C.throw (Q.dequeue blocked) ()));
         atomicEnd ())


        
    datatype condition = Cond of { mutex : mutex, waiting : Q.q }

    fun condition m = Cond { mutex = m, waiting = Q.new () }

    fun wait (Cond { mutex = m as Mutex { locked, blocked }, waiting }) =
        (atomicBegin ();
         C.callcc (fn k =>
              (Q.enqueue (waiting, k);
               if Q.empty blocked then (locked := false;
                            dispatch ())
               else C.throw (Q.dequeue blocked) ()));
         if !locked then
         C.callcc (fn k => (Q.enqueue (blocked, k);
                    dispatch ()))
         else locked := true;
         atomicEnd ())

    fun signal (Cond { waiting, ... }) =
        (atomicBegin ();
         if Q.empty waiting then ()
         else Q.enqueue (readyQ, Q.dequeue waiting);
         atomicEnd ())

    fun run (f, t) = let
        val oh = Signals.setHandler (Signals.sigALRM,
                     Signals.HANDLER sigH)
        val _ = SMLofNJ.IntervalTimer.setIntTimer (SOME t)
        fun reset () =
        (ignore (Signals.setHandler (Signals.sigALRM, oh));
         SMLofNJ.IntervalTimer.setIntTimer NONE)
             
    in
        (f () handle e => (reset (); raise e))
        before reset ()
    end
    end
end

structure ProdCons : sig
    val main : string * string list -> OS.Process.status
end = struct

    fun doit n = let

    val c_running = Mutex.mutex ()
    val p_running = Mutex.mutex ()

    val consumer's_turn = ref false
    val data = ref 0
    val produced = ref 0
    val consumed = ref 0
    val m = Mutex.mutex ()
    val c = Mutex.condition m

    fun producer () = let
        fun wait () = if !consumer's_turn then wait (Mutex.wait c) else ()
        fun loop i =
        if i <= n then
            let val _ = Mutex.lock m
            val _ = wait ()
            in
            data := i;
            consumer's_turn := true;
            produced := !produced + 1;
            Mutex.signal c;
            Mutex.unlock m;
            loop (i + 1)
            end
        else ()
    in
        loop 1 before Mutex.unlock p_running
    end
         
    fun consumer () = let
        fun wait () = if !consumer's_turn then () else wait (Mutex.wait c)
        fun loop () = let
        val _ = Mutex.lock m
        val _ = wait ()
        val i = !data
        in
        consumer's_turn := false;
        consumed := !consumed + 1;
        Mutex.signal c;
        Mutex.unlock m;
        if i <> n then loop () else ()
        end
    in
        loop () before Mutex.unlock c_running
    end

    
    val _ = Mutex.lock p_running
    val _ = Mutex.lock c_running

    val p = Mutex.fork producer
    val c = Mutex.fork consumer
    in
    
    Mutex.lock p_running;
    Mutex.lock c_running;

    TextIO.output (TextIO.stdOut,
               concat [Int.toString (!produced), " ",
                   Int.toString (!consumed), "\n"])
    end

    fun main (_, args) = let
    val n = case args of [] => 1
               | (x :: _) => getOpt (Int.fromString x, 1)
    in
    Mutex.run (fn () => doit n, Time.fromMilliseconds 1);
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("prodcons", ProdCons.main);

(* -*- mode: sml -*-
 * $Id: random.smlnj,v 1.5 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

val im : int = 139968;
val ia : int = 3877;
val ic : int = 29573;

fun randloop 0 seed rand max = rand
  | randloop n seed rand max = 
    let
    val newseed : int = (seed * ia + ic) mod im;
    val newrand : real = max * (Real.fromInt newseed) / (Real.fromInt im);
    in
        randloop (n-1) newseed newrand max
    end;


fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
  let
    val arg = hd(args @ ["1"]);
    val num = atoi arg;
    val result = randloop num 42 0.0 100.0;
  in
      print (Real.fmt (StringCvt.FIX (SOME 9)) result); print "\n";
      OS.Process.success
  end
end

val _ = SMLofNJ.exportFn("random", Test.main);

(* -*- mode: sml -*-
 * $Id: regexmatch.smlnj,v 1.1 2001/07/10 13:04:21 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 * "ported" to SML/NJ
 * with help from Daniel Wang
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct


fun ++ (r: int ref): int =
   let
      val n = 1 + !r
      val _ = r := n
   in n
   end

structure Int =
   struct
      open Int

      type t = int
     
      fun exists (start: t, stop: t, f: t -> bool): bool =
     let
        fun loop i = i < stop andalso (f i orelse loop (i + 1))
     in
        loop start
     end

      fun forall (start, stop, f) = not (exists (start, stop, not o f))

      fun fold (start: t, stop: t, a: 'a, f: t * 'a -> 'a): 'a =
     let
        fun loop (i: t, a: 'a) =
           if i >= stop
          then a
           else loop (i + 1, f (i, a))
     in loop (start, a)
     end
           
      fun for (start: t, stop: t, f: t -> unit): unit =
     let
        fun loop i =
           if i >= stop
          then ()
           else (f i; loop (i + 1))
     in
        loop start
     end
   end

structure Array2 =
   struct
      open Array2

      type 'a t = 'a array

      val new = array

      fun tabulate (r, c, f) = Array2.tabulate RowMajor (r, c, f)

      fun foreachi (a, f) =
     appi RowMajor f {base = a, row = 0, col = 0,
              nrows = NONE, ncols = NONE}
   end

structure Vector =
   struct
      open Vector

      fun exists (v, f) =
     Int.exists (0, length v, fn i => f (sub (v, i)))
      fun foreach (v, f) = app f v
      fun foreachi (v, f) = appi f (v, 0, NONE)
      fun new (n, x) = tabulate (n, fn _ => x)
      fun new1 x = new (1, x)
   end

structure List =
   struct
      open List

      fun foreach (l, f) = app f l

      fun fold (l, b, f) = foldl f b l

      fun appendRev (l1, l2) = fold (l1, l2, op ::)

      fun push (r, x) = r := x :: !r

      fun keepAll (l, f) = filter f l

      fun peek (l, f) = find f l

      fun insert (l, x, op <=) =
     let
        fun loop (l, ac) =
           case l of
          [] => appendRev (ac, [x])
        | x' :: l' =>
             if x <= x'
            then appendRev (ac, x :: l)
             else loop (l', x' :: ac)
     in loop (l, [])
     end
   end

structure Array =
   struct
      open Array

      val new = array

      fun modify (a, f) = Array.modify f a

      fun foreachi (a, f) = appi f (a, 0, NONE)
     
      fun indices (a: bool array): int vector =
     let
        val n = Array.length a
        val numTrue =
           let
          fun loop (i, count) =
             if i = n
            then count
             else loop (i + 1,
                if Array.sub (a, i)
                   then count + 1
                else count)
           in loop (0, 0)
           end
        val next = ref 0
        fun loop i =
           if Array.sub (a, i)
          then (next := i + 1; i)
           else loop (i + 1)
     in Vector.tabulate (numTrue, fn _ => loop (!next))
     end
   end

structure Char =
   struct
      open Char
     
      val fromInt = chr
      val toInt = ord
   end

structure String =
   struct
      open String

      type t = string
     
      fun contains (s: t, c: char): bool =
     Int.exists (0, size s, fn i => c = sub (s, i))
   end

val numChars: int = 128

structure Regexp =
   struct
      datatype t =
     AnchorStart
       | CharSet of char -> bool
       | Or of t list
       | Seq of t list
       | Star of t
   end

structure Stack:
   sig
      type 'a t

      val clear: 'a t -> unit
      val exists: 'a t * ('a -> bool) -> bool
      val foreach: 'a t * ('a -> unit) -> unit
      val new: int * 'a -> 'a t
      val push: 'a t * 'a -> unit
   end =
   struct
      datatype 'a t = T of {elts: 'a array,
                size: int ref}

      fun new (size: int, dummy: 'a): 'a t =
     T {elts = Array.new (size, dummy),
        size = ref 0}

      fun push (T {elts, size}, x) =
     let
        val n = !size
        val _ = Array.update (elts, n, x)
        val _ = size := n + 1
     in ()
     end

      fun exists (T {elts, size, ...}, f) =
     Int.exists (0, !size, fn i => f (Array.sub (elts, i)))
     
      fun foreach (T {elts, size}, f) =
     Int.for (0, !size, fn i => f (Array.sub (elts, i)))

      fun clear (T {size, ...}) = size := 0
   end


structure NFA:
   sig
      (* The states in an NFA are indexed from 0 to n-1, where n is the number
       * of states.
       *)
      type state = int

      (* State i is final iff Array.sub (final, i).
       * The outgoing states from state i on input char c are given by
       * Array2.sub (next, i, Char.ord c).
       * anchorStarts is sorted in increasing order of state index.
       *)
      datatype t = T of {anchorStarts: state list,
             final: bool array,
             seen: bool array, 
             stack1: int Stack.t, 
             stack2: int Stack.t, 
             start: state,
             next: state vector Array2.t}
     
      val fromRegexp: Regexp.t -> t
      val match: {nfa: t,
          string: string,
          startPos: int,
          anchorStart: bool} -> int option
      val numStates: t -> int
   end =
   struct
      type state = int
      datatype t = T of {anchorStarts: state list,
             final: bool array,
             seen: bool array,
             stack1: int Stack.t,
             stack2: int Stack.t,
             start: state,
             next: state vector Array2.t}

      fun numStates (T {next, ...}) = Array2.nRows next


      (* Simulating an NFA with two stacks and a bit vector, as in Algorithm 3.4
       * (page 126) of Compilers: Principles, Techniques, and Tools by Aho,
       * Sethi, and Ullman.
       *)
      fun match {anchorStart: bool,
         nfa as T {anchorStarts, final, seen, stack1, stack2, start,
               next},
         startPos,
         string = s}: int option =
     let
        val numStates = numStates nfa
        val n = String.size s
        val _ = Array.modify (seen, fn _ => false)
        fun loop (current: state Stack.t,
              nextStates: state Stack.t,
              i: int,
              last: int option): int option =
           let
          val last = 
             if Stack.exists (current, fn s => Array.sub (final, s))
            then SOME i
             else last
           in
          if numStates = 0 orelse i = n
             then (Stack.clear stack1
               ; Stack.clear stack2
               ; last)
          else
             let
            val _ = Array.modify (seen, fn _ => false)
            val c = Char.toInt (String.sub (s, i))
            val _ =
               Stack.foreach (current, fn s =>
                      Vector.foreach
                      (Array2.sub (next, s, c),
                       fn s' =>
                       if Array.sub (seen, s')
                          then ()
                       else (Array.update (seen, s', true)
                         ; Stack.push (nextStates, s'))))
            val _ = Stack.clear current
             in loop (nextStates, current, i + 1, last)
             end
           end
        val _ = Stack.push (stack1, start)
        val _ =
           if anchorStart
          then List.foreach (anchorStarts, fn s =>
                     Stack.push (stack1, s))
           else ()
     in
        loop (stack1, stack2, startPos, NONE)
     end

      (* This conversion from a regular expression to an NFA is based on
       * Section 3.9 (pages 134 -- 140) of Compilers: Principles, Techniques,
       * and Tools by Aho, Sethi, and Ullman.
       *
       * It creates one NFA state for each CharSet (called a "position") that is
       * in the regexp.  There is also one extra state for the start state.
       * It adds edges as in rules 1 and 2 (page 138) for the followpos function.
       *)
      fun fromRegexp (r: Regexp.t): t =
     let
        fun loop (r, ac) =
           let open Regexp
           in case r of
          AnchorStart => ac + 1
        | CharSet _ => ac + 1
        | Or rs => List.fold (rs, ac, loop)
        | Seq rs => List.fold (rs, ac, loop)
        | Star r => loop (r, ac)
           end
        val numPos = loop (r, 0)
        val numStates = numPos + 1
        val start = numPos
        val posCounter = ref ~1
        val follow = Array2.new (numStates, numStates, false)
        val posChars = Array2.tabulate (numPos, numChars, fn _ => false)
        local
           datatype t = T of bool vector 
        in
           fun contains (T v, s) = Vector.sub (v, s)
           val empty: t = T (Vector.new (numPos, false))
           fun union (T v, T v'): t =
          T (Vector.tabulate (numPos, fn i =>
                      Vector.sub (v, i)
                      orelse Vector.sub (v', i)))
           fun singleton (i: int): t =
          T (Vector.tabulate (numPos, fn j => i = j))
           fun foreach (T v, f) =
          Vector.foreachi (v, fn (i, b) => if b then f i else ())
        end
        val anchorStarts = ref []
        
        fun loop r =
           case r of
          Regexp.AnchorStart =>
             let
            val i = ++ posCounter
            val _ = List.push (anchorStarts, i)
            val first = singleton i
             in
            {first = first,
             last = first,
             nullable = false}
             end
        | Regexp.CharSet f =>
             let
            val i = ++ posCounter
            val _ =
               Int.for (0, numChars, fn c =>
                    if f (Char.chr c)
                       then Array2.update (posChars, i, c, true)
                    else ())
            val first = singleton i
             in {first = first,
             last = first,
             nullable = false}
             end
        | Regexp.Or rs =>
             List.fold
             (rs, {first = empty,
               last = empty,
               nullable = false},
              fn (r, {first = f, last = l, nullable = n}) =>
              let
             val {first = f', last = l', nullable = n'} =
                loop r
              in
             {first = union (f, f'),
              last = union (l, l'),
              nullable = n orelse n'}
              end)
        | Regexp.Seq rs =>
             List.fold
             (rs, {first = empty,
               last = empty,
               nullable = true},
              fn (r, {first = f, last = l, nullable = n}) =>
              let
             val {first = f', last = l', nullable = n'} =
                loop r
             val _ =
                foreach
                (l, fn s =>
                 foreach
                 (f', fn s' => Array2.update (follow, s, s', true)))
              in
             {first = if n then union (f, f') else f,
              last = if n' then union (l, l') else l',
              nullable = n andalso n'}
              end)
        | Regexp.Star r =>
             let
            val {first = f, last = l, nullable = n} = loop r
            val _ =
               foreach
               (l, fn s =>
                foreach
                (f, fn s' => Array2.update (follow, s, s', true)))
             in
            {first = f, last = l, nullable = true}
             end
        val {first, last, nullable} = loop r
        (* Any anchor starts in first should be anchor starts.
         * This also reverses anchorStarts so they are in order.
         *)
        val anchorStarts =
           List.fold (!anchorStarts, [], fn (s, ac) =>
              if contains (first, s) then s :: ac else ac)
        
        val _ = foreach (first, fn i =>
                 Array2.update (follow, start, i, true))
        
        val final = Array.array (numStates, false)
        val _ = foreach (last, fn i => Array.update (final, i, true))
        
        val _ = if nullable then Array.update (final, start, true) else ()
        
        val a = Array.new (numStates, false)
        val next =
           Array2.tabulate
           (numStates, numChars, fn (i, c) =>
        let
           val _ =
              Int.for (0, numStates, fn j => Array.update (a, j, false))
           val _ =
              Int.for
              (0, numPos, fn j =>
               if Array2.sub (follow, i, j)
              andalso Array2.sub (posChars, j, c)
              then Array.update (a, j, true)
               else ())
        in Array.indices a
        end)
     in
        T {anchorStarts = anchorStarts,
           final = final,
           next = next,
           seen = Array.new (numStates, false),
           stack1 = Stack.new (numStates, ~1),
           stack2 = Stack.new (numStates, ~1),
           start = start}
     end
      
   end

structure DFA:
   sig
      type t

      val fromNFA: NFA.t -> t
      val match: {dfa: t,
          string: string,
          startPos: int,
          anchorStart: bool} -> int option
      val minimize: t -> t
   end =
   struct
      (* The states in a DFA are indexed from 0 to n-1, where n is the number
       * of states.
       *)
      type state = int
     
      (* State i is final iff Array.sub (final, i).
       * The outgoing state from state i on input char c is
       * Array2.sub (next, i, Char.ord c).
       *)
      datatype t = T of {anchorStart: state,
             dead: bool array,
             final: bool array,
             next: state Array2.t,
             start: state}

      fun numStates (T {next, ...}): int = Array2.nRows next


      fun match {dfa as T {anchorStart = ancSt, dead, final, start, next},
         string as s,
         startPos: int,
         anchorStart: bool}: int option =
     let
        val n = String.size s
        fun loop (i: int, state: int, last: int option): int option =
           let
          val last =
             if Array.sub (final, state)
            then SOME i
             else last
           in
          if Array.sub (dead, state) orelse i = n
             then last
          else loop (i + 1,
                 Array2.sub (next, state,
                     Char.toInt (String.sub (s, i))),
                 last)
           end
     in loop (startPos,
          if anchorStart then ancSt else start,
             NONE)
     end

      fun dead (numStates, final, next) =
     Array.tabulate
     (numStates, fn i =>
      not (Array.sub (final, i))
      andalso Int.forall (0, numChars, fn c =>
                  i = Array2.sub (next, i, c)))
     
      (* This DFA minimization algorithm is based on algorithm 3.6 (page 142)
       * of Compilers: Principles, Techniques, and Tools by Aho, Sethi, and
       * Ullman. 
       *
       * It maintains an array, r, that stores for each state s the
       * representative of the class to which s belongs.
       * It repeatedly refines an equivalence relation, represented by a list
       * of classes, where each class is a list of states (i.e. ints).
       *)
      fun minimize (dfa as T {anchorStart, final, start, next, ...}): t =
     let
        val numStates = numStates dfa
        type class = int list
        type classes = class list
        val repCounter = ref ~1
        val change = ref false
        fun newRep () = (change := true; ++ repCounter)
        val finRep = newRep ()
        val nonfinRep = newRep ()
        val r = Array.tabulate (numStates, fn i =>
                    if Array.sub (final, i)
                       then finRep
                    else nonfinRep)
        fun rep s = Array.sub (r, s)
        fun trans (s, c) = rep (Array2.sub (next, s, c))
        fun refine (class: class, ac: classes): classes =
           let
          val r =
             List.fold
             (class, [], fn (state, classes) =>
              let
             fun loop (classes, ac) =
                case classes of
                   [] =>
                  (case ac of
                      [] => [{class = [state],
                          old = state}]
                    | _ => 
                     let
                        val s = newRep ()
                        val _ = Array.update (r, state, s)
                     in {class = [state],
                         old = state} :: ac
                     end)
                 | (z as {class, old}) :: classes =>
                  if Int.forall
                     (0, numChars, fn c =>
                      trans (old, c) = trans (state, c))
                     then
                    (Array.update (r, state, rep old)
                     ; {class = state :: class,
                        old = old} :: (List.appendRev
                               (classes, ac)))
                  else loop (classes, z :: ac)
              in loop (classes, [])
              end)
           in List.fold (r, ac, fn ({class, ...}, ac) =>
                 case class of
                [_] => ac
                  | _ => class :: ac)
           end
        fun refineAll (classes: classes): unit =
           case classes of
          [] => ()
        | _ =>
             let
            val _ = change := false
            val classes =
               List.fold (classes, [], fn (class, ac) =>
                      case class of
                     [_] => ac
                       | _ => refine (class, ac))
             in if !change
               then refineAll classes
            else ()
             end
        val (fin, nonfin) =
           Int.fold (0, numStates, ([], []), fn (i, (f, n)) =>
             if Array.sub (final, i)
                then (i :: f, n)
             else (f, i :: n))
        val _ = refineAll [fin, nonfin]
        val numStates' = 1 + !repCounter
        
        val reached = Array.new (numStates', false)
        fun visit (s: int ): unit =
           let
          val s' = rep s
           in
          if Array.sub (reached, s')
             then ()
          else (Array.update (reached, s', true)
            ; Int.for (0, numChars, fn c =>
                   visit (Array2.sub (next, s, c))))
           end
        val _ = visit start
        val _ = visit anchorStart
        
        val c = ref ~1
        val newR = Array.tabulate (numStates', fn s =>
                       if Array.sub (reached, s)
                      then ++ c
                       else ~1)
        val numStates' = 1 + !c
        val _ = Array.modify (r, fn s => Array.sub (newR, s))
        val next' = Array2.new (numStates', numChars, ~1)
        val _ =
           Array2.foreachi
           (next, fn (s, c, s') =>
        Array2.update (next', rep s, c, rep s'))
        val final' = Array.array (numStates', false)
        val _ =
           Array.foreachi
           (final, fn (i, b) =>
        if b then Array.update (final', rep i, true) else ())
     in T {anchorStart = rep anchorStart,
           dead = dead (numStates', final', next'),
           final = final',
           start = rep start,
           next = next'}
     end

      (* This is the usual "subset construction", as in algorithm 3.2 (page 118)
       * of Compilers: Principles, Techniques, and Tools by Aho, Sethi, and
       * Ullman.
       *
       * It associates each (reachable) set of states in the nfa with a single
       * state in the DFA.
       *)
      fun fromNFA (nfa as NFA.T {anchorStarts, final, start, next, ...}) =
     let
        
        type states = state vector
        val counter = ref ~1
        type work = {states: states,
             state: int,
             out: int vector option ref}
        val cache: work list ref = ref []
        val todo: work list ref = ref []
        fun statesToState (ss: states): int =
           case List.peek (!cache, fn {states, ...} => ss = states) of
          NONE =>
             let
            val state = ++ counter
            val work = {out = ref NONE,
                    state = state,
                    states = ss}
            val _ = List.push (cache, work)
            val _ = List.push (todo, work)
             in
            state
             end
        | SOME {state, ...} => state
        local
           val seen = Array.array (NFA.numStates nfa, false)
        in
           fun loop () =
          case !todo of
             [] => ()
           | {states, out, ...} :: rest =>
            (todo := rest
             ; out := (SOME
                   (Vector.tabulate
                    (numChars, fn c =>
                     let
                    val _ =
                       Array.modify (seen, fn _ => false)
                    val _ = 
                       Vector.foreach
                       (states, fn s =>
                        Vector.foreach
                        (Array2.sub (next, s, c), fn s' =>
                         Array.update (seen, s', true)))
                     in statesToState (Array.indices seen)
                     end)))
             ; loop ())
        end
        
        val start' = statesToState (Vector.new1 start)
        val anchorStart' =
           statesToState
           (Vector.fromList (List.insert (anchorStarts, start, op <=)))
        val _ = loop ()
        val numStates = 1 + !counter
        val next' = Array2.new (numStates, numChars, ~1)
        val final' = Array.new (numStates, false)
        val _ =
           List.foreach
           (!cache, fn {states, state = i, out, ...}: work =>
        let
           val _ =
              Vector.foreachi
              (valOf (! out), fn (c, j) =>
               Array2.update (next', i, c, j))
           val _ =
              if Vector.exists (states, fn s => Array.sub (final, s))
             then Array.update (final', i, true)
              else ()
        in ()
        end)
        val dead' = dead (numStates, final', next')
     in T {anchorStart = anchorStart',
           dead = dead',
           final = final',
           start = start',
           next = next'}
     end

   end

structure Regexp:
   sig
      structure Compiled:
     sig
        type t

        
        val find: t * string -> {start: int, length: int} option
     end

      type t

      val anchorStart: t
      val any: t
      val char: char -> t
      val compileDFA: t -> Compiled.t
      val compileNFA: t -> Compiled.t
      val digit: t
      val nonDigit: t
      val notOneOf: string -> t
      val oneOf: string -> t
      val or: t list -> t
      val seq: t list -> t
      val star: t -> t
   end =
   struct
      open Regexp

      val anchorStart = AnchorStart
      val isChar = CharSet
      fun isNotChar f = isChar (not o f)
      fun char c = isChar (fn c' => c = c')
      val or = Or
      val seq = Seq
      val star = Star

      val any = isChar (fn _ => true)

      fun oneOf s = isChar (fn c => String.contains (s, c))
      fun notOneOf s = isNotChar (fn c => String.contains (s, c))
      val digs = "0123456789"
      val digit = oneOf digs
      val nonDigit = notOneOf digs

      val empty = Or [] 
      val emptyString = Seq [] 

     
      structure Compiled =
     struct
        datatype t =
           DFA of DFA.t
         | NFA of NFA.t

        fun find (c: t, s: string) =
           let
          val n = String.size s
          fun loop (i: int, anchorStart: bool) =
             if i = n
            then NONE
             else
            let
               val res =
                  case c of
                 DFA dfa =>
                    DFA.match {dfa = dfa,
                           string = s,
                           startPos = i,
                           anchorStart = anchorStart}
                   | NFA nfa =>
                    NFA.match {nfa = nfa,
                           string = s,
                           startPos = i,
                           anchorStart = anchorStart}
            in
               case res of
                  NONE => loop (i + 1, false)
                | SOME finish => SOME {start = i,
                           length = finish - i}
            end
           in loop (0, true)
           end
     end

      fun compileDFA r =
     Compiled.DFA (DFA.minimize (DFA.fromNFA (NFA.fromRegexp r)))
      fun compileNFA r =
     Compiled.NFA (NFA.fromRegexp r)
   end

local
   open Regexp
in
   val d = digit
   val eol = char #"#"
   val space = oneOf " \t"
   val r =
      seq [or [anchorStart, notOneOf "0123456789("],
       or [seq [char #"(", d, d, d, char #")"],
           seq [d, d, d]],
       char #" ",
       d, d, d,
       oneOf " -",
       d, d, d, d,
       or [eol, nonDigit]]

   val comp = Regexp.compileDFA r
end

fun incr (r: int ref) = r := !r + 1

val ins = TextIO.stdIn



fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )


   
local
   val form = "(...) ...-...."
   val a = CharArray.tabulate (String.size form, fn i =>
                   String.sub (form, i))
in
   fun checkPhone (mustPrint: bool, cnt: int ref, line: string) =
      case Regexp.Compiled.find (comp, line) of
     NONE => ()
       | SOME {start = pos, ...} =>
        let
           fun blit (src, dst, length) =
          let
             val stop = src + length
             fun loop (src, dst) =
            if src = stop
               then ()
            else (CharArray.update (a, dst,
                        String.sub (line, src))
                  ; loop (src + 1, dst + 1))
          in
             loop (src, dst)
          end
           val (o1, o2, o3) =
          if #"(" = String.sub (line, pos)
             then (1, 6, 10)
          else if #"(" = String.sub (line, pos + 1)
              then (2, 7, 11)
               else if Char.isDigit (String.sub (line, pos))
                   then (0, 4, 8)
                else (1, 5, 9)
           val _ = blit (pos + o1, 1, 3)
           val _ = blit (pos + o2, 6, 3)
           val _ = blit (pos + o3, 10, 4)
           val _ =
          if mustPrint
             then printl [Int.toString (!cnt), ": ",
                  CharArray.extract (a, 0, NONE)]
          else ()
           val _ = incr cnt
        in
           ()
        end
end

fun doit (phones,mustPrint: bool): unit =
   let val cnt = ref 1
   in List.foreach (phones, fn line => checkPhone (mustPrint, cnt, line))
   end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0
   
fun main (name, args) =
   let
      val n = atoi (hd (args @ ["1"]))
      val phones = 
    let
      fun loop lines =
        case TextIO.inputLine ins of
          "" => rev lines
        | line => loop (line :: lines)
    in loop []
    end
      val _ = Int.for (1, n, fn _ => doit (phones,false))
      val _ = doit (phones,true)
   in OS.Process.success
   end
end
val _ = SMLofNJ.exportFn("regexmatch", Test.main);

(* -*- mode: sml -*-
 * $Id: reversefile.smlnj,v 1.4 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Tom 7
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

val bufsize = 4096
val rdbufsize = 4096

val stdout = Posix.FileSys.wordToFD 0w1
val stdin = Posix.FileSys.wordToFD 0w0

datatype block = END
               | MORE of int ref * Word8Array.array * block

val buff = Unsafe.Word8Array.create rdbufsize

fun out END = ()
  | out (MORE (ir as ref i, a, next)) =
  let in
    Posix.IO.writeArr (stdout, {buf=a, i=i, sz=NONE});
    out next
  end

fun rd (start, len, count, b) =
  if (start + len) >= count then 
    (* done with this block. 
       Copy from start to the end of the array into
       buff, then return the starting index into buff. *)
    let in
      Word8Array.copy {di=0,
                       dst=buff,
                       src=buff,
                       len=SOME len,
                       si=start};
      (b, len)
    end
  else
    if Unsafe.Word8Array.sub(buff, start + len) = 0w10 then
      
      case b of MORE(ir as ref i, a, _) =>
        if i > len then
            let in
              
              Word8Array.copy {di=i-len - 1,
                               dst=a,
                               len=SOME(len + 1),
                               si=start,
                               src=buff};
              ir := i - (len + 1);
              
              rd(start + len + 1, 0, count, b)
            end
          else 
            let
              
              val na = Unsafe.Word8Array.create bufsize
              val l = (len + 1) - i
            in
              
              Word8Array.copy {di=0,
                               dst=a,
                               len=SOME i,
                               si=(start + len + 1) - i,
                               src=buff};
              
              
              Word8Array.copy {di=bufsize - l,
                               dst=na,
                               len=SOME l,
                               si=start,
                               src=buff};
              ir := 0;
              rd(start + len + 1, 0, count, MORE(ref (bufsize - l), na, b))
            end
    else rd (start, len + 1, count, b)
    
fun loop (b, s) =
  let 
    val count = Posix.IO.readArr (stdin, 
                                  {buf=buff, i=s, sz=SOME (rdbufsize-s)})
    val (bb, bs) = rd (0, s, count + s, b)
  in
    case count of
      0 => out bb
    | _ => loop (bb, bs)
  end

fun main(name, args) =
    ( loop (MORE(ref bufsize, Unsafe.Word8Array.create bufsize, END), 0);
      OS.Process.success);

end

val _ = SMLofNJ.exportFn("reversefile", Test.main);

(* -*- mode: sml -*-
 * $Id: sieve.smlnj,v 1.8 2001/08/20 01:11:11 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * with help from Dan Wang
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct
structure WA = Word8Array
val flags  = WA.array (8193, 0w0)

fun init() = let
  fun loop i =
    if i < 8193 then (WA.update(flags,i,0w1);loop(i+1))
    else ()
in loop 2
end

fun do_elts(i,count) =
  if i < 8193 then
    if WA.sub(flags,i) = 0w1 then let
      fun loop k = 
    if k < 8193 then (WA.update(flags,k,0w0);loop(k+i))
    else ()
    in loop (i + i) ; do_elts(i + 1,count + 1)
    end
    else do_elts(i + 1, count)
  else count

fun repeat 0 = (init (); do_elts(2,0))
  | repeat n = (init (); do_elts(2,0);repeat(n-1))

fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )
fun atoi s = case Int.fromString s of SOME num => num | NONE => 0

fun main(name, param_list) =  let
    val arg = hd(param_list @ ["1"]);
    val num = atoi arg
    val count = repeat num 
    in  printl ["Count: ", Int.toString count];
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("sieve", Test.main);

(* -*- mode: sml -*-
 * $Id: spellcheck.smlnj,v 1.2 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

open TextIO;

fun chop str = String.substring (str, 0, (String.size str) - 1);

fun spellcheck () =
    let
    val dict = HashTable.mkTable (HashString.hashString, op =) (40000, (Fail "not found"))
    in
    let val din = openIn "Usr.Dict.Words"
        fun init_dict din dict =
        ( HashTable.insert dict (chop (inputLine din), 1);
          init_dict din dict )
    in
        init_dict din dict
    end handle EndOfFile => ();

    let fun check_words dict =
        let val word = chop (inputLine stdIn) in
            case HashTable.find dict word of
            SOME _ => ()
              | NONE => (print word ; print "\n");
            check_words dict
        end
    in
        check_words dict
    end handle EndOfFile => ()
    end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;

fun main(name, args) = 
    let
    val arg = hd(args @ ["1"])
    val num = atoi arg
    in
    spellcheck ();
    OS.Process.success
    end
end

val _ = SMLofNJ.exportFn("spellcheck", Test.main);

(* -*- mode: sml -*-
 * $Id: moments.smlnj,v 1.3 2001/07/10 12:55:23 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 * with help from Daniel Wang:
 *   Modified to be more functional and use SML/NJ library sorting function
 *)


structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct
val ins = TextIO.stdIn
fun loop (nums,sum) =
   case TextIO.inputLine ins of
      "" => (nums,sum)
    | l => (case Real.fromString l of
          NONE => raise Fail "invalid input"
        | SOME num => loop(num::nums,sum+num))

fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )

fun r2s (x: real): string =
   if Real.== (x, 0.0) then "0.000000"
   else String.translate
     (fn #"~" => "-" | c => str c)
     (Real.fmt (StringCvt.FIX (SOME 6)) x)
      
fun main(name, args) =  let
  
    val (nums,sum) = loop ([],0.0) 
    val nums = Array.fromList nums 
    val n = Array.length nums
    val n_float = real n
    val mean = sum / n_float
      
    fun moments (x,{average_deviation,variance,skew,kurtosis}) = let
      val deviation = x - mean
      val average_deviation =
    average_deviation + abs(deviation)
      val dev2 = deviation * deviation
      val variance = variance + dev2
      val dev3 = dev2 * deviation
      val skew = skew + dev3
    val dev4 = dev3 * deviation
    val kurtosis = kurtosis + dev4
    in {average_deviation=average_deviation,
    variance=variance,
    skew=skew,
    kurtosis=kurtosis}
    end
    val init = {average_deviation=0.0,
        variance=0.0,
        skew=0.0,
        kurtosis=0.0}

    val {average_deviation,variance,skew,kurtosis} =
      Array.foldl moments init nums
      
    val average_deviation = average_deviation / n_float
    val variance = variance /  real (n - 1);
    val standard_deviation = Real.Math.sqrt (variance)
    val {skew,kurtosis} =
      if variance > 0.0
    then {skew=skew / n_float / variance / standard_deviation,
          kurtosis=kurtosis / n_float / variance / variance - 3.0}
      else {skew=skew,kurtosis=kurtosis}
    
    val _ = ArrayQSort.sort Real.compare nums
    val mid = Int.quot (n, 2)
    val median =
      if Int.rem (n, 2) = 1
    then Array.sub (nums, mid)
      else (Array.sub (nums, mid) + 
        Array.sub (nums, mid - 1)) / 2.0
in
  printl ["n:                  ", Int.toString n, "\n",
      "median:             ", r2s median, "\n",
      "mean:               ", r2s mean, "\n",
      "average_deviation:  ", r2s average_deviation, "\n",
      "standard_deviation: ", r2s standard_deviation, "\n",
      "variance:           ", r2s variance, "\n",
      "skew:               ", r2s skew, "\n",
      "kurtosis:           ", r2s kurtosis];
  OS.Process.success
end
end

val _ = SMLofNJ.exportFn("moments", Test.main);

(* -*- mode: sml -*-
 * $Id: strcat.smlnj,v 1.6 2001/07/10 04:01:48 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 * Modified by Daniel Wang
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )

val stuff = "hello\n"

structure Buffer:
   sig
      type 'a t

      val add: 'a t * 'a array -> unit
      val length: 'a t -> int
      val new: 'a -> 'a t
   end =
   struct
      datatype 'a t = T of {dummy: 'a,
                length: int ref,
                elts: 'a array ref}

      fun add (T {dummy, elts, length}, a) =
     let
        val l = !length
        val e = !elts
        val en = Array.length e
        val an = Array.length a
        val e =
           if l + an >= en then    
         let val e' = Array.array(2 * en,dummy)
           val _ = Array.copy {src = e, si = 0,len = SOME en,
                       dst = e',di = 0}
           val _ = elts := e'
         in e'
         end
           else e
        val _ =
           Array.copy {src = a, si = 0, len = NONE,
               dst = e, di = l}
        val _ = length := l + an
     in ()
     end

      fun new (dummy: 'a) = T {dummy = dummy,
                   length = ref 0,
                   elts = ref (Array.array (32, dummy))}

      fun length (T {length, ...}) = !length
   end

fun main (name, args) =
   let
       val stuff =
       Array.tabulate (String.size stuff, fn i => String.sub (stuff, i))
       val n = atoi (hd (args @ ["1"]))
       val b = Buffer.new #"\000"
       val _ = for (1, n, fn _ => Buffer.add (b, stuff))
       val _ = printl [Int.toString (Buffer.length b)]
   in
       OS.Process.success
   end
end

val _ = SMLofNJ.exportFn("strcat", Test.main);

(* -*- mode: sml -*-
 * $Id: sumcol.smlnj,v 1.3 2001/07/09 00:25:28 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 *)

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

fun sumlines sum =
  if TextIO.endOfStream TextIO.stdIn
  then (print (Int.toString sum); print "\n")
  else case (Int.fromString (TextIO.inputLine TextIO.stdIn)) of
      NONE => sumlines sum
    | SOME i => sumlines (sum + i);

fun main(name, args) = (sumlines 0; OS.Process.success);

end

val _ = SMLofNJ.exportFn("sumcol", Test.main);

(* -*- mode: sml -*-
 * $Id: wordfreq.smlnj,v 1.3 2001/07/09 00:25:29 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Stephen Weeks
 *)

fun for (start, stop, f) =
   let
      fun loop i =
     if i > stop
        then ()
     else (f i; loop (i + 1))
   in
      loop start
   end
fun incr r = r := 1 + !r
val sub = Array.sub
val update = Array.update
   
signature HASH_SET =
   sig
      type 'a t

      val foreach: 'a t * ('a -> unit) -> unit
      (* lookupOrInsert (s, h, p, f)  looks in the set s for an entry with hash h
       * satisfying predicate p.  If the entry is there, it is returned.
       * Otherwise, the function f is called to create a new entry, which is
       * inserted and returned.
       *)
      val lookupOrInsert: 'a t * word * ('a -> bool) * (unit -> 'a) -> 'a
      val new: {hash: 'a -> word} -> 'a t
      val size: 'a t -> int
   end

structure HashSet: HASH_SET =
struct

datatype 'a t =
   T of {buckets: 'a list array ref,
     hash: 'a -> word,
     mask: word ref,
     numItems: int ref}

val initialSize: int = 65536
val initialMask: word = Word.fromInt initialSize - 0w1

fun 'a new {hash}: 'a t =
   T {buckets = ref (Array.array (initialSize, [])),
      hash = hash,
      numItems = ref 0,
      mask = ref initialMask}

fun size (T {numItems, ...}) = !numItems
fun numBuckets (T {buckets, ...}) = Array.length (!buckets)

fun index (w: word, mask: word): int =
   Word.toInt (Word.andb (w, mask))
   
fun resize (T {buckets, hash, mask, ...}, size: int, newMask: word): unit =
   let
      val newBuckets = Array.array (size, [])
   in Array.app (fn r =>
         List.app (fn a =>
                   let val j = index (hash a, newMask)
                   in Array.update
                  (newBuckets, j,
                   a :: Array.sub (newBuckets, j))
                   end) r) (!buckets)
      ; buckets := newBuckets
      ; mask := newMask
   end
              
fun maybeGrow (s as T {buckets, mask, numItems, ...}): unit =
   let
      val n = Array.length (!buckets)
   in if !numItems * 4 > n
     then resize (s,
              n * 2,
              
              Word.orb (0w1, Word.<< (!mask, 0w1)))
      else ()
   end

fun peekGen (T {buckets = ref buckets, mask, ...}, w, p, no, yes) =
   let
      val j = index (w, !mask)
      val b = Array.sub (buckets, j)
   in case List.find p b of
      NONE => no (j, b)
    | SOME a => yes a
   end

fun lookupOrInsert (table as T {buckets, numItems, ...}, w, p, f) =
   let
      fun no (j, b) =
     let val a = f ()
        val _ = incr numItems
        val _ = Array.update (!buckets, j, a :: b)
        val _ = maybeGrow table
     in a
     end
   in peekGen (table, w, p, no, fn x => x)
   end

fun foreach (T {buckets, ...}, f) =
   Array.app (fn r => List.app f r) (!buckets)

end

structure Buffer:
   sig
      type t

      val add: t * Word8.word -> unit
      val clear: t -> unit
      val contents: t -> string
      val new: int -> t
   end =
   struct
      datatype t = T of {elts: Word8Array.array ref,
             size: int ref}

      fun contents (T {elts, size, ...}) =
     Byte.bytesToString (Word8Array.extract (!elts, 0, SOME (!size)))

      fun clear (T {size, ...}) = size := 0

      fun new (bufSize) =
     T {elts = ref (Word8Array.array (bufSize, 0w0)),
        size = ref 0}

      fun add (T {elts, size}, x) =
     let
        val s = !size
        val _ = size := s + 1
        val a = !elts
        val n = Word8Array.length a
     in
        if s = n
           then
          let
             val a' =
            Word8Array.tabulate
            (2 * n, fn i =>
             if i < n then Word8Array.sub (a, i) else 0w0)
             val _ = elts := a'
             val _ = Word8Array.update (a', s, x)
          in ()
          end
        else Word8Array.update (a, s, x)
     end
   end

structure Quicksort:
   sig
      val quicksort: 'a array * ('a * 'a -> bool) -> unit
   end =
   struct
      fun assert (s, f: unit -> bool) =
     if true orelse f ()
        then ()
     else raise Fail (concat ["assert: ", s])

      fun forall (low, high, f) =
     let
        fun loop i = i > high orelse (f i andalso loop (i + 1))
     in
        loop low
     end

      fun fold (l, u, state, f) =
     let
        fun loop (i, state) =
           if i > u
          then state
           else loop (i + 1, f (i, state))
     in
        loop (l, state)
     end

      
      fun 'a isSorted (a: 'a array,
               lo: int,
               hi: int,
               op <= : 'a * 'a -> bool) =
     let
        fun loop (i, x) =
           i > hi
           orelse let
             val y = sub (a, i)
              in
             x <= y andalso loop (i + 1, y)
              end
     in
        lo >= hi orelse loop (lo + 1, sub (a, lo))
     end

      
      local
     open Word
     val seed = ref 0w13
      in
     fun rand () =
        let
           val res = 0w1664525 * !seed + 0w1013904223
           val _ = seed := res
        in
           toIntX res
        end
      end

      fun randInt (lo, hi) = lo + Int.mod (rand(), hi - lo + 1)

      
      fun insertionSort (a: 'a array, op <= : 'a * 'a -> bool): unit =
     let
        fun x i = sub (a, i)
     in
        for (1, Array.length a - 1, fn i =>
         let
            val _ =
               assert ("insertionSort1", fn () =>
                   isSorted (a, 0, i - 1, op <=))
            val t = x i
            fun sift (j: int) =
               (assert ("insertionSort2", fn () =>
                isSorted (a, 0, j - 1, op <=)
                andalso isSorted (a, j + 1, i, op <=)
                andalso forall (j + 1, i, fn k => t <= x k))
            ; if j > 0
                 then
                let
                   val j' = j - 1
                   val z = x j'
                in if t <= z
                      then (update (a, j, z);
                        sift j')
                   else j
                end
              else j)
            val _ = update (a, sift i, t)
         in ()
         end)
     end

      
      fun 'a quicksort (a: 'a array, op <= : 'a * 'a -> bool): unit =
     let
        fun x i = Array.sub (a, i)
        fun swap (i, j) =
           let
          val t = x i
          val _ = update (a, i, x j)
          val _ = update (a, j, t)
           in ()
           end
        val cutoff = 20
        fun qsort (l: int, u: int): unit =
           if u - l > cutoff
          then
             let
            val _ = swap (l, randInt (l, u))
            val t = x l
            val m =
               fold
               (l + 1, u, l, fn (i, m) =>
                (assert
                 ("qsort", fn () =>
                  forall (l + 1, m, fn k => x k <= t)
                  andalso forall (m + 1, i - 1, fn k => not (x k <= t)))
                 ; if x i <= t
                  then (swap (m + 1, i)
                    ; m + 1)
                   else m))
            val _ = swap (l, m)
            val _ = qsort (l, m - 1)
            val _ = qsort (m + 1, u)
             in ()
             end
           else ()
        val max = Array.length a - 1
        val _ = qsort (0, max)
        val _ = insertionSort (a, op <=)  
     in
        ()
     end
   end

structure Test : sig
    val main : (string * string list) -> OS.Process.status
end = struct

(* This hash function is taken from pages 56-57 of
 * The Practice of Programming by Kernighan and Pike.
 *)
fun hash (s: string): word =
   let
      val n = String.size s
      fun loop (i, w) =
     if i = n
        then w
     else Word.fromInt (Char.ord (String.sub (s, i))) + Word.* (w, 0w31)
   in
      loop (0, 0w0)
   end

fun hash (s: string): word =
   let
      val n = String.size s
      fun loop (i, w) =
     if i = n
        then w
     else loop (i + 1,
            Word.fromInt (Char.ord (String.sub (s, i)))
               + Word.* (w, 0w31))
   in
      loop (0, 0w0)
   end



val max = 4096
val buf = Word8Array.array (max, 0w0)
val count: {hash: word,
        word: string,
        count: int ref} HashSet.t = HashSet.new {hash = #hash}
val wbuf = Buffer.new 64

val c2b = Byte.charToByte
fun scan_words (i, n, inword) =
  if i < n
     then
    let
       val c = Word8Array.sub (buf, i)
    in
       if c2b #"a" <= c andalso c <= c2b #"z"
          then (Buffer.add (wbuf, c);
            scan_words (i + 1, n, true))
       else
          if c2b #"A" <= c andalso c <= c2b #"Z"
         then
            (Buffer.add (wbuf, c + 0w32);
             scan_words (i + 1, n, true))
          else
         if inword
            then 
               let
              val w = Buffer.contents wbuf
              val h = hash w
               in
              incr (#count
                (HashSet.lookupOrInsert
                 (count, h,
                  fn {hash, word, ...} =>
                  hash = h andalso word = w,
                  fn () => {hash = h, word = w, count = ref 0})));
              Buffer.clear wbuf;
              scan_words (i + 1, n, false)
               end
         else scan_words (i + 1, n, false)
    end
  else
     let
    val nread =
       Posix.IO.readArr (Posix.FileSys.stdin,
                 {buf = buf, i =  0, sz = NONE})
     in
    if nread = 0
       then ()
    else scan_words (0, nread, inword)
     end

fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t )

fun rightJustify (s: string, width: int) =
   let
      val n = String.size s
   in concat [CharVector.tabulate (width - n, fn _ => #" "), s]
   end

fun main (name, args) =
   let
    val _ = scan_words (0, 0, false)
    val a = Array.array (HashSet.size count, (0, ""))
    val i = ref 0
    val _ = HashSet.foreach (count, fn {word, count, ...} =>
             (Array.update (a, !i, (!count, word)); incr i))
    val _ = Quicksort.quicksort (a, fn ((c, w), (c', w')) =>
                 c > c' orelse c = c' andalso w >= w')
    val _ = Array.app (fn (c, w) =>
           printl [rightJustify (Int.toString c, 7), "\t", w]) a
   in
      OS.Process.success
   end
end

val _ = SMLofNJ.exportFn("wordfreq", Test.main);