benchmark/tests/peek.sml

   1 (* Written by Stephen Weeks (sweeks@sweeks.com). *)
   2 structure Plist:
   3    sig
   4       type t
   5
   6       val new: unit -> t
   7       val addPeek: unit -> {add: t * 'a -> unit,
   8                             peek: t -> 'a option}
   9    end =
  10    struct
  11       datatype t = T of exn list ref
  12
  13       fun new () = T (ref [])
  14
  15       fun addPeek () =
  16          let
  17             exception E of 'a
  18             fun add (T r, x) = r := E x :: !r
  19             fun peek (T r) =
  20                let
  21                   val rec loop =
  22                      fn [] => NONE
  23                       | E x :: _ => SOME x
  24                       | _ :: l => loop l
  25                in loop (!r)
  26                end
  27          in {add = add, peek = peek}
  28          end
  29    end
  30
  31 structure Main =
  32    struct
  33       fun inner () =
  34          let
  35             val l = Plist.new ()
  36             val {add, peek} = Plist.addPeek ()
  37             val _ = add (l, 13)
  38             fun loop (i, ac) =
  39                if i = 0
  40                   then ac
  41                else loop (i - 1, ac + valOf (peek l))
  42             val n = loop (10000000, 0)
  43             val _ = print (concat [Int.toString n, "\n"])
  44          in ()
  45          end
  46
  47       fun doit size =
  48          let
  49             fun loop i =
  50                if i = 0
  51                   then ()
  52                else (inner (); loop (i - 1))
  53          in loop size
  54          end
  55    end