Unexplained infinite loop

Jacques Carette
 Jacques Carette
[
Home
]
[ Index:
by date

by threads
]
[ Message by date: previous  next ] [ Message in thread: previous  next ] [ Thread: previous  next ]
[ Message by date: previous  next ] [ Message in thread: previous  next ] [ Thread: previous  next ]
Date:   (:) 
From:  Jacques Carette <carette@m...> 
Subject:  RE: [Camllist] Unexplained infinite loop 
Sorry to answer my own post, but offlist I got the answer. The problem is that I was too cavalier in erasing the MetaOCaml markup. I need to replace .< x >. with fun () > x and .~x with x () for any expression x. And because of memoization, I need to do that, I can't use the Lazy module. For the curious, I the resulting code is below. While ocamldebug can deal with this code without difficulty, stepping through it by hand is quite mystifying! Jacques (* Base monad type, to be used throughout *) type ('v,'s,'w) monad = 's > ('s > 'v > 'w) > 'w let ret a = fun s k > k s a let retN a = fun s k > fun () > (let t = a () in k s (fun () > t) () ) let bind a f = fun s k > a s (fun s' b > f b s' k) let k0 s v = v (* Initial continuation  for `reset' and `run' *) let runM m = m [] k0 (* running our monad *) let liftGet x = fun () > (! (x()) ) let liftRef x = fun () > (ref (x ())) let l1 f x = bind x (fun t > f t) let seqM a b = fun s k > k s (fun () > (begin a s k0 () ; b s k0 () end)) (* while ``loops'' do not naturally bind a value *) let retWhileM cond body = fun s k > k s (fun () > (while (cond s k0 ()) do body s k0 () done)) (* operations on indices *) module Idx = struct let zero = fun () > 0 let succ a = fun () > (a () +1) let less a b = fun () > (a () < b () ) end (* code generators *) module Code = struct let update a f = let b = f (liftGet a) in ret (fun () > (a () := b ())) end let dogen a = bind (retN (liftRef Idx.zero)) (fun c > bind (retN (fun () > (Array.length a))) (fun m > (retWhileM (ret (Idx.less (liftGet c) m)) (bind (retN (liftGet c)) (fun cc > Printf.printf "%i %i\n" (cc ()) !(c ()); (Code.update c Idx.succ)))))) ;; let gen a = runM (dogen a) ;; (gen (Array.make 1 1.)) ();;