// Copyright (C) 1996 DIMACS Center, Rutgers, The State University of New Jersey
// Author(s): Jonathan Berry

// This software is copyrighted by the DIMACS Center at Rutgers, The State
// University of New Jersey.  IT IS PROVIDED AS IS, AND THE AUTHORS, DIMACS, AND
// RUTGERS, THE STATE UNIVERSITY OF NEW JERSEY  DISCLAIM
// ALL LIABILITY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
// DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
// DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.

// THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
// INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
// IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
// NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
// MODIFICATIONS.

// The authors hereby grant permission to use, copy, modify, distribute,
// and license this software and its documentation for any purpose, provided
// that existing copyright notices are retained in all copies and that this
// notice is included verbatim in any distributions. No written agreement,
// license, or royalty fee is required for any of the authorized uses.
// Modifications to this software may be copyrighted by their authors
// and need not follow the licensing terms described here, provided that
// the new terms are clearly indicated on the first page of each file where
// they apply.

// Last File Update: 31-Jul-1996
// 

#include <stk.h>
#include <iostream.h>
#include <strstream.h>
#include <LINK/stkWrapper/LINK_STk.h>


template <class T> 
Collection<T>* 
CollectionWrapper<T>::getCollection(SCM p)
{
	int &Collection_Type 	= Wrapper<Collection<T> >::type;
	int &MSet_Type		= Wrapper<MSet<T> >::type;
	int &Set_Type		= Wrapper<Set<T> >::type;
	int &Sequence_Type	= Wrapper<Sequence<T> >::type;
	Collection<T> *cp;
	if (CXX_TYPEP(p, Collection_Type) ||
	    CXX_TYPEP(p, MSet_Type) || 
	    CXX_TYPEP(p, Set_Type) || 
	    CXX_TYPEP(p, Sequence_Type)) { 
		cp = (Collection<T>*) CLASSDATA(p);
	} else
		cp = 0;
	return cp;
}

template <class T> 
MSet<T>* 
CollectionWrapper<T>::getMSet(SCM p)
{
	int &MSet_Type		= Wrapper<MSet<T> >::type;
	MSet<T> *sp;
	if (CXX_TYPEP(p, MSet_Type)) {
		sp = (MSet<T>*) CLASSDATA(p);
	} else
		sp = 0;
	return sp;
}

template <class T> 
Set<T>* 
CollectionWrapper<T>::getSet(SCM p)
{
	int &Set_Type		= Wrapper<Set<T> >::type;
	Set<T> *sp;
	if (CXX_TYPEP(p, Set_Type)) {
		sp = (Set<T>*) CLASSDATA(p);
	} else
		sp = 0;
	return sp;
}

template <class T> 
Sequence<T>* 
CollectionWrapper<T>::getSequence(SCM p)
{
	int &Sequence_Type		= Wrapper<Sequence<T> >::type;
	Sequence<T> *sp;
	if (CXX_TYPEP(p, Sequence_Type)) {
		sp = (Sequence<T>*) CLASSDATA(p);
	} else
		sp = 0;
	return sp;
}


template <class T> 
Bool 
CollectionWrapper<T>::isCollection(SCM p)
{
	int &Collection_Type 	= Wrapper<Collection<T> >::type;
	int &MSet_Type		= Wrapper<MSet<T> >::type;
	int &Set_Type		= Wrapper<Set<T> >::type;
	int &Sequence_Type	= Wrapper<Sequence<T> >::type;
	if (CXX_TYPEP(p, Collection_Type) ||
	    CXX_TYPEP(p, MSet_Type) ||
	    CXX_TYPEP(p, Set_Type) ||
	    CXX_TYPEP(p, Sequence_Type)) 
		return TRUE;
	return FALSE;
}

template <class T> 
Bool 
CollectionWrapper<T>::isMSet(SCM p)
{
	int &MSet_Type		= Wrapper<MSet<T> >::type;
	if (CXX_TYPEP(p, MSet_Type))
		return TRUE;
	return FALSE;
}

template <class T> 
Bool 
CollectionWrapper<T>::isSet(SCM p)
{
	int &Set_Type		= Wrapper<Set<T> >::type;
	if (CXX_TYPEP(p, Set_Type))
		return TRUE;
	return FALSE;
}

template <class T> 
Bool 
CollectionWrapper<T>::isSequence(SCM p)
{
	int &Sequence_Type		= Wrapper<Sequence<T> >::type;
	if (CXX_TYPEP(p, Sequence_Type))
		return TRUE;
	return FALSE;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::collectionP(SCM l)
{
	return  isCollection(l) ? Truth : Ntruth; 
}

template <class T> 
void 
CollectionWrapper<T>::markTypedCollection(SCM p)
{}

template <class T> 
void 
CollectionWrapper<T>::freeTypedCollection(SCM p)
{
	int &Collection_Type 	= Wrapper<Collection<T> >::type;
	int &MSet_Type		= Wrapper<MSet<T> >::type;
	int &Set_Type		= Wrapper<Set<T> >::type;
	int &Sequence_Type	= Wrapper<Sequence<T> >::type;

	if  	(CXXw_TYPEP(p, Collection_Type) ||
		 CXXw_TYPEP(p, MSet_Type) || 
		 CXXw_TYPEP(p, Set_Type) || 
		 CXXw_TYPEP(p, Sequence_Type)) {
		if (!EXTSTATICP(p)) {
	    		delete (Collection<T> *) EXTDATA(p); 
		}
	} else
		Err("free-typed-collection: wrong type of argument", p);
}
	
template <class T> 
void 
CollectionWrapper<T>::displayTypedCollection(SCM c, SCM port, int mode)
{
	int &Collection_Type 	= Wrapper<Collection<T> >::type;
	int &MSet_Type		= Wrapper<MSet<T> >::type;
	int &Set_Type		= Wrapper<Set<T> >::type;
	int &Sequence_Type	= Wrapper<Sequence<T> >::type;

	Collection<T>* cp;
	if  	(CXXw_TYPEP(c, Collection_Type) ||
		 CXXw_TYPEP(c, MSet_Type) || 
		 CXXw_TYPEP(c, Set_Type) || 
		 CXXw_TYPEP(c, Sequence_Type)) {
		cp = (Collection<T>*) EXTDATA(c);
	} else 
		Err("display-typed-collection: wrong type of argument", c);
        ostrstream oss;
        cp->display(oss);
	oss << ends;
        char *buffer = oss.str();
        Puts(buffer, FILEPTR(port));
        delete buffer;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::buildMSet(SCM l)
{
	int i;
	SCM tmp, ns;
	Collection<T>* new_set;
	int &MSet_Type = Wrapper<MSet<T> >::type;
	char*MSet_Name = Wrapper<MSet<T> >::name;

	if (l == NIL)
                new_set = new MSet<T>;
	else if (CXX_TYPEP(CAR(l), MSet_Type)) {
                new_set = new MSet<T>(
			   *(MSet<T>*) CLASSDATA(CAR(l)));
	} else if (isCollection(CAR(l))) {
		new_set = getCollection(CAR(l));
		//cout << "size: " << new_set->size() << endl;
		new_set = new MSet<T>(*new_set);
	} else if (CONSP(l)) {
		new_set = new MSet<T>();
		for (tmp=l; tmp != NIL; tmp = CDR(tmp))  {
			if  (CXX_TYPEP(CAR(tmp), Wrapper<T>::type)) {
				new_set->insert(*(T*) CLASSDATA(CAR(tmp)));
			} else {
				delete new_set;
				Err("typed-set: wrong type of argument", tmp);
			}
		}
	} else
		Err("typed-set: wrong type of argument", l);
	ns = STk_make_CXXwrapper(MSet_Type,MSet_Name,
				 (void*)new_set,LINK_DYNAMIC);
	return ns;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::buildSet(SCM l)
{
	int i;
	SCM tmp, ns;
	Collection<T>* new_set;
	int &Set_Type = Wrapper<Set<T> >::type;
	char*Set_Name = Wrapper<Set<T> >::name;

	if (l == NIL)
                new_set = new Set<T>;
	else if (CXX_TYPEP(CAR(l), Set_Type)) {
                new_set = new Set<T>(
			   *(Set<T>*) CLASSDATA(CAR(l)));
	} else if (isCollection(CAR(l))) {
		new_set = getCollection(CAR(l));
		//cout << "size: " << new_set->size() << endl;
		new_set = new Set<T>(*new_set);
	} else if (CONSP(l)) {
		new_set = new Set<T>();
		for (tmp=l; tmp != NIL; tmp = CDR(tmp))  {
			if  (CXX_TYPEP(CAR(tmp), Wrapper<T>::type)) {
				new_set->insert(*(T*) CLASSDATA(CAR(tmp)));
			} else {
				delete new_set;
				Err("typed-set: wrong type of argument", tmp);
			}
		}
	}
	ns = STk_make_CXXwrapper(Set_Type,Set_Name,(void*)new_set,LINK_DYNAMIC);
	return ns;
}

template <class T>
PRIMITIVE
CollectionWrapper<T>::buildSequence(SCM l)
{
        int i;
        SCM tmp, nl;
	Collection<T> *source;
	Sequence<T> *new_seq;
	int &Seq_Type	= Wrapper<Sequence<T> >::type;
	char*Seq_Name	= Wrapper<Sequence<T> >::name;

	if (l == NIL)
                new_seq = new Sequence<T>;
	else if (CXX_TYPEP(CAR(l), Seq_Type)) {
                new_seq = new Sequence<T>(
			   *(Sequence<T>*) CLASSDATA(CAR(l)));
	} else if (isCollection(CAR(l))) {
                source = getCollection(CAR(l));
                //cout << "size: " << new_seq->size() << endl;
                new_seq = new Sequence<T>(*source);
	} else if (CONSP(l)) {
                new_seq = new Sequence<T>();
                for (tmp=l; tmp != NIL; tmp = CDR(tmp))  {
                        if  (CXX_TYPEP(CAR(tmp), Wrapper<T>::type)) {
                                new_seq->append(*(T*) CLASSDATA(CAR(tmp)));
                        } else {
                                delete new_seq;
                                Err("typed-sequence: wrong type of argument", 
									tmp);
                        }
                }
	}
        nl = STk_make_CXXwrapper(Seq_Type,Seq_Name,(void*)new_seq,LINK_DYNAMIC);
        return nl;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::stkList2LinkSet(SCM l)
{
	return buildSet(l);
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::stkList2LinkMSet(SCM l)
{
	return buildMSet(l);
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::stkList2LinkSequence(SCM l)
{
	return buildSequence(l);
}


template <class T> 
PRIMITIVE 
CollectionWrapper<T>::collection2STkList(SCM l)
{
	SCM z;

	if (!isCollection(l))
		Err("typed-collection-convert: wrong type of argument", l);
	Collection<T> *cp = getCollection(l);
	//cp->display(cout);
	Iterator<T> get_next(cp);
	T e;
	if (get_next(e)) {
		SCM new_el = STk_make_CXXwrapper(Wrapper<T>::type, 
			Wrapper<T>::name, (void*) new T(e), LINK_DYNAMIC);
		SCM tail, head;
		NEWCELL(tail, tc_cons);
		CAR(tail) = new_el;
		CDR(tail) = NIL;
		head = tail;
		SCM z;
		while (get_next(e)) {
			SCM new_el  = STk_make_CXXwrapper(Wrapper<T>::type, 
				Wrapper<T>::name,(void*) new T(e),LINK_DYNAMIC);
			NEWCELL(z, tc_cons);
			CAR(z) = new_el;
			CDR(z) = NIL;
			CDR(tail) = z;
			tail = z;
		}
		return head;
	}
	return NIL;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::nullLinkCollection(SCM l)
{
	if (!isCollection(l))
		Err("typed-collection-null?: wrong type of argument", l);
	Collection<T> *cp = getCollection(l);
	return cp->emptyQ() ? Truth : Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::sortedLinkCollection(SCM l)
{
	if (!isCollection(l))
		Err("typed-collection-sorted?: wrong type of argument", l);
	Collection<T> *cp = getCollection(l);
	return cp->sortedQ() ? Truth : Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::sizeLinkCollection(SCM l)
{
	if (!isCollection(l))
		Err("typed-collection-size: wrong type of argument", l);
	Collection<T> *cp = getCollection(l);
	SCM z;
  	NEWCELL(z, tc_integer);
  	SET_INTEGER(z, cp->size());
  	return z;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::eqvLinkCollection(SCM l, SCM l2)
{
/*
	if (Wrapper<Collection<T> >::compareItems(l, l2) == 0)
		return Truth;
	return Ntruth;
*/
	if (!isCollection(l))
		Err("typed-collection-eqv?: wrong type of argument", l);
	if (!isCollection(l2))
		Err("typed-collection-eqv?: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	return (*cp == *cp2) ? Truth : Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::lthLinkCollection(SCM l, SCM l2)
{
	if (!isCollection(l))
		Err("typed-collection-<: wrong type of argument", l);
	if (!isCollection(l2))
		Err("typed-collection-<: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	return (*cp < *cp2) ? Truth : Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::leLinkCollection(SCM l, SCM l2)
{
	if (!isCollection(l))
		Err("typed-collection-<=: wrong type of argument", l);
	if (!isCollection(l2))
		Err("typed-collection-<=: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	return (*cp <= *cp2) ? Truth : Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::grLinkCollection(SCM l, SCM l2)
{
	if (!isCollection(l))
		Err("typed-collection->: wrong type of argument", l);
	if (!isCollection(l2))
		Err("typed-collection->: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	return (*cp > *cp2) ? Truth : Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::geLinkCollection(SCM l, SCM l2)
{
	if (!isCollection(l))
		Err("typed-collection->=: wrong type of argument", l);
	if (!isCollection(l2))
		Err("typed-collection->=: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	return (*cp >= *cp2) ? Truth : Ntruth;
}

/*
template <class T> 
PRIMITIVE 
CollectionWrapper<T>::carLinkCollection(SCM l)
{
	SCM res = NIL;
	Collection<T>* cp;

	if (isCollection(l)) {
		cp = getCollection(l);
		T t=cp->first());
		res = STk_make_CXXwrapper(Wrapper<T>::type, Wrapper<T>::name,
			(void*)new T(cp->first()),LINK_DYNAMIC);
	}
	return res;
}
*/

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::memberLinkCollection(SCM e, SCM l)
{
	Collection<T>* cp;

	if  (CXX_NTYPEP(e, Wrapper<T>::type))
                Err("typed-collection-member: wrong type of argument", e);

	if (isCollection(l)) {
		T elem =  * (T *) CLASSDATA(e);
		cp = getCollection(l);
		if (cp->memberQ(elem))
			return e;
	}
	return Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::clearLinkCollection(SCM l)
{
	Collection<T>* cp;

	if (isCollection(l)) {
		cp = getCollection(l);
		cp->clear();
	}
	return UNDEFINED;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::insertLinkCollection(SCM e, SCM l)
{
	Collection<T>* cp;

	if  (CXX_NTYPEP(e, Wrapper<T>::type))
                Err("typed-collection-insert: wrong type of argument", e);

	if (isCollection(l)) {
		T elem =  * (T *) CLASSDATA(e);
		cp = getCollection(l);
		cp->insert(elem);
	}
	return UNDEFINED;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::appendLinkCollection(SCM e, SCM l)
{
	Collection<T>* cp;

	if  (CXX_NTYPEP(e, Wrapper<T>::type))
                Err("typed-collection-append: wrong type of argument", e);

	if (isCollection(l)) {
		T elem =  * (T *) CLASSDATA(e);
		cp = getCollection(l);
		cp->append(elem);
	}
	return UNDEFINED;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::removeLinkCollection(SCM e, SCM l)
{
	Collection<T>* cp;

	if  (CXX_NTYPEP(e, Wrapper<T>::type))
                Err("typed-collection-remove: wrong type of argument", e);

	if (isCollection(l)) {
		T elem =  * (T *) CLASSDATA(e);
		cp = getCollection(l);
		cp->remove(elem);
	}
	return UNDEFINED;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::occurrencesLinkCollection(SCM l, SCM e)
{
	Collection<T>* cp;
	int num = 0;

	if  (CXX_NTYPEP(e, Wrapper<T>::type))
                Err("typed-collection-occurrences: wrong type of argument", e);

	if (isCollection(l)) {
		T elem =  * (T *) CLASSDATA(e);
		cp = getCollection(l);
		num = cp->occurrences(elem);
	}
	SCM z;
  	NEWCELL(z, tc_integer);
  	SET_INTEGER(z, num);
  	return z;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::rankLinkCollection(SCM l, SCM e)
{
	Collection<T>* cp;
	int num = 0;

	if  (CXX_NTYPEP(e, Wrapper<T>::type))
                Err("typed-collection-rank: wrong type of argument", e);

	if (isCollection(l)) {
		T elem =  * (T *) CLASSDATA(e);
		cp = getCollection(l);
		num = cp->rank(elem);
	}
	SCM z;
  	NEWCELL(z, tc_integer);
  	SET_INTEGER(z, num);
  	return z;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::refLinkCollection(SCM l, SCM e)
{
	Collection<T>* cp;

	if  (NINTEGERP(e))
                Err("typed-collection-ref: <integer> expected", e);
	int num = INTEGER(e);

	if (!isCollection(l))
		return NIL;

	cp = getCollection(l);
	T elem = cp->ref(num);
	T *ep = new T(elem);
	SCM res_scm = STk_make_CXXwrapper(Wrapper<T>::type, 
				      Wrapper<T>::name,
				      (void*) ep, 
				      LINK_DYNAMIC);
	return res_scm;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::unionLinkCollection(SCM l, SCM l2)
{
	int &MSet_Type = Wrapper<MSet<T> >::type;
	char*MSet_Name = Wrapper<MSet<T> >::name;
	SCM res_scm;
	if (!isCollection(l))
		Err("typed-collection-+: wrong type of argument", l);
	if (l2 == UNBOUND)	// see tc_subr_1_or_2 in Extending STk
		return l;
	if (!isCollection(l2))
		Err("typed-collection-+: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	Collection<T> *res = new MSet<T>
				 ( (*(MSet<T>*)cp) + (*(MSet<T>*)cp2) );
	res_scm = STk_make_CXXwrapper(MSet_Type,MSet_Name,
				(void*)res,LINK_DYNAMIC);
	return res_scm;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::intersectionLinkCollection(SCM l, SCM l2)
{
	int &MSet_Type = Wrapper<MSet<T> >::type;
	char*MSet_Name = Wrapper<MSet<T> >::name;
	SCM res_scm;
	if (!isCollection(l))
		Err("typed-collection-^: wrong type of argument", l);
	if (l2 == UNBOUND)	// see tc_subr_1_or_2 in Extending STk
		return l;
	if (!isCollection(l2))
		Err("typed-collection-^: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	Collection<T> *res = new MSet<T>
				 ( (*(MSet<T>*)cp) ^ (*(MSet<T>*)cp2) );
	res_scm = STk_make_CXXwrapper(MSet_Type,MSet_Name,
				(void*)res,LINK_DYNAMIC);
	return res_scm;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::differenceLinkCollection(SCM l, SCM l2)
{
	int &MSet_Type = Wrapper<MSet<T> >::type;
	char*MSet_Name = Wrapper<MSet<T> >::name;
	SCM res_scm;
	if (!isCollection(l))
		Err("typed-collection--: wrong type of argument", l);
	if (l2 == UNBOUND)	// see tc_subr_1_or_2 in Extending STk
		return l;
	if (!isCollection(l2))
		Err("typed-collection--: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);
	Collection<T> *res = new MSet<T>
				 ( (*(MSet<T>*)cp) - (*(MSet<T>*)cp2) );
	res_scm = STk_make_CXXwrapper(MSet_Type,MSet_Name,
				(void*)res,LINK_DYNAMIC);
	return res_scm;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::subsetLinkCollection(SCM l, SCM l2)
{
	SCM res_scm;
	if (!isCollection(l))
		Err("subset: wrong type of argument", l);
	if (!isCollection(l2))
		Err("subset: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);

	if ( ((MSet<T>*)cp)->subsetQ(*cp2))
		return l;
	return Ntruth;
}

template <class T> 
PRIMITIVE 
CollectionWrapper<T>::properSubsetLinkCollection(SCM l, SCM l2)
{
	SCM res_scm;
	if (!isCollection(l))
		Err("proper-subset: wrong type of argument", l);
	if (!isCollection(l2))
		Err("proper-subset: wrong type of argument", l2);
	Collection<T> *cp = getCollection(l);
	Collection<T> *cp2 = getCollection(l2);

	if (((MSet<T>*)cp)->properSubsetQ(*cp2))
		return l;
	return Ntruth;
}