From: Jim Pryor Date: Sun, 12 Dec 2010 06:09:45 +0000 (-0500) Subject: tweak monads-lib X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=commitdiff_plain;h=4e590cb7725aa4ba86b06491ff2ec9338bc8e347 tweak monads-lib Signed-off-by: Jim Pryor --- diff --git a/code/monads.ml b/code/monads.ml index bdc3eba2..e1865a4a 100644 --- a/code/monads.ml +++ b/code/monads.ml @@ -43,7 +43,7 @@ * to types whose internals you have free access to. * * Acknowledgements: This is largely based on the mtl library distributed - * with the Glaskow Haskell Compiler. I've also been helped in + * with the Glasgow Haskell Compiler. I've also been helped in * various ways by posts and direct feedback from Oleg Kiselyov and * Chung-chieh Shan. The following were also useful: * - @@ -169,20 +169,21 @@ module Monad = struct let (>=>) f g = fun a -> f a >>= g let do_when test u = if test then u else unit () let do_unless test u = if test then unit () else u - (* A Haskell-like version: + (* A Haskell-like version works: let rec forever uthunk = uthunk () >>= fun _ -> forever uthunk - * is not in tail position and will stack overflow. *) + * but the recursive call is not in tail position so this can stack overflow. *) let forever uthunk = let z = zero () in let id result = result in - let newk = ref id in - let rec loop () = - let result = uthunk (newk := id) >>= chained - in !newk result - and chained = - fun _ -> newk := (fun _ -> loop ()); z (* we use z only for its polymorphism *) - in loop () - (* reimplementations of the preceding using a hand-rolled State or StateT also stack overflowed *) + let kcell = ref id in + let rec loop _ = + let result = uthunk (kcell := id) >>= chained + in !kcell result + and chained _ = + kcell := loop; z (* we use z only for its polymorphism *) + in loop z + (* Reimplementations of the preceding using a hand-rolled State or StateT +can also stack overflow. *) let sequence ms = let op u v = u >>= fun x -> v >>= fun xs -> unit (x :: xs) in Util.fold_right op ms (unit [])