* 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:
* - <http://pauillac.inria.fr/~xleroy/mpri/progfunc/>
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 [])