Version française
Home     About     Download     Resources     Contact us    
Browse thread
Unexplained infinite loop
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Jacques Carette <carette@m...>
Subject: RE: [Caml-list] Unexplained infinite loop
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.)) ();;