This site is updated infrequently. For up-to-date information, please visit the new OCaml website at ocaml.org.

Unexplained infinite loop
• Jacques Carette
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
 Date: 2005-06-20 (20:22) From: Jacques Carette Subject: Unexplained infinite loop
```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)

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.) ;;

```