レイジーリスト

OCamlでもレイジーリストは便利ですねー。参考のために、某案件で使うために書いたレイジーリストの実装を書いておきます。バグがあったら某案件のプログラムもバグっていると言うことなので、痛いです。ぜひご報告をお願いします。tail-recursiveとかも一応考えたはず。メモリ効率やスピードは計ってないです。ごめんなさい。

本格的に使いたい人はOCaml Batteries Includedを入れると便利関数が多くて幸せになれますよ！
http://thelema.github.com/batteries-included/hdoc/BatLazyList.html

(**
  lazy list
 
  @author IT Planning Inc.
  @version $Id$
*)

(*   
   Copyright (c) 2007 IT Planning inc. All Rights Reserved.
 
   Permission is hereby granted, free of charge, to any person obtaining
   a copy of this software and associated documentation files (the
   "Software"), to deal in the Software without restriction, including
   without limitation the rights to use, copy, modify, merge, publish,
   distribute, sublicense, and/or sell copies of the Software, and to
   permit persons to whom the Software is furnished to do so, subject to
   the following conditions:
   
   The above copyright notice and this permission notice shall be
   included in all copies or substantial portions of the Software.
   
   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
   CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*)

let (!$) x = Lazy.force x

type 'a seq = Nil | Cons of 'a * 'a t
and 'a t = 'a seq Lazy.t

let empty = lazy Nil

let zero = lazy Nil

let return x = lazy (Cons(x, lazy Nil))

let rec map f l = 
  lazy begin
    match !$l with
      | Nil -> Nil
      | Cons (x, xs) -> Cons (f x, map f xs)
  end

(* Be careful! All elements will be evaluated. *)
let rec foldl f v l = 
  match !$l with
      Nil -> v
    | Cons(x, xs) -> foldl f (f v x) xs
        
(* Be careful! All elements will be evaluated. not tail-recursive. *)
let rec foldr f v l = 
    match !$l with
        Nil -> v
      | Cons(x, xs) -> f x (foldr f v xs)

let rec (++) s1 s2 = 
  match !$s1 with
      Nil -> s2
    | Cons (hd, tl) -> lazy (Cons (hd, tl ++ s2))

(* 早速 concatがtail-recursiveじゃなかったバグが見つかったので修正 *)
let rec concat l = 
  lazy begin
    match !$l with
      Nil -> Nil
    | Cons(x, xs) ->
        !$(x ++ (concat xs))
  end

let bind s f = concat (map f s)

let rec filter f l = 
  lazy begin 
    match !$l with
        Nil -> Nil
      | Cons(x, xs) ->
          if f x then 
            Cons(x, filter f xs)
          else
            !$(filter f xs)
  end

let rec filter_map f l = 
  lazy begin 
    match !$l with
        Nil -> Nil
      | Cons(x, xs) ->
          match f x with
              Some v -> Cons(v, filter_map f xs)
            | None -> !$(filter_map f xs)
  end

let guard c = if c then return () else zero

(* Be careful! All elements will be evaluated. *)
let reverse s =
  let rec rev acc l = 
    match !$l with
        Nil -> acc
      | Cons (hd, tl) -> rev (Cons (hd, lazy acc)) tl
  in
  lazy (rev Nil s)

let rec take n l =
  lazy begin
    match n, !$l with
      | 0, _ -> Nil
      | n, Nil -> Nil
      | n, Cons (x, xs) -> 
          Cons(x, take (n-1) xs)
  end

let rec of_list = function
    [] -> empty
  | hd :: tl -> lazy (Cons (hd, of_list tl))

let rec unfold f x =
  lazy begin
    match f x with
        Some (a, b) -> 
          Cons (a, unfold f b)
      | None -> Nil
  end

let rec take_while f l = 
  lazy begin
    match !$l with
        Nil -> Nil
      | Cons(x, xs) ->
          if f x then 
            Cons(x, take_while f xs)
          else
            Nil
  end

let rec drop_while f l =
  lazy begin
    match !$l with
        Nil -> Nil
      | Cons(x, xs) as l -> 
          if f x then 
            !$(drop_while f xs)
          else 
            l
  end

let rec zip x y =
  lazy begin
    match !$x with
        Nil -> Nil
      | Cons(x, xs) ->
          match !$y with
              Nil -> Nil
            | Cons(y, ys) ->
                Cons((x,y), zip xs ys)
  end

let hd = function | lazy Nil -> failwith "hd" | lazy (Cons (x, xs)) -> x
let tl = function | lazy Nil -> failwith "tl" | lazy (Cons (x, xs)) -> xs
let cons x xs = lazy (Cons(x, xs))

(* Be careful! All elements will be evaluated. *)
let rec iter f l =
  match !$l with
      Nil -> ()
    | Cons(x, xs) -> 
        f x;
        iter f xs