X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fmonads.ml;h=e1865a4a29f5dc109ed9f7bbeb05c25d45bc1931;hp=bdc3eba2adc8982c64716d7a8a9e03b36c664e68;hb=4e590cb7725aa4ba86b06491ff2ec9338bc8e347;hpb=4bc0776e79a9bad3a6378d9f1339f62605e436fd

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