// 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> 
SCM 
ListWrapper<T>::LINK_newListNode()
{
	SCM new_node;
	NEWCELL(new_node, tc_cons);
	//SCM *n = new SCM(new_node); 
	//STk_gc_protect(n);	
	return new_node;
}
***********/

template <class T>
PRIMITIVE
ListWrapper<T>::newWrappedElement(const T& e, int staticp)
{
	T* ep = new T(e);
	return STk_make_CXXwrapper(Wrapper<T >::type, 
				 Wrapper<T >::name,
				 (void*)ep, staticp);
}

template <class T>
PRIMITIVE
ListWrapper<T>::newWrappedList(const List<T>& newlist, int staticp)
{
	List<T> *nl = new List<T>(newlist);
	return STk_make_CXXwrapper(Wrapper<List<T> >::type, 
				 Wrapper<List<T> >::name,
				 (void*)nl, staticp);
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::nullpLinkList(SCM l)
{
	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-nullp: wrong type of argument", l);
	List<T> *oldlist = (List<T> *) CLASSDATA(l);
	if (oldlist->emptyQ())
		return Truth;
	return Ntruth;
}

template <class T> 
int 
ListWrapper<T>::LINK_llength(SCM l)
{
	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-llength: wrong type of argument", l);
	List<T> *oldlist = (List<T> *) CLASSDATA(l);
	return  oldlist->size();
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::linkListP(SCM l)
{
	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		return Truth;
	return Ntruth;

	//return  LINK_llength(l) < 0 ? Ntruth : Truth; // STk lists do this
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::lengthLinkList(SCM l)
{
	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-length: wrong type of argument", l);
	
	int len = LINK_llength(l);
	if (len >= 0)
		return STk_makeinteger(len);
	Err("length: not calculable", NIL);
}


template <class T> 
PRIMITIVE 
ListWrapper<T>::buildLinkList(SCM l)
{
	int i;
	SCM tmp, nl;
	List<T>  newlist;

	if ((l != NIL) && CXX_TYPEP(CAR(l), Wrapper<List<T> >::type)) {
                newlist = *(List<T>*) CLASSDATA(CAR(l));
	} else if (CONSP(l)) {
		for (tmp=l; tmp != NIL; tmp = CDR(tmp)) {
			if  (CXX_NTYPEP(CAR(tmp), Wrapper<T>::type)) 
				Err("typed-list: wrong type of argument", tmp);
			T t = *(T*) CLASSDATA(CAR(tmp));
			newlist.append(t);
		}
	} else if (l != NIL)
			Err("typed-set: wrong type of argument", l);
	nl = newWrappedList(newlist, LINK_DYNAMIC);
	return nl;
}


template <class T> 
SCM 
ListWrapper<T>::eqvLinkList(SCM obj1, SCM  obj2)
{
	if  (EQ(obj1,obj2)) return Truth;
	if  (CXX_NTYPEP(obj1, Wrapper<List<T> >::type))
		Err("typed-list-eqv?: wrong type of argument", obj1);
	if  (CXX_NTYPEP(obj2, Wrapper<List<T> >::type))
		Err("typed-list-eqv?: wrong type of argument", obj2);
	
	if (*(List<T>*) CLASSDATA(obj1) == *(List<T>*) CLASSDATA(obj2))
		return Truth;
	return Ntruth;
}

template <class T> 
SCM 
ListWrapper<T>::lthLinkList(SCM obj1, SCM  obj2)
{
	if  (CXX_NTYPEP(obj1, Wrapper<List<T> >::type))
		Err("typed-list-<: wrong type of argument", obj1);
	if  (CXX_NTYPEP(obj2, Wrapper<List<T> >::type))
		Err("typed-list-<: wrong type of argument", obj2);
	
	if (*(List<T>*) CLASSDATA(obj1) < *(List<T>*) CLASSDATA(obj2))
		return Truth;
	return Ntruth;
}

template <class T> 
SCM 
ListWrapper<T>::leLinkList(SCM obj1, SCM  obj2)
{
	if  (CXX_NTYPEP(obj1, Wrapper<List<T> >::type))
		Err("typed-list-<=: wrong type of argument", obj1);
	if  (CXX_NTYPEP(obj2, Wrapper<List<T> >::type))
		Err("typed-list-<=: wrong type of argument", obj2);
	
	if (*(List<T>*) CLASSDATA(obj1) <= *(List<T>*) CLASSDATA(obj2))
		return Truth;
	return Ntruth;
}

template <class T> 
SCM 
ListWrapper<T>::grLinkList(SCM obj1, SCM  obj2)
{
	if  (CXX_NTYPEP(obj1, Wrapper<List<T> >::type))
		Err("typed-list->: wrong type of argument", obj1);
	if  (CXX_NTYPEP(obj2, Wrapper<List<T> >::type))
		Err("typed-list->: wrong type of argument", obj2);
	
	if (*(List<T>*) CLASSDATA(obj1) > *(List<T>*) CLASSDATA(obj2))
		return Truth;
	return Ntruth;
}

template <class T> 
SCM 
ListWrapper<T>::geLinkList(SCM obj1, SCM  obj2)
{
	if  (CXX_NTYPEP(obj1, Wrapper<List<T> >::type))
		Err("typed-list->=: wrong type of argument", obj1);
	if  (CXX_NTYPEP(obj2, Wrapper<List<T> >::type))
		Err("typed-list->=: wrong type of argument", obj2);
	
	if (*(List<T>*) CLASSDATA(obj1) >= *(List<T>*) CLASSDATA(obj2))
		return Truth;
	return Ntruth;
}

/*****never was used**
template <class T> 
SCM 
ListWrapper<T>::equalLinkList(SCM obj1, SCM  obj2)
{

	if (CXX_TYPEP(obj1, Wrapper<T>::type) &&
	   CXX_TYPEP(obj2, Wrapper<T>::type))
		return eqvLinkList(obj1,obj2);
	if  (CXX_NTYPEP(obj1, Wrapper<List<T> >::type) &&
	     CXX_NTYPEP(obj1, Wrapper<T>::type))
		Err("typed-equal?: wrong type of argument", obj1);
	if  (CXX_NTYPEP(obj2, Wrapper<List<T> >::type) &&
	     CXX_NTYPEP(obj2, Wrapper<T>::type))
		Err("typed-equal?: wrong type of argument", obj2);

	if  (!(CXX_TYPEP(obj1, Wrapper<List<T> >::type) &&
	     CXX_TYPEP(obj2, Wrapper<List<T> >::type)))
		return Ntruth;
	
	List<T> *l1 = (List<T>*) CLASSDATA(obj1);
	List<T> *l2= (List<T>*) CLASSDATA(obj2);

	if (*l1 == *l2)
		return Truth;
	return Ntruth;

	SCM stk_list1 = (SCM) l1->_first;
	SCM stk_list2 = (SCM) l2->_first;

	register SCM ptr1, ptr2;

	for (ptr1=stk_list1, ptr2=stk_list2; NNULLP(ptr1) && NNULLP(ptr2); 
				ptr1 = CDR(ptr1), ptr2 = CDR(ptr2)) { 
		if (eqvLinkList(CAR(ptr1), CAR(ptr2)) == Ntruth)
			return Ntruth;
	}
	return Truth;
}
*************/

/*****************************OLD!!! uses SCM listnodes
template <class T> 
PRIMITIVE 
ListWrapper<T>::buildLinkList(SCM l)
{
	int i;
	SCM tmp, nl;
	
	if (NCONSP(l))
		Err("typed-list: wrong type of argument", tmp);

	for (tmp=l; tmp != NIL; tmp = CDR(tmp))
		if  (CXX_NTYPEP(CAR(tmp), Wrapper<T>::type)) 
			Err("typed-list: wrong type of argument", tmp);

	List<T> *newlist = new List<T>;
	if (len > 0)
		newlist->_first = (ListNode<T>*) l;
	nl = newlist->unprotectHeader();
	return nl;
}
*****************************/

//
// copy of static SCM lmember
//

/****************
template <class T> 
SCM 
ListWrapper<T>::LINK_lmember(SCM obj, SCM  list, SCM (*predicate)(SCM,SCM))
{
	if  (CXX_NTYPEP(list, Wrapper<List<T> >::type))
		Err("typed-list-lmember: wrong type of argument",list);
	if  (CXX_NTYPEP(obj, Wrapper<T>::type))
		Err("typed-list-lmember: wrong type of argument",obj);
	
	List<T> *l = (List<T>*) CLASSDATA(list);
	SCM stk_list = (SCM) l->_first;

	register SCM ptr;

	for (ptr=stk_list; NNULLP(ptr); ) {
	    if (CONSP(ptr)) {
		if ((*predicate)(CAR(ptr), obj) == Truth) 
			return ptr;
	    } else // end of a dotted list 
		return ((*predicate)(ptr, obj) == Truth) ? ptr : Ntruth;
	    if ((ptr=CDR(ptr)) == stk_list) goto Error;
	}
	return Ntruth;
     Error:
	Err("typed-list-member: bad list: ", list);
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::memqLinkList(SCM obj, SCM list)
{
	return LINK_lmember(obj, list, STk_eq);
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::memvLinkList(SCM obj, SCM list)
{
	return LINK_lmember(obj, list, Wrapper<T>::eqv);
}
************/

/*
template <class T> 
PRIMITIVE 
ListWrapper<T>::memberLinkList(SCM obj, SCM list)
{
	return LINK_lmember(obj, list, equalLinkList);
}
*/
/////////////////// Might want to switch back in some form

/*
template <class T> 
PRIMITIVE 
ListWrapper<T>::memberLinkList(SCM obj, SCM list)
{
	return LINK_lmember(obj, list, Wrapper<T>::eqv);
}

	
//
// almost an exact copy of STk's append2
//
template <class T> 
PRIMITIVE 
ListWrapper<T>::LINK_append2(SCM ll1, SCM ll2)
{
  register SCM l1, l2, res, p, z;

  List<T> *list1 = (List<T>*) CLASSDATA(ll1);
  List<T> *list2 = (List<T>*) CLASSDATA(ll2);
  l1 = (SCM) list1->_first;
  l2 = (SCM) list2->_first;

  if (NULLP(l1)) return ll2;
  if (NCONSP(l1)) 
	Err("append: argument is not a list", l1);

  for (res = NIL; ; l1 = CDR(l1)) {
    if (NCONSP(l1))      
	Err("append: argument is not a list", l1);
    if (res == NIL){
      NEWCELL(res, tc_cons);
      //res = LINK_newListNode();
      p = res;
    }
    else {
      NEWCELL(CDR(p), tc_cons);
      //CDR(p) = LINK_newListNode();
      p = CDR(p);
    }
    CAR(p) = CAR(l1);
    CDR(p) = NIL;               // Keep alwys a valid list in case of a GC 
    if (NCONSP(CDR(l1))) break; // p is marked by STk_mark_stack           
  }
  CDR(p) = l2;
  List<T> *listres = new List<T>();
  listres->_first = (ListNode<T>*) res;
  z = listres->unprotectHeader();
  return z;
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::appendLinkList(SCM l, int len)
{
	switch (len) {
		case 0:	return NIL;
		case 1: if  (CXX_NTYPEP(CAR(l), Wrapper<List<T> >::type))
                	   Err("typed-list-append: wrong type of argument", 
								CAR(l));
			return CAR(l);
		case 2: if  (CXX_NTYPEP(CAR(l), Wrapper<List<T> >::type))
                	    Err("typed-list-append: wrong type of argument", 
								CAR(l));
		        if  (CXX_NTYPEP(CAR(CDR(l)), Wrapper<List<T> >::type))
                	    Err("typed-list-append: wrong type of argument", 
								CAR(CDR(l)));
			return LINK_append2(CAR(l), CAR(CDR(l)));
		default:return LINK_append2(CAR(l), 
					appendLinkList(CDR(l), len-1));
	}
}
**************/


template <class T> 
PRIMITIVE 
ListWrapper<T>::makeLinkList()
{
	SCM z;
        List<T> nl;
	//z = nl->unprotectHeader();
	z = newWrappedList(nl, LINK_DYNAMIC);
	return z;
}

/****************
template <class T> 
PRIMITIVE 
ListWrapper<T>::carLinkList(SCM l)
{
	//cout << "Wrapper<List<T> >::type:" << Wrapper<List<T> >::type << endl;
	//cout << "tc_CXXwrapper: " << tc_CXXwrapper << endl; 
	//cout << "TYPE(l):" << TYPE(l) << endl;
	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-car: wrong type of argument", l);

	List<T> *oldlist = (List<T> *) CLASSDATA(l);
	return  CAR((SCM) oldlist->_first);
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::cdrLinkList(SCM l)
{
	SCM nl, first;

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-cdr: wrong type of argument", l);

	List<T> *newlist = new List<T>();
	List<T> *oldlist = (List<T> *) CLASSDATA(l);
	//nl = STk_make_CXXwrapper(Wrapper<List<T> >::type, 
	//			 Wrapper<List<T> >::name,
	//			 (void*)newlist, LINK_DYNAMIC);
	nl = newlist->unprotectHeader();
	first = (SCM) oldlist->_first;
	if (NTYPEP(first, tc_nil))
		newlist->_first = (ListNode<T>*) CDR(first);
	else 
		Err("typed-list-cdr: empty list: ", l);
	return nl;
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::setCarLinkList(SCM l, SCM value)
{
	SCM nl, first;

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-set-car!: wrong type of argument", l);

	if  (CXX_NTYPEP(value, Wrapper<T>::type))
		Err("typed-list-set-car!: wrong type of argument", value);

	List<T> *list1 = (List<T> *) CLASSDATA(l);
	first = (SCM) list1->_first;
	CAR(first) = value;
	return UNDEFINED;
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::setCdrLinkList(SCM l, SCM l2)
{
	SCM nl, first1, first2;

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-set-cdr!: wrong type of argument", l);

	if  (CXX_NTYPEP(l2, Wrapper<List<T> >::type))
		Err("typed-list-set-cdr!: wrong type of argument", l2);

	List<T> *list1 = (List<T> *) CLASSDATA(l);
	List<T> *list2 = (List<T> *) CLASSDATA(l2);
	first1 = (SCM) list1->_first;
	first2 = (SCM) list2->_first;
	CDR(first1) = first2;
	return UNDEFINED;
}



template <class T> 
PRIMITIVE 
ListWrapper<T>::consLinkList(SCM e, SCM l)
{
	SCM z, nl;

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

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-cons: wrong type of argument", l);

	List<T> *newlist = new List<T>();
	List<T> *oldlist = (List<T> *) CLASSDATA(l);
	nl = newlist->unprotectHeader();

	NEWCELL(z, tc_cons);
	//z = LINK_newListNode();
	CAR(z) = e;
	CDR(z) = (SCM) oldlist->_first;
	newlist->_first = (ListNode<T> *) z;
	return nl;
}


template <class T> 
PRIMITIVE 
ListWrapper<T>::tailLinkList(SCM l, SCM k)
{
	SCM z, nl;

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-convert: wrong type of argument", l);

	List<T>* ll = (List<T>*) CLASSDATA(l);
	z = STk_list_tail( (SCM) ll->_first, k);
	List<T> *newlist = new List<T>();
	//nl = STk_make_CXXwrapper(Wrapper<List<T> >::type, 
	//			 Wrapper<List<T> >::name,
	//			 (void*) newlist, LINK_DYNAMIC);
	nl = newlist->unprotectHeader();
	newlist->_first = (ListNode<T>*) z;
	return nl;
}

template <class T> 
PRIMITIVE 
ListWrapper<T>::refLinkList(SCM l, SCM k)
{
	SCM z;

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-convert: wrong type of argument", l);

	List<T>* ll = (List<T>*) CLASSDATA(l);
	return STk_list_ref( (SCM) ll->_first, k);
}
*******/

template <class T> 
PRIMITIVE 
ListWrapper<T>::stkList2LinkList(SCM l)
{
	return buildLinkList(l);
}


template <class T> 
PRIMITIVE 
ListWrapper<T>::linkList2STkList(SCM l)
{
	SCM last=NIL, z;

	if  (CXX_NTYPEP(l, Wrapper<List<T> >::type))
		Err("typed-list-convert: wrong type of argument", l);

	List<T> *lp = (List<T>*) CLASSDATA(l);
	Iterator<T> get_next(lp);
	T e;
	while (get_next(e)) {
		NEWCELL(z, tc_cons);
		CAR(z) = newWrappedElement(e, LINK_DYNAMIC);
		CDR(z) = last;
		last = z;
	}
	return STk_reverse(last);
}


template <class T> 
void 
ListWrapper<T>::markTypedList(SCM p)
{
	//cout << "markTypedList" << endl;
/*********
	if  (CXXw_NTYPEP(p, Wrapper<List<T> >::type))
		Err("mark_typed_list: wrong type of argument", p);

	List<T> *l = (List<T>*) EXTDATA(p);
	ListNode<T> *ln = l->firstNode();
	if (ln)
		STk_gc_mark((SCM) ln);
***********/
}

template <class T> 
void 
ListWrapper<T>::freeTypedList(SCM p)
{
	//cout << "freeTypedList" << endl;
	if  (CXXw_NTYPEP(p, Wrapper<List<T> >::type))
		Err("free-typed-list: wrong type of argument", p);

	if (!EXTSTATICP(p))
	    delete (List<T> *) EXTDATA(p); // if STK_LISTS is defined then
				           // STk takes care of the list
				           // nodes since they're SCM's.
}
	
template <class T> 
void 
ListWrapper<T>::displayTypedList(SCM c, SCM port, int mode)
{

	if  (CXXw_NTYPEP(c, Wrapper<List<T> >::type))
		Err("display-typed-list: wrong type of argument", c);

        ostrstream oss;
	List<T> *p = (List<T>*) EXTDATA(c);
	p->display(oss);
	oss << ends;
        char *buffer = oss.str();
        Puts(buffer, FILEPTR(port));
        delete buffer;
}