Commits

camlspotter committed 38d3071

stream => spotStream

Comments (0)

Files changed (4)

lib/spotStream.ml

+open Base
+open Xlazy
+
+type 'a t = 'a desc lazy_t
+
+and 'a desc =
+  | Cons of 'a * 'a t
+  | Null
+
+let null = from_val Null
+let cons v t = from_val (Cons (v, t))
+let (^^) = cons
+let singleton v = cons v null
+
+let peek = function
+  | lazy Null -> None
+  | lazy (Cons (v, t)) -> Some (v, t)
+
+let is_null = function
+  | lazy Null -> true
+  | _ -> false
+
+let rec create f st = lazy (match f st with
+  | Some (v, st) -> Cons (v, create f st)
+  | None -> Null)
+
+let rec of_list = function
+  | [] -> null
+  | x::xs -> cons x (of_list xs)
+
+let to_list t = 
+  let rec to_list st = function
+    | lazy Null -> List.rev st
+    | lazy (Cons (v, t)) -> to_list (v :: st) t
+  in
+  to_list [] t
+  
+let hd = function
+  | lazy Null -> failwith "hd"
+  | lazy (Cons (x, _)) -> x
+
+let tl = function
+  | lazy Null -> failwith "tl"
+  | lazy (Cons (_, xs)) -> xs
+
+let rec nth t n = 
+  if n < 0 then invalid_arg "Stream.nth"
+  else
+    match t with
+    | lazy Null -> failwith "Stream.nth"
+    | lazy (Cons (x,xs)) ->
+        if n = 0 then x
+        else nth xs (n-1)
+
+let rec init t = lazy (match t with
+  | lazy Null -> failwith "Stream.init"
+  | lazy (Cons (_, lazy Null)) -> Null
+  | lazy (Cons (x, xs)) -> Cons (x, init xs))
+
+let rec length = function
+  | lazy Null -> 0
+  | lazy (Cons (_, xs)) -> length xs + 1
+
+let rec iter f = function
+  | lazy Null -> ()
+  | lazy (Cons (v, t)) -> f v; iter f t
+
+let rec fold_left f st t = lazy (match t with
+  | 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 map f lst = lazy (match lst with
+  | lazy Null -> Null
+  | lazy (Cons (v, lst')) -> Cons (f v, map f lst'))
+
+let rec append xs ys = lazy (match xs with
+  | lazy Null -> !!ys
+  | lazy (Cons (x, xs)) -> Cons (x, append xs ys))
+      
+  
+let rev t = fold_left (fun st x -> x ^^ st) null t
+
+let intersparse a t = lazy (match t with
+  | lazy Null -> Null
+  | lazy (Cons (_, lazy Null) as singleton) -> singleton
+  | lazy (Cons (x, xs)) -> Cons (x, from_val (Cons (a, xs)))) 
+
+let rec concat xss = lazy (match xss with
+  | lazy Null -> Null
+  | lazy (Cons (x, xs)) -> !! (append x (concat xs)))
+
+let intercalate xs xss = concat (intersparse xs xss)
+
+(*
+transpose :: [[a]] -> [[a]]Source
+
+The transpose function transposes the rows and columns of its argument. For example,
+
+ transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
+subsequences :: [a] -> [[a]]Source
+
+The subsequences function returns the list of all subsequences of the argument.
+
+ subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
+permutations :: [a] -> [[a]]
+*)
+
+let rec fold_left' f st = function
+  | lazy Null -> st
+  | lazy (Cons (v, t)) -> fold_left' f (f v st) t
+
+let fold_left1 f t = match t with
+  | lazy Null -> failwith "fold_left1"
+  | lazy (Cons (v, t)) -> fold_left f v t
+
+let rec fold_right1 f lst st = 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)
+
+let rec mem k t = match t with
+  | lazy Null -> false
+  | lazy (Cons (v, t)) -> if k = v then true else mem k t
+
+let concat tss = lazy (match tss with
+  | lazy Null -> Null
+  | lazy (Cons (ts,tss)) -> !! (append ts (concat tss)))
+
+let filter p xs = fold_right (fun x st -> if p x then cons x st else st) xs null
+
+let rec take n xs = lazy (
+  if n <= 0 then Null
+  else match xs with
+  | lazy Null -> Null
+  | lazy (Cons (x,xs)) -> Cons (x, take (n-1) xs)
+)
+
+(* [t2] must be a postfix of [t1] otherwise, it loops forever *)
+let rev_between t1 t2 =
+  let rec loop st t =
+    if t == t2 then st (* CR jfuruse: we cannot always use pointer eq *)
+    else 
+      match t with
+      | lazy (Cons (v, t')) -> loop (v::st) t'
+      | lazy Null -> st
+  in
+  loop [] t1
+
+let between t1 t2 = List.rev (rev_between t1 t2)
+
+let split_at len t = 
+  let rec split rev_list len t = 
+    if len <= 0 then List.rev rev_list, t
+    else 
+      match t with
+      | lazy Null -> List.rev rev_list, null
+      | lazy (Cons (v, t)) -> split (v::rev_list) (len-1) t
+  in
+  split [] len t
+          
+(*
+let rec split_at' : int -> 'a t -> 'a t * 'a t = fun len t ->
+  let ztuple : ('a t * 'a t) Lazy.t = lazy (
+    if len <= 0 then null, t
+    else match t with
+    | lazy Null -> null, null
+    | lazy (Cons (v, t)) -> 
+        let pref, post = split_at' (len-1) t in
+        v^^pref, post
+  )
+  in
+  lazy(!!(fst !!ztuple)),
+  lazy(!!(snd !!ztuple))
+*)
+
+let rec split_at' : int -> 'a t -> 'a t * 'a t = fun len t ->
+  let ztuple : ('a t * 'a t) Lazy.t = lazy (
+    if len <= 0 then null, t
+    else match t with
+    | lazy Null -> null, null
+    | lazy (Cons (v, t)) -> 
+        let pref, post = split_at' (len-1) t in
+        v^^pref, post
+  )
+  in
+  lazy(!!(fst !!ztuple)),
+  lazy(!!(snd !!ztuple))
+
+let _test_split_at' () = 
+  let rec list = 
+    function 
+      | 0 -> null
+      | i -> lazy (print_int i; print_newline (); Cons (i, list (i-1)))
+  in
+  let my = split_at' 3 (list 10) in
+  print_endline "forcing fst";
+  ignore & Lazy.force (fst my);
+  print_endline "forcing snd";
+  ignore & Lazy.force (snd my);
+  ()
+  

lib/spotStream.mli

+(** Lazy list or Stream *)
+
+(** {6 Type } *)
+
+type 'a desc = 
+  | Cons of 'a * 'a desc lazy_t
+  | Null 
+
+type 'a t = 'a desc lazy_t
+
+(** {6 Constructors} *)
+
+val null : 'a t
+(** a constant null *)
+
+val cons : 'a -> 'a t -> 'a t
+val (^^) :  'a -> 'a t -> 'a t
+(** same as [cons] *)
+
+val singleton : 'a -> 'a t
+
+val create : ('st -> ('a * 'st) option) -> 'st -> 'a t
+(** Pure functional creator *)
+
+(** {6 Deconstructors} *)
+
+val hd : 'a t -> 'a
+val tl : 'a t -> 'a t
+
+val peek : 'a t -> ('a * 'a t) option
+(** You can use match with lazy pattern instead of [peek] *)
+
+val is_null : 'a t -> bool
+(** null check *)
+
+val nth : 'a t -> int -> 'a
+
+val length : 'a t -> int
+
+(** {6 Conversions between the eager list} *)
+
+val to_list : 'a t -> 'a list
+(** Conversion from a lazy stream to a strict list.
+    Do not use against inifinite streams. *)
+
+val of_list : 'a list -> 'a t
+(** Conversion from a strict list to a lazy stream. 
+    The conversion itself is done strictly: the result has no reference to the original list *)
+
+(** {6 Misc functions} *)
+
+val take : int -> 'a t -> 'a t
+(** [take n t] takes the first [n] elements of [t]. Lazy. *)
+
+val init : 'a t -> 'a t
+(** [init t] returns the same list [t] but without its final element. *)
+
+val rev : 'a t -> 'a t
+
+val filter : ('a -> bool) -> 'a t -> 'a t
+
+val concat : 'a t t -> 'a t
+
+val mem : 'a -> 'a t -> bool
+(** Membership. Never terminates over inifinite streams. *)
+  
+val iter : ('a -> unit) -> 'a t -> unit
+(** 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. *)
+
+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] 
+    [fold_left1 f null] raises an exception.
+*) 
+
+val fold_left' : ('a -> 'b -> 'b) -> 'b -> 'a t -> 'b
+(** Folding left, strict version. Never terminates over inifinite streams. *) 
+
+val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+(** [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
+(** [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]. 
+*)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** Map. Lazy. *)
+
+val append : 'a t -> 'a t -> 'a t
+(** Append. Lazy. *)
+
+val intercalate : 'a t -> 'a t t -> 'a t
+(** Haskell's intercalate *)
+val intersparse : 'a -> 'a t -> 'a t
+(** Haskell's intersparse *)
+
+val split_at : int -> 'a t -> 'a list * 'a t
+(** Haskell's splitAt. Prefix is forced. *)
+
+val split_at' : int -> 'a t -> 'a t * 'a t
+(** Haskell's splitAt. Prefix is lazy. *)
+
+(** {6 Inpure hacks} *)
+
+val rev_between : 'a t -> 'a t -> 'a list
+val between : 'a t -> 'a t -> 'a list
+(** Get elements between two points of the *same* stream.
+
+    The first argument of [rev_between] and [between] must point the former element of the stream
+    than the second argument. Otherwise, the behaviour of [rev_between] and [between] are not specified:
+    a wrong result or memory exhaustion by an infinite loop.
+*)

lib/stream.ml

-open Base
-open Xlazy
-
-type 'a t = 'a desc lazy_t
-
-and 'a desc =
-  | Cons of 'a * 'a t
-  | Null
-
-let null = from_val Null
-let cons v t = from_val (Cons (v, t))
-let (^^) = cons
-let singleton v = cons v null
-
-let peek = function
-  | lazy Null -> None
-  | lazy (Cons (v, t)) -> Some (v, t)
-
-let is_null = function
-  | lazy Null -> true
-  | _ -> false
-
-let rec create f st = lazy (match f st with
-  | Some (v, st) -> Cons (v, create f st)
-  | None -> Null)
-
-let rec of_list = function
-  | [] -> null
-  | x::xs -> cons x (of_list xs)
-
-let to_list t = 
-  let rec to_list st = function
-    | lazy Null -> List.rev st
-    | lazy (Cons (v, t)) -> to_list (v :: st) t
-  in
-  to_list [] t
-  
-let hd = function
-  | lazy Null -> failwith "hd"
-  | lazy (Cons (x, _)) -> x
-
-let tl = function
-  | lazy Null -> failwith "tl"
-  | lazy (Cons (_, xs)) -> xs
-
-let rec nth t n = 
-  if n < 0 then invalid_arg "Stream.nth"
-  else
-    match t with
-    | lazy Null -> failwith "Stream.nth"
-    | lazy (Cons (x,xs)) ->
-        if n = 0 then x
-        else nth xs (n-1)
-
-let rec init t = lazy (match t with
-  | lazy Null -> failwith "Stream.init"
-  | lazy (Cons (_, lazy Null)) -> Null
-  | lazy (Cons (x, xs)) -> Cons (x, init xs))
-
-let rec length = function
-  | lazy Null -> 0
-  | lazy (Cons (_, xs)) -> length xs + 1
-
-let rec iter f = function
-  | lazy Null -> ()
-  | lazy (Cons (v, t)) -> f v; iter f t
-
-let rec fold_left f st t = lazy (match t with
-  | 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 map f lst = lazy (match lst with
-  | lazy Null -> Null
-  | lazy (Cons (v, lst')) -> Cons (f v, map f lst'))
-
-let rec append xs ys = lazy (match xs with
-  | lazy Null -> !!ys
-  | lazy (Cons (x, xs)) -> Cons (x, append xs ys))
-      
-  
-let rev t = fold_left (fun st x -> x ^^ st) null t
-
-let intersparse a t = lazy (match t with
-  | lazy Null -> Null
-  | lazy (Cons (_, lazy Null) as singleton) -> singleton
-  | lazy (Cons (x, xs)) -> Cons (x, from_val (Cons (a, xs)))) 
-
-let rec concat xss = lazy (match xss with
-  | lazy Null -> Null
-  | lazy (Cons (x, xs)) -> !! (append x (concat xs)))
-
-let intercalate xs xss = concat (intersparse xs xss)
-
-(*
-transpose :: [[a]] -> [[a]]Source
-
-The transpose function transposes the rows and columns of its argument. For example,
-
- transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
-subsequences :: [a] -> [[a]]Source
-
-The subsequences function returns the list of all subsequences of the argument.
-
- subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
-permutations :: [a] -> [[a]]
-*)
-
-let rec fold_left' f st = function
-  | lazy Null -> st
-  | lazy (Cons (v, t)) -> fold_left' f (f v st) t
-
-let fold_left1 f t = match t with
-  | lazy Null -> failwith "fold_left1"
-  | lazy (Cons (v, t)) -> fold_left f v t
-
-let rec fold_right1 f lst st = 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)
-
-let rec mem k t = match t with
-  | lazy Null -> false
-  | lazy (Cons (v, t)) -> if k = v then true else mem k t
-
-let concat tss = lazy (match tss with
-  | lazy Null -> Null
-  | lazy (Cons (ts,tss)) -> !! (append ts (concat tss)))
-
-let filter p xs = fold_right (fun x st -> if p x then cons x st else st) xs null
-
-let rec take n xs = lazy (
-  if n <= 0 then Null
-  else match xs with
-  | lazy Null -> Null
-  | lazy (Cons (x,xs)) -> Cons (x, take (n-1) xs)
-)
-
-(* [t2] must be a postfix of [t1] otherwise, it loops forever *)
-let rev_between t1 t2 =
-  let rec loop st t =
-    if t == t2 then st (* CR jfuruse: we cannot always use pointer eq *)
-    else 
-      match t with
-      | lazy (Cons (v, t')) -> loop (v::st) t'
-      | lazy Null -> st
-  in
-  loop [] t1
-
-let between t1 t2 = List.rev (rev_between t1 t2)
-
-let split_at len t = 
-  let rec split rev_list len t = 
-    if len <= 0 then List.rev rev_list, t
-    else 
-      match t with
-      | lazy Null -> List.rev rev_list, null
-      | lazy (Cons (v, t)) -> split (v::rev_list) (len-1) t
-  in
-  split [] len t
-          
-(*
-let rec split_at' : int -> 'a t -> 'a t * 'a t = fun len t ->
-  let ztuple : ('a t * 'a t) Lazy.t = lazy (
-    if len <= 0 then null, t
-    else match t with
-    | lazy Null -> null, null
-    | lazy (Cons (v, t)) -> 
-        let pref, post = split_at' (len-1) t in
-        v^^pref, post
-  )
-  in
-  lazy(!!(fst !!ztuple)),
-  lazy(!!(snd !!ztuple))
-*)
-
-let rec split_at' : int -> 'a t -> 'a t * 'a t = fun len t ->
-  let ztuple : ('a t * 'a t) Lazy.t = lazy (
-    if len <= 0 then null, t
-    else match t with
-    | lazy Null -> null, null
-    | lazy (Cons (v, t)) -> 
-        let pref, post = split_at' (len-1) t in
-        v^^pref, post
-  )
-  in
-  lazy(!!(fst !!ztuple)),
-  lazy(!!(snd !!ztuple))
-
-let _test_split_at' () = 
-  let rec list = 
-    function 
-      | 0 -> null
-      | i -> lazy (print_int i; print_newline (); Cons (i, list (i-1)))
-  in
-  let my = split_at' 3 (list 10) in
-  print_endline "forcing fst";
-  ignore & Lazy.force (fst my);
-  print_endline "forcing snd";
-  ignore & Lazy.force (snd my);
-  ()
-  

lib/stream.mli

-(** Lazy list or Stream *)
-
-(** {6 Type } *)
-
-type 'a desc = 
-  | Cons of 'a * 'a desc lazy_t
-  | Null 
-
-type 'a t = 'a desc lazy_t
-
-(** {6 Constructors} *)
-
-val null : 'a t
-(** a constant null *)
-
-val cons : 'a -> 'a t -> 'a t
-val (^^) :  'a -> 'a t -> 'a t
-(** same as [cons] *)
-
-val singleton : 'a -> 'a t
-
-val create : ('st -> ('a * 'st) option) -> 'st -> 'a t
-(** Pure functional creator *)
-
-(** {6 Deconstructors} *)
-
-val hd : 'a t -> 'a
-val tl : 'a t -> 'a t
-
-val peek : 'a t -> ('a * 'a t) option
-(** You can use match with lazy pattern instead of [peek] *)
-
-val is_null : 'a t -> bool
-(** null check *)
-
-val nth : 'a t -> int -> 'a
-
-val length : 'a t -> int
-
-(** {6 Conversions between the eager list} *)
-
-val to_list : 'a t -> 'a list
-(** Conversion from a lazy stream to a strict list.
-    Do not use against inifinite streams. *)
-
-val of_list : 'a list -> 'a t
-(** Conversion from a strict list to a lazy stream. 
-    The conversion itself is done strictly: the result has no reference to the original list *)
-
-(** {6 Misc functions} *)
-
-val take : int -> 'a t -> 'a t
-(** [take n t] takes the first [n] elements of [t]. Lazy. *)
-
-val init : 'a t -> 'a t
-(** [init t] returns the same list [t] but without its final element. *)
-
-val rev : 'a t -> 'a t
-
-val filter : ('a -> bool) -> 'a t -> 'a t
-
-val concat : 'a t t -> 'a t
-
-val mem : 'a -> 'a t -> bool
-(** Membership. Never terminates over inifinite streams. *)
-  
-val iter : ('a -> unit) -> 'a t -> unit
-(** 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. *)
-
-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] 
-    [fold_left1 f null] raises an exception.
-*) 
-
-val fold_left' : ('a -> 'b -> 'b) -> 'b -> 'a t -> 'b
-(** Folding left, strict version. Never terminates over inifinite streams. *) 
-
-val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
-(** [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
-(** [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]. 
-*)
-
-val map : ('a -> 'b) -> 'a t -> 'b t
-(** Map. Lazy. *)
-
-val append : 'a t -> 'a t -> 'a t
-(** Append. Lazy. *)
-
-val intercalate : 'a t -> 'a t t -> 'a t
-(** Haskell's intercalate *)
-val intersparse : 'a -> 'a t -> 'a t
-(** Haskell's intersparse *)
-
-val split_at : int -> 'a t -> 'a list * 'a t
-(** Haskell's splitAt. Prefix is forced. *)
-
-val split_at' : int -> 'a t -> 'a t * 'a t
-(** Haskell's splitAt. Prefix is lazy. *)
-
-(** {6 Inpure hacks} *)
-
-val rev_between : 'a t -> 'a t -> 'a list
-val between : 'a t -> 'a t -> 'a list
-(** Get elements between two points of the *same* stream.
-
-    The first argument of [rev_between] and [between] must point the former element of the stream
-    than the second argument. Otherwise, the behaviour of [rev_between] and [between] are not specified:
-    a wrong result or memory exhaustion by an infinite loop.
-*)