lib/stubs/mlton-stubs/random.sml

   1 (* Copyright (C) 2009 Matthew Fluet.
   2  * Copyright (C) 2002-2006 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 structure MLtonRandom: MLTON_RANDOM =
  11    struct
  12       (* Uses /dev/random and /dev/urandom to get a random word.
  13        * If they can't be read from, return NONE.
  14        *)
  15       local
  16          fun make (file, name) =
  17             let
  18                val buf = Word8Array.array (4, 0w0)
  19             in
  20                fn () =>
  21                (let
  22                    val fd =
  23                       let
  24                          open Posix.FileSys
  25                       in
  26                          openf (file, O_RDONLY, O.flags [])
  27                       end
  28                    fun loop rem =
  29                       let
  30                          val n = Posix.IO.readArr (fd,
  31                                                    Word8ArraySlice.slice
  32                                                    (buf, 4 - rem, SOME rem))
  33                          val _ = if n = 0
  34                                     then (Posix.IO.close fd; raise Fail name)
  35                                  else ()
  36                          val rem = rem - n
  37                       in
  38                          if rem = 0
  39                             then ()
  40                          else loop rem
  41                       end
  42                    val _ = loop 4
  43                    val _ = Posix.IO.close fd
  44                 in
  45                    SOME (Word.fromLarge (PackWord32Little.subArr (buf, 0)))
  46                 end
  47                    handle OS.SysErr _ => NONE)
  48             end
  49       in
  50          val seed = make ("/dev/random", "Random.seed")
  51          val useed = make ("/dev/urandom", "Random.useed")
  52       end
  53
  54       local
  55          open Word
  56          val seed: word ref = ref 0w13
  57       in
  58          (* From page 284 of Numerical Recipes in C. *)
  59          fun rand (): word =
  60             let
  61                val res = 0w1664525 * !seed + 0w1013904223
  62                val _ = seed := res
  63             in
  64                res
  65             end
  66
  67          fun srand (w: word): unit = seed := w
  68       end
  69
  70       local
  71          val chars =
  72             "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
  73          val numChars = String.size chars
  74          val refresh =
  75             let
  76                val numChars = IntInf.fromInt numChars
  77                fun loop (i: IntInf.int, c: int): int =
  78                   if IntInf.< (i, numChars)
  79                      then c
  80                   else loop (IntInf.div (i, numChars), c + 1)
  81             in
  82                loop (IntInf.pow (2, Word.wordSize), 0)
  83             end
  84          val r: word ref = ref 0w0
  85          val count: int ref = ref refresh
  86          val numChars = Word.fromInt numChars
  87       in
  88          fun alphaNumChar (): char =
  89             let
  90                val n = !count
  91                val _ = if n = refresh
  92                           then (r := rand ()
  93                                 ; count := 1)
  94                        else (count := n + 1)
  95                val w = !r
  96                val c = String.sub (chars, Word.toInt (Word.mod (w, numChars)))
  97                val _ = r := Word.div (w, numChars)
  98             in
  99                c
 100             end
 101       end
 102
 103       fun alphaNumString (length: int): string =
 104          CharVector.tabulate (length, fn _ => alphaNumChar ())
 105    end