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