regression/finalize.6.sml

   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