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