Lazy evaluation and caml-light

[Christophe Raffalli <cr@dcs.ed.ac.uk>]

The problem in your program is this function~:

let rec recursive sb sd=selec({state=Evaluated (append true sb)},sd,
   F(fun ()->distr2(sb,{state=Evaluated (recursive sb sd)})));;

With the recursive call you compute an infinite number of time the value of 
(recusive sb sd) !!!!!

Here is a better way to write the same program:

******************************************************************************
type 'a stream_aux = Str of ('a * 'a stream)
                   | Unevaluated of (unit -> 'a stream)
                   | Not_Ready (* use for fix_point only *)

and 'a stream == 'a stream_aux ref;;

let rec Eval p = p := Eval' !p; !p
where Eval' = function
  Str _ as s -> s
| Unevaluated f -> Eval (f ())
| Not_Ready -> raise (Failure "Can't evaluate any more")
;;
  
let fix_point f = 
  let fp = ref Not_Ready in 
  fp := !(f fp);
  fp
;;

let append x ls = ref (Str (x,ls));; (* not usefull *)
let append' x f a = ref (Str(x, ref (Unevaluated (fun () -> f a))));;
let stop_eval f a = ref (Unevaluated (fun () -> f a));;

let rec selec (f,g,h) = 
match  (Eval f) with Str (sf,rf) -> 
  if sf then
    match (Eval g) with Str(sg,rg) -> append' sg selec (rf,rg,h)
  else
    match (Eval h) with Str(sh,rh) -> append' sh selec (rf,g,rh);;

let rec distr2 (f,g)= 
let (Str(sf,rf)) = (Eval f) and (Str(sg,rg)) = (Eval g) in 
  if not sf then 
    append' sg distr2 (rf,rg)
  else 
    distr2 (rf,rg);;

let rec recursive (sb,sd) = 
  fix_point f where
  f = function x -> selec (
        (append true sb),sd,
        stop_eval distr2 (sb,x))
;;


let rec strinf =fun []->failwith "lista vacia" | (a::b)-> append' a strinf b;;

let rec l1=false::false::false::false::false::true::true::false::false::true::l1;;
let rec l2=1::2::3::4::5::6::7::8::9::l2;; 
let s1=stop_eval strinf l1;; 
let s2=stop_eval strinf l2;; 
let s3=recursive (s1,s2);;

let rec get s = function
  0 -> ()
| n -> match  (Eval s) with Str (sf,rf) ->
 print_int sf; print_string " "; get rf (n -1)
;;