Unexplained infinite loop

Unexplained infinite loop

[Jacques Carette]

Hello,

I am writing some stateful code in continuation-passing-style, and am
encountering an infinite loop that I cannot explain.  

The code below is extracted from a larger piece of code (which performs
Gaussian Elimination).  All that is left is a loop on a 1 cell vector, and
that does not work :-(

The real mystery (to me) is that if I annotate this code with lots of .< >.
and .~ for MetaOCaml, then not only does the code work, the generated code
works too.  I am somewhat at a loss to explain the infinite loop below.

Using the debugger, I can see that the while loop condition is only fully
evaluated once, and then on subsequent passes through, only the 2nd and 3rd
parameters are evaluated, the first (which is the one that changes!) is not
re-evaluated.  I don't understand why not. Could someone from this list shed
some light on this issue for me?

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 -> let t = a in k s 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 = ! x
let liftRef x = ref x

let l1 f x = bind x (fun t -> f t)

let seqM a b = fun s k -> k s (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 (while cond s k0 do body s k0 done)

(* monadic logic combinators *)
module LogicCode = struct
  let and_ a b = ret (a && b)
end

(* operations on indices *)
module Idx = struct
  let zero = 0
  let succ a = a+1
  let less a b = a<b
end

(* code generators *)
module Code = struct
  let update a f = let b = f (liftGet a) in ret (a := b) 
end

let dogen a = 
  bind (retN (liftRef Idx.zero)) (fun c ->
  bind (retN (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.) ;;

RE: [Caml-list] Unexplained infinite loop

[Jacques Carette]

Sorry to answer my own post, but off-list 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.)) ();;