X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fmonads.ml;h=54a324831d5714ebc23782a6eae496ded167d4e4;hp=bdc3eba2adc8982c64716d7a8a9e03b36c664e68;hb=d0c1b524d79cd88b2979d7825dc297bbbddc4f22;hpb=092c31a2cad42975fb4751c2eda5ac03a13c8cd5

diff --git a/code/monads.ml b/code/monads.ml
index bdc3eba2..54a32483 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/>
@@ -51,7 +51,8 @@
  * - http://www.grabmueller.de/martin/www/pub/Transformers.pdf
  * - http://en.wikibooks.org/wiki/Haskell/Monad_transformers
  *
- * Licensing: MIT (if that's compatible with the ghc sources).
+ * Licensing: MIT (if that's compatible with the ghc sources this is partly
+ * derived from)
  *)
 
 exception Undefined
@@ -169,20 +170,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 [])