Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | structure Bug = |
2 | struct | |
3 | ||
4 | structure F = MLton.Finalizable | |
5 | ||
6 | fun new_t () = | |
7 | let | |
8 | val p = 0 | |
9 | val t = F.new p | |
10 | fun finalize x = () | |
11 | in | |
12 | F.addFinalizer(t,finalize); | |
13 | t | |
14 | end | |
15 | ||
16 | fun from_string (_:string) = | |
17 | let | |
18 | val x = new_t () | |
19 | in | |
20 | F.withValue(x,fn p => ()); | |
21 | x | |
22 | end | |
23 | ||
24 | val zero = from_string "0.0" | |
25 | ||
26 | (* NOTE: I removed the F.withValue lines in an attempt to make the | |
27 | code simpler, but the bug didn't manifest itself. So I think these | |
28 | lines are critical. *) | |
29 | fun plus (x,y) = | |
30 | let | |
31 | val z = new_t () | |
32 | in | |
33 | F.withValue(x,fn xp => | |
34 | F.withValue(y,fn yp => | |
35 | F.withValue(z,fn zp => | |
36 | let in | |
37 | z | |
38 | end))) | |
39 | end | |
40 | ||
41 | end | |
42 | ||
43 | structure B = Bug | |
44 | ||
45 | fun bigsum (n,store) = | |
46 | if n = 0 then store else | |
47 | let | |
48 | val _ = if Int.mod(n,10000) = 0 then print (Int.toString n ^ "\n") else () | |
49 | in | |
50 | bigsum(Int.-(n,1),B.plus(store,B.from_string(Int.toString n ^ ".0"))) | |
51 | end | |
52 | ||
53 | val bigsum = (fn n => bigsum(n,B.zero)) | |
54 | ||
55 | val x = bigsum 5000000 |