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