benchmark/tests/psdes-random.sml

   1 (* Written by Stephen Weeks (sweeks@sweeks.com). *)
   2 (*
   3  * Random number generator based on page 302 of Numerical Recipes in C.
   4  *)
   5 fun once () =
   6    let
   7    fun natFold (start, stop, ac, f) =
   8       let
   9          fun loop (i, ac) =
  10             if i = stop
  11                then ac
  12             else loop (i + 1, f (i, ac))
  13       in loop (start, ac)
  14       end
  15    val niter: int = 4
  16    open Word32
  17    fun make (l: word list) =
  18       let val a = Array.fromList l
  19       in fn i => Array.sub (a, i)
  20       end
  21    val c1 = make [0wxbaa96887, 0wx1e17d32c, 0wx03bdcd3c, 0wx0f33d1b2]
  22    val c2 = make [0wx4b0f3b58, 0wxe874f0c3, 0wx6955c5a6, 0wx55a7ca46]
  23    val half: Word.word = 0w16
  24    fun reverse w = orb (>> (w, half), << (w, half))
  25    fun psdes (lword: word, irword: word): word * word =
  26       natFold
  27       (0, niter, (lword, irword), fn (i, (lword, irword)) =>
  28        let
  29           val ia = xorb (irword, c1 i)
  30           val itmpl = andb (ia, 0wxffff)
  31           val itmph = >> (ia, half)
  32           val ib = itmpl * itmpl + notb (itmph * itmph)
  33        in (irword,
  34            xorb (lword, itmpl * itmph + xorb (c2 i, reverse ib)))
  35        end)
  36    val zero: word = 0wx13
  37    val lword: word ref = ref 0w13
  38    val irword: word ref = ref 0w14
  39    val needTo = ref true
  40    fun word () =
  41       if !needTo
  42          then
  43             let
  44                val (l, i) = psdes (!lword, !irword)
  45                val _ = lword := l
  46                val _ = irword := i
  47                val _ = needTo := false
  48             in
  49                l
  50             end
  51       else (needTo := true
  52             ; !irword)
  53    fun loop (i, w) =
  54       if i = 0
  55          then
  56             if w = 0wx132B1B67
  57                then ()
  58             else raise Fail "bug"
  59       else loop (Int.- (i, 1), w + word())
  60    in
  61       loop (150000000, 0w0)
  62    end
  63
  64 structure Main =
  65    struct
  66       fun doit n =
  67          if n = 0
  68             then ()
  69          else (once ()
  70                ; doit (n - 1))
  71    end
  72
  73 val _ = Main.doit 2