/*
 * functional program copyright (C) 2009 - 2013 H.Niwa
 */

/*
 * 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, 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., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301, USA.
 */
#include "config.h"

#include <stdio.h>
#include <stdlib.h>
#include <errno.h>

#include <string>
#include <complex>

#include "syserr.h"

#include "bin_node.h"
#include "gc.h"
#include "context.h"
#include "pred.h"
#include "unify.h"
#include "builtin.h"
#include "sysmodule.h"
#include "var.h"
#include "ncurlib.h"
#include "compiler.h"
#include "func.h"



int Func(Context* cx, Node* goalscar, List* module);
int FuncPred(Context* cx, Node* goals);
int FuncPred(Context* cx, Node* goals, List* module);
int FuncPred(Context* cx, Node* g, List* module, Node* &retn);

int FuncPredSub(Context* cx, Node* g, List* module, Node* &retn);

int Func(Context* cx, Node* goalscar, List* module)
{
//	Node*	g = goalscar->Val();
	Node*	g = goalscar;
	Node*	rn;
	int	rval;
	
	if (ListLength(g) != 3) {
		syserr("func : <func var <...>> \n");
		return 0;
	}
		
	g = g->Cdr();
	Node* nval = g->Car()->Val();

	g = g->Cdr();
	
	cxpush(cx, g);
	cxpush(cx, module);
//printf("Func g start "); g->print(); printf("\n");
	if ( ! ((rval = FuncPred(cx, g, module, rn))>=0)) {
		cxpop(cx);
		cxpop(cx);
		return rval;
	}
	cxpop(cx);
	cxpop(cx);

//PrintNode("Func rn ", rn);
//printf("Func rval %d \n", rval);

	if (rval == 0) {
		return rval;
	}
	
	rn = rn->Car()->Val();
	if (nval->kind() != UNDEF) {
		if (nval->Eq(rn)) {
			return 1;
		} else {
			return 0;
		}

	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nval);
	((Undef*)nval)->Set(rn);
	PushStack(cx, goalscar, Nil, env);
		
	return rval;
}

int FuncPred(Context* cx, Node* goals)
{
	extern List* Module;
	Node* retn = Nil;
	return FuncPred(cx, goals, Module, retn);
}

int FuncPred(Context* cx, Node* goals, List* module)
{
	Node* retn = Nil;
	return FuncPred(cx, goals, module, retn);
}


int FuncPred(Context* cx, Node* g, List* module, Node* &retn)
{
	return FuncPredSub(cx, g, module, retn);
}


int FuncPredSub(Context* cx, Node* g, List* module, Node* &retn)
{
	Node*	newn = Nil;
	Node*	rn = Nil;
	Node*	retncar = Nil;
	Node*	retncdr = Nil;
	int	rval;

	extern	int	TraceFlag;
		
//	g = g->Val();
#if 0
	if (TraceFlag) {
		PrintNode("func : ", g);
	}
#endif
	
	if (g->kind() == ATOM || g->kind() == VAR || g->kind() == UNDEF) {
		retn = g;
		return 1;
	} else if (g->kind() == LIST) {
		retncar = retncdr = Nil;
		cxpush(cx, g);
		cxpush(cx, module);
		if(!((rval = FuncPredSub(cx, g->Car(), module, retncar))>=0)) {
			cxpop(cx);
			cxpop(cx);
			retn = g;
			return rval;
		}
/*
		cxpop(cx);
		cxpop(cx);
		cxpush(cx, g);
		cxpush(cx, module);
*/
		if (g->Cdr() == Nil) {
			cxpop(cx);
			cxpop(cx);
			retncdr = Nil;
		} else {
			cxpush(cx, retncar);
			if(!((rval = FuncPredSub(cx, g->Cdr(), module, retncdr))>=0)) {
				cxpop(cx);
				cxpop(cx);
				cxpop(cx);
				retn = g;
				return rval;
			}
			cxpop(cx);
			cxpop(cx);
			cxpop(cx);
		}
		retn = Cons(retncar, retncdr);
		return rval;
	} else { // if g->kind() == PRED
		if (g->Car()->Eq(mka("quote"))) {
			retn = g->Cdr()->Car();
			return 1;
		} else {
			if ((g->Car()->Eq(mka("obj"))) 
					|| (g->Car()->Eq(mka("unify")))) {
				g = g->Val();
#if 0
				if (g->Cdr()->Car()->Eq(mka("sys3"))) {
					int r;
					int rt = sysmodule(cx, g->Cdr()->Cdr()->Car(),
							Nil, Nil, 
							module, r);
					retn = g->Cdr()->Cdr()->Car()->Cdr()->Car()
									->Val();
					if (rt) {
						if (r>0) {
					    		if (TraceFlag) {
								PrintNode("sys module: ", g->Val(), "...success");
							}
						} else {
						    if (TraceFlag) {
							if (r == 0) {
								PrintNode("sys module: ", g->Val(), "...false");
							} else {	// rval == -1
								PrintNode("sys module: ", g->Val(), "...unknown");
							}
						    }
						    return r;
						}
					} else {
						return -1;
					}
					return 1;
					
				}
#endif
				int r = DoUnify(cx, g,	module);

				retn = g->Cdr()->Cdr()->Car()->Cdr()->Car()
								->Val();
				if (r>0) {
			    		if (TraceFlag) {
						PrintNode("module: ", g->Val(), "...success");
					}
					return r;
				} else {
				    if (TraceFlag) {
					if (r == 0) {
						PrintNode("module: ", g->Val(), "...false");
					} else {	// rval == -1
						PrintNode("module: ", g->Val(), "...unknown");
					}
				    }
				    return r;
				}
			}
			retncar = retncdr = Nil;
			cxpush(cx, g);
			cxpush(cx, module);
			if(!((rval = FuncPred(cx, g->Car(), module, retncar))>=0)) {
				cxpop(cx);
				cxpop(cx);
				retn = g;
				return rval;
			}
/*
			cxpop(cx);
			cxpop(cx);
			cxpush(cx, g);
			cxpush(cx, module);
*/
			if (g->Cdr() == Nil) {
				cxpop(cx);
				cxpop(cx);
				retncdr = Nil;
			} else {
				cxpush(cx, retncar);
				if(!((rval=FuncPred(cx, g->Cdr(), module, retncdr))>=0)) {
					cxpop(cx);
					cxpop(cx);
					cxpop(cx);
					retn = g;
					return rval;
				}
				cxpop(cx);
				cxpop(cx);
				cxpop(cx);
			}
			newn = MkPred(Cons(retncar, retncdr));
		}
	}

	if (newn->kind() != PRED) {
//printf("FuncPred not PRED return \n");
		retn = newn;
		return 1;
	}
	
//PrintNode("FuncPred Pred call Unify ", newn);
	
	cxpush(cx, newn);
	cxpush(cx, g);
	cxpush(cx, module);

	if (TraceFlag) {
		PrintNode("func : ", newn);
	}

	if ((rval=Unify(cx, newn, module))>0) {
		cxpop(cx);
		cxpop(cx);
		cxpop(cx);
		if (newn->Car()->Eq(mka("obj")) ||
		    newn->Car()->Eq(mka("unify"))) {
			retn = newn->Cdr()->Cdr()->Car();
		} else {
			retn = newn->Cdr()->Car();
		}
//printf("FuncPred return %d \n", rval);
		return rval;
	} else {
		cxpop(cx);
		cxpop(cx);
		cxpop(cx);
		retn = g;
//printf("FuncPred return %d \n", rval);
		return rval;
	}
}


