Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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 |