/************************************************************************
 ************************************************************************
    FAUST compiler
	Copyright (C) 2003-2004 GRAME, Centre National de Creation Musicale
    ---------------------------------------------------------------------
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    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 a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ************************************************************************
 ************************************************************************/
 
 
 
/*****************************************************************************
******************************************************************************
								LIST 
						Y. Orlarey, (c) Grame 2002
------------------------------------------------------------------------------
This file contains several extensions to the tree library : 
	- lists : based on a operations like cons, hd , tl, ... 
	- environments : list of associations (key value)
	- property list : used to annotate trees


 API:
 ---- 

	List :
	-----
	
	nil					= predefined empty list
	cons (x,l)			= create a nex list of head x and tail l
	hd(cons(x,l)) 		= x, 
	tl (cons(x,l)) 		= l
	nth(l,i)			= ith element of l (or nil)
	replace(l,i,e)		= a copy of l where the ith element is e
	len(l)				= number of elements of l
	isNil(nil) 			= true 		(false otherwise)
	isList(cons(x,l)) 	= true 		(false otherwise)
	list(a,b,..)		= cons(a, list(b,...))
	
	lmap(f, cons(x,l))	= cons(f(x), lmap(f,l))
	reverse([a,b,..,z])	= [z,..,b,a]
	reverseall([a,b,..,z])	= [ra(z),..,ra(b),ra(a)] where ra is reverseall
	
	Set :
	-----
	(Sets are implemented as ordered lists of elements without duplication)
	
	isElement(e,s)			= true if e is an element of set s, false otherwise
	addElement(e,s)			= s U {e}
	remElement(e,s)			= s - {e}
	singleton(e)			= {e}
	list2set(l)				= convert a list into a set 
	setUnion(s1,s2)			= s1 U s2
	setIntersection(s1,s2)	= s1 intersection s2
	setDifference(s1,s2)	= s1 - s2
	
	Environment : 
	-------------
	
	An 'environment' is a stack of pairs (key x value) used to keep track of lexical bindings
	
	pushEnv (key, val, env) -> env' create a new environment
	searchEnv (key,&v,env) -> bool  search for key in env and set v accordingly
	
	search(k1,&v, push(k2,x,env)) 	= true and v is set to x if k1==k2
									= search(k1,&v,env) if k1 != k2
	Property list :
	---------------
	
	Every tree can be annotated with an 'attribut' field. This attribute field 
	can be used to manage a property list (pl). A property list is a list of pairs
	key x value, with three basic operations :
	
	setProperty (t, key, val) -> t		add the association (key x val) to the pl of t
	getProperty (t, key, &val) -> bool	search the pp of t for the value associated to key
	remProperty (t, key) -> t			remove any association (key x ?) from the pl of t
	
 Warning :
 ---------
 Since reference counters are used for garbage collecting, one must be careful not to 
 create cycles in trees. The only possible source of cycles is by setting the attribut
 of a tree t to a tree t' that contains t as a subtree.  
	
 History :
 ---------
 	2002-02-08 : First version
 	2002-02-20 : New description of the API, non recursive lmap and reverse
 	2002-03-29 : Added function remElement(e,set), corrected comment error
	
******************************************************************************
*****************************************************************************/

#include <stdlib.h>
#include "list.hh"
#include "compatibility.hh"
#include <map>
#include <cstdlib>

// predefined symbols CONS and NIL
Sym CONS = symbol("cons");
Sym NIL  = symbol("nil");

// predefined nil tree
Tree nil = tree(NIL);


//------------------------------------------------------------------------------
// Printing of trees with special case for lists
//------------------------------------------------------------------------------

static bool printlist (Tree l, FILE* out)
{
	if (isList(l)) {
		
		char sep = '(';
		
		do {
			fputc(sep, out); sep = ',';
			print(hd(l));
			l = tl(l);
		} while (isList(l));
		
		if (! isNil(l)) {
			fprintf(out, " . ");
			print(l, out);
		}
		
		fputc(')', out);
		return true;
		
	} else if (isNil(l)) {
		
		fprintf(out, "nil");
		return true;
		
	} else {
		
		return false;
	}
}

void print (Tree t, FILE* out)
{
	int i; double f; Sym s; void* p;
	
	if (printlist(t, out))		return;
	
	Node n = t->node();
		 if (isInt(n, &i)) 		fprintf (out, "%d", i);
	else if (isDouble(n, &f)) 	fprintf (out, "%f", f);
	else if (isSym(n, &s)) 		fprintf (out, "%s", name(s));
	else if (isPointer(n, &p)) 	fprintf (out, "#%p", p);
	
	int k = t->arity();
	if (k > 0) {
		char sep = '[';
		for (int i=0; i<k; i++) {
			fputc(sep, out); sep = ',';
			print(t->branch(i), out);
		}
		fputc(']', out);
	} 
}


//------------------------------------------------------------------------------
// Elements of list
//------------------------------------------------------------------------------

Tree nth (Tree l, int i)
{
	while (isList(l)) {
		if (i == 0)  return hd(l);
		l = tl(l);
		i--;
	}
	return nil;
}

Tree replace(Tree l, int i, Tree e)
{
	return (i==0) ? cons(e,tl(l)) : cons( hd(l), replace(tl(l),i-1,e) );
}


int len (Tree l)
{
	int 	n = 0;
	while (isList(l)) { l = tl(l); n++; }
	return n;
}


//------------------------------------------------------------------------------
// Mapping and reversing
//------------------------------------------------------------------------------

Tree rconcat (Tree l, Tree q)
{
	while (isList(l)) { q = cons(hd(l),q); l = tl(l); }
	return q;
}

Tree concat (Tree l, Tree q)
{
	return rconcat(reverse(l), q);
}

Tree lrange (Tree l, int i, int j)
{
	Tree 	r = nil;
	int 	c = j;
	while (c>i) r = cons( nth(l,--c), r);
	return r;
}

//------------------------------------------------------------------------------
// Mapping and reversing
//------------------------------------------------------------------------------

static Tree rmap (tfun f, Tree l)
{
	Tree r = nil;
	while (isList(l)) { r = cons(f(hd(l)),r); l = tl(l); }
	return r;
}

Tree reverse (Tree l)
{
	Tree r = nil;
	while (isList(l)) { r = cons(hd(l),r); l = tl(l); }
	return r;
}

Tree lmap (tfun f, Tree l)
{
	return reverse(rmap(f,l));
}

Tree reverseall (Tree l)
{
	return isList(l) ? rmap(reverseall, l) : l;
}


//------------------------------------------------------------------------------
// Sets : implemented as ordered list
//------------------------------------------------------------------------------

bool isElement (Tree e, Tree l)
{
	while (isList(l)) {
		if (hd(l) == e) return true;
		if (hd(l) > e) return false;
		l = tl(l);
	}
	return false;
}

Tree addElement(Tree e, Tree l)
{
	if (isList(l)) {
		if (e < hd(l)) {
			return cons(e,l);
		} else if (e == hd(l)) {
			return l;
		} else {
			return cons(hd(l), addElement(e,tl(l)));
		}
	} else {
		return cons(e,nil);
	}
}

Tree remElement(Tree e, Tree l)
{
	if (isList(l)) {
		if (e < hd(l)) {
			return l;
		} else if (e == hd(l)) {
			return tl(l);
		} else {
			return cons(hd(l), remElement(e,tl(l)));
		}
	} else {
		return nil;
	}
}

Tree singleton (Tree e)
{
	return list1(e);
}

Tree list2set (Tree l)
{
	Tree s = nil;
	while (isList(l)) {
		s = addElement(hd(l),s);
		l = tl(l);
	}
	return s;
}

Tree setUnion (Tree A, Tree B)
{
	if (isNil(A)) 		return B;
	if (isNil(B)) 		return A;
	
	if (hd(A) == hd(B)) return cons(hd(A), setUnion(tl(A),tl(B)));
	if (hd(A) < hd(B)) 	return cons(hd(A), setUnion(tl(A),B));
	/* hd(A) > hd(B) */	return cons(hd(B), setUnion(A,tl(B)));
}

Tree setIntersection (Tree A, Tree B)
{
	if (isNil(A)) 		return A;
	if (isNil(B)) 		return B;
	if (hd(A) == hd(B)) return cons(hd(A), setIntersection(tl(A),tl(B)));
	if (hd(A) < hd(B)) 	return setIntersection(tl(A),B);
	/* (hd(A) > hd(B)*/	return setIntersection(A,tl(B));
}

Tree setDifference (Tree A, Tree B)
{
	if (isNil(A)) 		return A;
	if (isNil(B)) 		return A;
	if (hd(A) == hd(B)) return setDifference(tl(A),tl(B));
	if (hd(A) < hd(B)) 	return cons(hd(A), setDifference(tl(A),B));
	/* (hd(A) > hd(B)*/	return setDifference(A,tl(B));
}
	
		

//------------------------------------------------------------------------------
// Environments
//------------------------------------------------------------------------------

Tree pushEnv (Tree key, Tree val, Tree env)
{
	return cons (cons(key,val), env);
}

bool searchEnv (Tree key, Tree& v, Tree env)
{
	while (isList(env)) {
		if (hd(hd(env)) == key) {
			v = tl(hd(env));
			return true;
		}
		env = tl(env);
	}
	return false;
}


//------------------------------------------------------------------------------
// Property list
//------------------------------------------------------------------------------

static bool findKey (Tree pl, Tree key, Tree& val)
{
	if (isNil(pl)) 				return false;
	if (left(hd(pl)) == key) 	{ val= right(hd(pl)); return true; }
	/*  left(hd(pl)) != key	*/	return findKey (tl(pl), key, val); 
}

static Tree updateKey (Tree pl, Tree key, Tree val)
{
	if (isNil(pl)) 				return cons ( cons(key,val), nil );
	if (left(hd(pl)) == key) 	return cons ( cons(key,val), tl(pl) );
	/*  left(hd(pl)) != key	*/	return cons ( hd(pl), updateKey( tl(pl), key, val ));
}

static Tree removeKey (Tree pl, Tree key)
{
	if (isNil(pl)) 				return nil;
	if (left(hd(pl)) == key) 	return tl(pl);
	/*  left(hd(pl)) != key	*/	return cons (hd(pl), removeKey(tl(pl), key));
}


#if 0
void setProperty (Tree t, Tree key, Tree val)
{
	CTree* pl = t->attribut();
	if (pl) t->attribut(updateKey(pl, key, val)); 
	else 	t->attribut(updateKey(nil, key, val));
}

void remProperty (Tree t, Tree key)
{
	CTree* pl = t->attribut();
	if (pl) t->attribut(removeKey(pl, key));
}

bool getProperty (Tree t, Tree key, Tree& val)
{
	CTree* pl = t->attribut();
	if (pl) return findKey(pl, key, val);
	else 	return false;
}

#else
// nouvelle implementation
void setProperty (Tree t, Tree key, Tree val)
{
	t->setProperty(key, val);
}

bool getProperty (Tree t, Tree key, Tree& val)
{
	CTree* pl = t->getProperty(key);
	if (pl) {
		val = pl;
		return true;
	} else {
		return false;
	}
}

void remProperty (Tree t, Tree key)
{
	exit(1); // fonction not implemented
}
#endif


//------------------------------------------------------------------------------
// Bottom Up Tree Mapping
//------------------------------------------------------------------------------

Tree tmap (Tree key, tfun f, Tree t)
{	
	//printf("start tmap\n");
	Tree p; 
	
	if (getProperty(t, key, p)) {
		
		return (isNil(p)) ? t : p;	// truc pour eviter les boucles
		
	} else {
		
		Tree r1=nil;
		switch (t->arity()) {
			
			case 0 : 
				r1 = t; 
				break;
			case 1 : 
				r1 = tree(t->node(), tmap(key,f,t->branch(0))); 
				break;
			case 2 : 
				r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1))); 
				break;
			case 3 : 
				r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)),
										   tmap(key,f,t->branch(2))); 
				break;
			case 4 : 
				r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)),
										   tmap(key,f,t->branch(2)), tmap(key,f,t->branch(3))); 
				break;
		}
		Tree r2 = f(r1);
		if (r2 == t) {
			setProperty(t, key, nil);
		} else {
			setProperty(t, key, r2);
		}
		return r2;
	}
}
		




//------------------------------------------------------------------------------
// substitute :remplace toutes les occurences de 'id' par 'val' dans 't'
//------------------------------------------------------------------------------

// genere une clef unique propre � cette substitution
static Tree substkey(Tree t, Tree id, Tree val) 
{
	char 	name[256];
	snprintf(name, 255, "SUBST<%p,%p,%p> : ", (CTree*)t, (CTree*)id, (CTree*)val);
	return tree(unique(name));
}	

// realise la substitution proprement dite tout en mettant � jour la propriete
// pour ne pas avoir � la calculer deux fois

static Tree subst (Tree t, Tree propkey, Tree id, Tree val)
{
	Tree p;
	
	if (t==id) {
		return val;
		
	} else if (t->arity() == 0) {
		return t;
	} else if (getProperty(t, propkey, p)) {
		return (isNil(p)) ?  t : p;
	} else {
		Tree r=nil;
		switch (t->arity()) {
			
			case 1 : 
				r = tree(t->node(), 
							subst(t->branch(0), propkey, id, val)); 
				break;
				
			case 2 : 
				r = tree(t->node(), 
							subst(t->branch(0), propkey, id, val), 
							subst(t->branch(1), propkey, id, val)); 
				break;
				
			case 3 : 
				r = tree(t->node(), 
							subst(t->branch(0), propkey, id, val), 
							subst(t->branch(1), propkey, id, val), 
							subst(t->branch(2), propkey, id, val)); 
				break;
				
			case 4 : 
				r = tree(t->node(), 
							subst(t->branch(0), propkey, id, val), 
							subst(t->branch(1), propkey, id, val), 
							subst(t->branch(2), propkey, id, val), 
							subst(t->branch(3), propkey, id, val)); 
				break;
			
		}
		if (r == t) {
			setProperty(t, propkey, nil);
		} else {
			setProperty(t, propkey, r);
		}
		return r;
	}
		
}

// remplace toutes les occurences de 'id' par 'val' dans 't'
Tree substitute (Tree t, Tree id, Tree val)
{
	return subst (t, substkey(t,id,val), id, val);
}
	
	
	

	
