Commits

camlspotter committed 5650a7d

fixed Stream.fold_right

Comments (0)

Files changed (2)

lib/spotStream.ml

   | lazy Null -> !!st
   | lazy (Cons (v, t)) -> !!(fold_left f (f st v) t))
 
-let rec fold_right f lst st = match lst with
-  | lazy Null -> st
-  | lazy (Cons (v, lst)) -> f v (fold_right f lst st)
+let rec fold_right f xs st =
+  lazy match xs with
+  | lazy Null -> Lazy.force st
+  | lazy (Cons (x,xs)) -> Lazy.force (f x (fold_right f xs st))
 
 let rec map f lst = lazy (match lst with
   | lazy Null -> Null
   | lazy Null -> failwith "fold_left1"
   | lazy (Cons (v, t)) -> fold_left f v t
 
-let rec fold_right1 f lst st = match lst with
+let rec fold_right1 f lst st = lazy match lst with
   | lazy Null -> failwith "fold_right1"
   | lazy (Cons (v, lazy Null)) -> v
-  | lazy (Cons (v, lst)) -> f v (fold_right1 f lst st)
+  | lazy (Cons (v, lst)) -> Lazy.force (f v (fold_right1 f lst st))
 
 let rec mem k t = match t with
   | lazy Null -> false
   let bind t f = concat (map f t)
 end)
 
-
+TEST "fold_right and map" =
+  let zeros = create (fun () -> Some (0, ())) () in
+  let ones = fold_right (fun z st -> (z+1)^^st) zeros null in
+  let ones' = map (fun z -> z + 1) zeros in
+  to_list (take 3 ones) = [1; 1; 1] 
+  && to_list (take 3 ones') = [1; 1; 1]

lib/spotStream.mli

 (** Iteration. Never terminates over inifinite streams. *)
 
 val fold_left : ('a Lazy.t -> 'b -> 'a Lazy.t) -> 'a Lazy.t -> 'b t -> 'a Lazy.t
-(** Folding left. Tail recursive. Lazy. *)
+(** Folding left *)
 
 val fold_left1 : ('a Lazy.t -> 'a Lazy.t -> 'a Lazy.t) -> 'a Lazy.t t -> 'a Lazy.t
 (** [fold_left1 f (x^^xs) = fold_left f x xs] 
 *) 
 
 val fold_left' : ('a -> 'b -> 'b) -> 'b -> 'a t -> 'b
-(** Folding left, strict version. Never terminates over inifinite streams. *) 
+(** Folding left, strict version. Never terminates over inifinite streams. Tail recursive. *) 
 
-val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+val fold_right : ('a -> 'b lazy_t -> 'b lazy_t) -> 'a t -> 'b lazy_t -> 'b lazy_t
 (** [fold_right f t init]. Folding right. Not tail recursive. 
     If laziness is required, it is the responsibility of [f]. 
 *)
 
-val fold_right1 : ('a -> 'a -> 'a) -> 'a t -> 'a -> 'a
+val fold_right1 : ('a -> 'a lazy_t -> 'a lazy_t) -> 'a t -> 'a lazy_t -> 'a lazy_t
 (** [fold_right1 f (append xs (singleton x)) = fold_right f xs x] 
     [fold_right1 f null] raises an exception.
     If laziness is required, it is the responsibility of [f].