// 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: 7-Aug-1997
// 
#include <stk.h>
#include <iostream.h>
#include <strstream.h>
#include <LINK/stkWrapper/LINK_STk.h>
template <class Item> 
Array<Item>* 
ArrayWrapper<Item>::getArray(SCM p)
{
	int &Array_Type 	= Wrapper<Array<Item> >::type;
	Array<Item> *cp;
	if (CXX_TYPEP(p, Array_Type))
		cp = (Array<Item>*) CLASSDATA(p);
	else
		cp = 0;
	return cp;
}
template <class Item> 
Bool 
ArrayWrapper<Item>::isArray(SCM p)
{
	int &Array_Type 	= Wrapper<Array<Item> >::type;
	if (CXX_TYPEP(p, Array_Type))
		return TRUE;
	return FALSE;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::linkArrayP(SCM l)
{
	return  isArray(l) ? Truth : Ntruth; 
}
template <class Item> 
void 
ArrayWrapper<Item>::markTypedArray(SCM p)
{}
template <class Item> 
void 
ArrayWrapper<Item>::freeTypedArray(SCM p)
{
	int &Array_Type 	= Wrapper<Array<Item> >::type;
	if (CXXw_TYPEP(p, Array_Type))
		if (!EXTSTATICP(p))
	    		delete (Array<Item> *) EXTDATA(p); 
	else
		Err("free-typed-array: wrong type of argument", p);
}
	
template <class Item> 
void 
ArrayWrapper<Item>::displayTypedArray(SCM c, SCM port, int mode)
{
	int &Array_Type 	= Wrapper<Array<Item> >::type;
	Array<Item>* cp;
	if (CXXw_TYPEP(c, Array_Type))
		cp = (Array<Item>*) EXTDATA(c);
	else 
		Err("display-typed-array: wrong type of argument", c);
        ostrstream oss;
        cp->display(oss);
	oss << ends;
        char *buffer = oss.str();
        Puts(buffer, port);
        delete buffer;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::makeLinkArray(SCM k)
{
	int x = STk_integer_value(k);
	SCM ns;
	Array<Item>* new_array;
	int &Array_Type = Wrapper<Array<Item> >::type;
	char*Array_Name = Wrapper<Array<Item> >::name;
        new_array = new Array<Item>(x);
	ns = STk_make_CXXwrapper(Array_Type,Array_Name,
				 (void*)new_array,LINK_DYNAMIC);
	return ns;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::makeFilledLinkArray(SCM k, SCM e)
{
	int i;
	int x = STk_integer_value(k);
	SCM ns;
	Array<Item>* new_array;
	int &Array_Type = Wrapper<Array<Item> >::type;
	char*Array_Name = Wrapper<Array<Item> >::name;
	if  (CXX_NTYPEP(e, Wrapper<Item>::type))
                Err("typed-array-insert: wrong type of argument", e);
        new_array = new Array<Item>(x);
	ns = STk_make_CXXwrapper(Array_Type,Array_Name,
				 (void*)new_array,LINK_DYNAMIC);
	Item elem =  * (Item *) CLASSDATA(e);
	for (i=0; i<x; i++)
		(*new_array)[i] = elem;
	return ns;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::copyLinkArray(SCM l)
{
	SCM ns;
	Array<Item> *new_array, *old_array;
	int &Array_Type = Wrapper<Array<Item> >::type;
	char*Array_Name = Wrapper<Array<Item> >::name;
	if (isArray(l))
		old_array = getArray(l);	
        new_array = new Array<Item>(*old_array);
	ns = STk_make_CXXwrapper(Array_Type,Array_Name,
				 (void*)new_array,LINK_DYNAMIC);
	return ns;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::fillLinkArray(SCM l, SCM e)
{
	int i, count;
	Array<Item>* a;
	if  (CXX_NTYPEP(l, Wrapper<Array<Item> >::type))
                Err("typed-array-insert: argument not an array", l);
	if  (CXX_NTYPEP(e, Wrapper<Item>::type))
                Err("typed-array-insert: wrong type of argument", e);
        if (isArray(l))
        	a = getArray(l);
	Item elem =  * (Item *) CLASSDATA(e);
	count = a->_size;		//need to be a friend of class Array
	for (i=0; i<count; i++)		//or else it needs an allocation() mth.
		(*a)[i] = elem;
	return UNDEFINED;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::buildLinkArray(SCM l)
{
	SCM ns;
	Array<Item>* new_array;
	int &Array_Type = Wrapper<Array<Item> >::type;
	char*Array_Name = Wrapper<Array<Item> >::name;
	if (l == NIL)
                new_array = new Array<Item>;
	else if (INTEGERP(l)) {
                new_array = new Array<Item>(INTEGER(l));
	} else if (isArray(l)) {
		new_array = getArray(l);
		new_array = new Array<Item>(*new_array);
	} else 
		Err("typed-array: wrong type of argument", l);
	ns = STk_make_CXXwrapper(Array_Type,Array_Name,
				 (void*)new_array,LINK_DYNAMIC);
	return ns;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::stkList2LinkArray(SCM l)
{
	return buildLinkArray(l);
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::linkArray2STkList(SCM l)
{
	if (!isArray(l))
		Err("typed-array-convert: wrong type of argument", l);
	Array<Item> *cp = getArray(l);
	//cp->display(cout);
	Iterator<Item> get_next(cp);
	Item e;
	if (get_next(e)) {
		SCM new_el = STk_make_CXXwrapper(Wrapper<Item>::type, 
			Wrapper<Item>::name, (void*) new Item(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<Item>::type, 
				Wrapper<Item>::name,(void*) new Item(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 Item> 
PRIMITIVE 
ArrayWrapper<Item>::lengthLinkArray(SCM l)
{
	if (!isArray(l))
		Err("typed-array-length: wrong type of argument", l);
	Array<Item> *cp = getArray(l);
	SCM z;
  	NEWCELL(z, tc_integer);
  	SET_INTEGER(z, cp->size());
  	return z;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::eqvLinkArray(SCM l, SCM l2)
{
/*
	if (Wrapper<Array<Item> >::compareItems(l, l2) == 0)
		return Truth;
	return Ntruth;
*/
	if (!isArray(l))
		Err("typed-array-eqv?: wrong type of argument", l);
	if (!isArray(l2))
		Err("typed-array-eqv?: wrong type of argument", l2);
	Array<Item> *cp = getArray(l);
	Array<Item> *cp2 = getArray(l2);
	return (*cp == *cp2) ? Truth : Ntruth;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::lthLinkArray(SCM l, SCM l2)
{
	if (!isArray(l))
		Err("typed-array-<: wrong type of argument", l);
	if (!isArray(l2))
		Err("typed-array-<: wrong type of argument", l2);
	Array<Item> *cp = getArray(l);
	Array<Item> *cp2 = getArray(l2);
	return (*cp < *cp2) ? Truth : Ntruth;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::leLinkArray(SCM l, SCM l2)
{
	if (!isArray(l))
		Err("typed-array-<=: wrong type of argument", l);
	if (!isArray(l2))
		Err("typed-array-<=: wrong type of argument", l2);
	Array<Item> *cp = getArray(l);
	Array<Item> *cp2 = getArray(l2);
	return (*cp <= *cp2) ? Truth : Ntruth;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::grLinkArray(SCM l, SCM l2)
{
	if (!isArray(l))
		Err("typed-array->?: wrong type of argument", l);
	if (!isArray(l2))
		Err("typed-array->?: wrong type of argument", l2);
	Array<Item> *cp = getArray(l);
	Array<Item> *cp2 = getArray(l2);
	return (*cp > *cp2) ? Truth : Ntruth;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::geLinkArray(SCM l, SCM l2)
{
	if (!isArray(l))
		Err("typed-array->?: wrong type of argument", l);
	if (!isArray(l2))
		Err("typed-array->?: wrong type of argument", l2);
	Array<Item> *cp = getArray(l);
	Array<Item> *cp2 = getArray(l2);
	return (*cp >= *cp2) ? Truth : Ntruth;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::refLinkArray(SCM l, SCM k)
{
	SCM res = NIL;
	Array<Item>* cp;
	long x = STk_integer_value(k);
	if (isArray(l)) {
		cp = getArray(l);
		Item t = (*cp)[x];
		res = STk_make_CXXwrapper(Wrapper<Item>::type, Wrapper<Item>::name,
			(void*)new Item(t),LINK_DYNAMIC);
	}
	return res;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::setLinkArray(SCM l, SCM k, SCM e)
{
	Array<Item>* cp;
	if  (CXX_NTYPEP(e, Wrapper<Item>::type))
                Err("typed-array-insert: wrong type of argument", e);
	long x = STk_integer_value(k);
	if (isArray(l)) {
		Item elem =  * (Item *) CLASSDATA(e);
		cp = getArray(l);
		(*cp)[x] = elem;
	}
	return UNDEFINED;
}
template <class Item> 
PRIMITIVE 
ArrayWrapper<Item>::resizeLinkArray(SCM l, SCM k)
{
	Array<Item>* cp;
	long x = STk_integer_value(k);
	if (isArray(l)) {
		cp = getArray(l);
		cp->resize(x);
	}
	return UNDEFINED;
}
