(*
 *  This file is a component of PropPlan - a model-based planner
 *  Copyright (C) 2000-2007  Michael Paul Fourman
 *  homepages.inf.ed.ac.uk/mfourman/tools/propplan
 *  sourceforge.net/projects/propplan
 *  michael.fourman (AT) gmail.com
 *
 *  This program is free software: you can redistribute it and/or modify
 *  it under the terms of version 3 of the GNU Affero General Public License
 *  as published by the Free Software Foundation.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received the file COPYING, a copy of the GNU Affero 
 *  Public License, along with this program.  
 *  If not, see <http://www.gnu.org/licenses/>.
 
 *  $Id: SEQUENCE.ML,v 1.1 2007/12/30 15:31:25 michaelfourman Exp $
 *)

signature SEQUENCE = 
  sig
  type 'a T
  exception Empty
  val empty: 'a T
  val cons: '_a * (unit -> '_a T) -> '_a T
  val null: 'a T -> bool
  val hd: 'a T -> 'a
  val tl: 'a T -> 'a T
  val take: 'a T * int -> 'a list
  val toList: 'a T -> 'a list
  val fromList: '_a list -> '_a T
  val @ : '_a T * '_a T -> '_a T
  val interleave : '_a T * '_a T -> '_a T
  val concat: '_a T T -> '_a T
  val map: ('a -> '_b) -> 'a T -> '_b T
  val filter: ('_a -> bool) -> '_a T -> '_a T
  val cycle: ((unit -> '_a T) -> '_a T) -> '_a T
  end;


functor SEQUENCE() :SEQUENCE =
  struct
  datatype 'a T  = Nil 
                 | Cons of 'a * ('a T) ref
                 | Delayed of unit -> 'a T;

  exception Empty;

  fun delay xf = ref(Delayed xf);

  (*sequence "constructors" for export*)
  val empty = Nil;

  fun cons(x,xf) = Cons(x, delay xf);

  (*gets tail value, perhaps with the side effect of storing it*)
  fun force xp = case !xp of
                     Delayed f => let val s = f()
                                  in  xp := s;  s  end
                   | s => s;

  (** these functions do not expect Delayed -- it is only permissible
      in the tail of a Cons, where it is enclosed in a reference **)

  fun null Nil = true
    | null (Cons _) = false; 

  fun hd Nil = raise Empty
    | hd (Cons(x,_)) = x;

  fun tl Nil = raise Empty
    | tl (Cons(_,xp)) = force xp;

  fun take (xq, 0) = []
    | take (Nil, n) = []
    | take (Cons(x,xp), n) = x :: take (force xp, n-1);

  fun toList Nil = []
    | toList (Cons(x,xp)) = x :: toList (force xp);

  fun fromList [] = Nil
    | fromList (x::xs) = cons(x, fn()=> fromList xs);

  fun Nil @ yq = yq
    | (Cons(x,xp)) @ yq =
          cons(x, fn()=> (force xp) @ yq);

  fun interleave (Nil,    yq) = yq
    | interleave (Cons(x,xp), yq) = 
          cons(x, fn()=> interleave(yq, force xp));

(*  (*concatenate a sequence of sequences, taking care not to loop! *)
   fun concat xqq =
     if null xqq then empty
     else if null(hd xqq) then concat(tl xqq)
          else cons(hd(hd xqq),  
                    fn()=> tl(hd xqq) @ concat(tl xqq));
*)

  fun concat xqq =
      let fun conc xs next = if null xs then next()
			     else cons(hd xs, fn () => conc (tl xs) next)
      in
	  if null xqq then empty
	  else if null(hd xqq) then concat(tl xqq)
	       else cons(hd(hd xqq),  
			 fn()=> conc (tl(hd xqq)) (fn () => concat(tl xqq)))
      end

  (** functionals for sequences **)
  fun map f Nil  = Nil
    | map f (Cons(x,xp)) = 
          cons(f x, fn()=> map f (force xp));

  fun filter pred Nil = Nil
    | filter pred (Cons(x,xp)) =
          if pred x 
          then cons(x, fn()=> filter pred (force xp))
          else filter pred (force xp);

  (*idea thanks to C. Reade, see Appendix 3 of his book;
    seqfn must not call its argument outside of a closure;
    lest it get Nil rather than the cycle. *)
  fun cycle seqfn =
      let val knot = ref Nil
      in  knot := seqfn (fn()=> !knot);  !knot  end;
  end;