[hcoop/debian/mlton.git] / doc / examples / profiling / fib-tak.sml

structure Profile = MLton.Profile

val fibData = Profile.Data.malloc ()
val takData = Profile.Data.malloc ()

fun wrap (f, d) x =
   Profile.withData (d, fn () => f x)

val rec fib =
   fn 0 => 0
    | 1 => 1
    | n => fib (n - 1) + fib (n - 2)
val fib = wrap (fib, fibData)

fun tak (x,y,z) =
   if not (y < x)
      then z
   else tak (tak (x - 1, y, z),
             tak (y - 1, z, x),
             tak (z - 1, x, y))
val tak = wrap (tak, takData)

val rec f =
   fn 0 => ()
    | n => (fib 38; f (n-1))
val _ = f 2

val rec g =
   fn 0 => ()
    | n => (tak (18,12,6); g (n-1))
val _ = g 500

fun done (data, file) =
   (Profile.Data.write (data, file)
    ; Profile.Data.free data)

val _ = done (fibData, "mlmon.fib.out")
val _ = done (takData, "mlmon.tak.out")
Commit	Line	Data
7f918cf1 CE	1	structure Profile = MLton.Profile
	2
	3	val fibData = Profile.Data.malloc ()
	4	val takData = Profile.Data.malloc ()
	5
	6	fun wrap (f, d) x =
	7	Profile.withData (d, fn () => f x)
	8
	9	val rec fib =
	10	fn 0 => 0
	11	\| 1 => 1
	12	\| n => fib (n - 1) + fib (n - 2)
	13	val fib = wrap (fib, fibData)
	14
	15	fun tak (x,y,z) =
	16	if not (y < x)
	17	then z
	18	else tak (tak (x - 1, y, z),
	19	tak (y - 1, z, x),
	20	tak (z - 1, x, y))
	21	val tak = wrap (tak, takData)
	22
	23	val rec f =
	24	fn 0 => ()
	25	\| n => (fib 38; f (n-1))
	26	val _ = f 2
	27
	28	val rec g =
	29	fn 0 => ()
	30	\| n => (tak (18,12,6); g (n-1))
	31	val _ = g 500
	32
	33	fun done (data, file) =
	34	(Profile.Data.write (data, file)
	35	; Profile.Data.free data)
	36
	37	val _ = done (fibData, "mlmon.fib.out")
	38	val _ = done (takData, "mlmon.tak.out")