/*
 * built-in program copyright (C) 2009 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 <unistd.h>

#include <errno.h>
#include <setjmp.h>
#include <sys/time.h>
#include <math.h>
#include <libgen.h>
#include <setjmp.h>

#ifndef __CYGWIN__
#ifndef __MINGW32__ 
#include <wait.h>
#endif /* __MINGW32__ */
#endif /* __CYGWIN__ */

#ifndef __MINGW32__ 
#include <readline/readline.h>
#include <readline/history.h>
#endif /* __MINGW32__ */

#include <string>
#include <complex>

#include "syserr.h"

#include "bin_node.h"
#include "gc.h"
#include "var.h"
#include "pred.h"
#include "context.h"
#include "unify.h"
#include "builtin.h"
#include "sysmodule.h"
#include "expression.h"
#include "let.h"
#include "func.h"
#include "token.h"
#include "module.h"
#include "code.h"
#include "timeout.h"
#include "help.h"

#define MAXPATHLEN 4096

extern int TraceFlag;
extern jmp_buf program_jb;

int incflag = 0;

extern void PushStack(Context* cx, Node* goals, Node* md, Node* env);
extern int PopStack(Context* cx, Node* &goals, Node* &md, Node* &env);

int ListLength(Node* n);

int Eval(Context* cx, Node* goalscar);
int Include(Context* cx, Node* goalscar);
int Load(Context* cx, Node* goalscar);
int Save(Context* cx, Node* goalscar);
int Editor(Context* cx, Node* goalscar);
int ChDir(Context* cx, Node* goalscar);
int GetPwd(Context* cx, Node* goalscar);
int Dir(Context* cx, Node* goalscar);
int Plist(Context* cx, Node* goalscar);
int Quit(Context* cx, Node* goalscar);
int DoNew(Context* cx, Node* goalscar);

int Quote(Context* cx, Node* goalscar);

extern int Format(Context* cx, Node* goalscar);
int EscSeq(Context* cx, Node* goalscar);
int Printf(Context* cx, Node* goalscar, List* module);
int PrintList(Context* cx, Node* goalscar, List* module);
int PrintListNL(Context* cx, Node* goalscar, List* module);
int Warn(Context* cx, Node* goalscar, List* module);

int GetModule(Context* cx, Node* goalscar);
int DoUnify(Context* cx, Node* goalscar, List* module);
int TimeOut(Context* cx, Node* goalscar, List* module);
int DoLoop(Context* cx, Node* goalscar, List* module);
int DoOrPred(Context* cx, Node* goalscar, List* module);
int DoAlt(Context* cx, Node* goalscar, List* module);
int DoNot(Context* cx, Node* goalscar, List* module);
int DoFor(Context* cx, Node* goalscar, List* module);
int DoForeach(Context* cx, Node* goalscar, List* module);
int DoFindAll(Context* cx, Node* goalscar, List* module);

int DoAsserta(Context* cx, Node* goalscar, List* module);
int DoAssertz(Context* cx, Node* goalscar, List* module);
int DoRetract(Context* cx, Node* goalscar, List* module);
int DoRetractPred(Context* cx, Node* goalscar, List* module);


int ObjSetMethoda(Node* nobj, Node* npred, Node* module);
int ObjSetMethodz(Node* nobj, Node* npred, Node* module);
int ObjDelMethoda(Node* nobj, Node* npred, Node* module);
int ObjDelMethodz(Node* nobj, Node* npred, Node* module);

int DoNewObj(Context* cx, Node* goalscar, List* module);
int DoSetMethoda(Context* cx, Node* goalscar, List* module);
int DoSetMethodz(Context* cx, Node* goalscar, List* module);
int DoDelMethoda(Context* cx, Node* goalscar, List* module);
int DoDelMethodz(Context* cx, Node* goalscar, List* module);
int Self(Context* cx, Node* goalscar, List* module);
int Super(Context* cx, Node* goalscar, List* module);

int DoSetVar(Context* cx, Node* goalscar, List* module);
int DoSetArray(Context* cx, Node* goalscar, List* module);
int DoDelVar(Context* cx, Node* goalscar, List* module);
int DoDelArray(Context* cx, Node* goalscar, List* module);

int ObjSetVar(Node* nobj, Node* nvar, Node* val, List* module);
int ObjDelVar(Node* nobj, Node* nvar, List* module);
int ObjSetArray(Node* nobj, Node* nvar, Node* val, Node* index, List* module);
int ObjDelArray(Node* nobj, Node* nvar, Node* index, List* module);


int Tron();
int Troff();

#ifndef __CYGWIN__
#ifndef __MINGW32__ 
int CmdExec(char* arg0, char* arg1)
{
	int rc;
	int st = 0;
	
	rc = fork();
	if (rc < 0) {
		syserr("CmdExec : %s %s \n", arg0, arg1);
		return 0;
	} else if (rc > 0) {
		wait(&st);
		return WEXITSTATUS(st) == 0;
	} else {
		execlp(arg0, arg0, arg1, NULL);
	}
}

int CmdExec(char* arg0)
{
	int rc;
	int st = 0;
	
	rc = fork();
	if (rc < 0) {
		syserr("CmdExec : %s \n", arg0);
		return 0;
	} else if (rc > 0) {
		wait(&st);
		return WEXITSTATUS(st) == 0;
	} else {
		execlp(arg0, arg0, NULL);
	}
}
#endif
#endif

#ifdef __CYGWIN__
int FNameCheck(char* buf)
{
	int	i;

	for (i = 0; i < strlen(buf); i++) {
		switch(buf[i]) {
		case '*' :
		case '?' :
		case '\"' :
		case '<' :
		case '>' :
		case '|' :
			buf[i] = 0;
			return 0;
			break;
		}
		if (buf[i] == 0) {
			return 1;
			break;
		}
	}
	return 1;
}

int CmdExec(char* arg0, char* arg1)
{
	std::string s = arg0;
	s += " ";
	s += arg1;

	int r = system(s.c_str());
	
	return r == 0;
}

int CmdExec(char* arg0)
{
	int r = system(arg0);

	return r == 0;
}

#endif

#ifdef __MINGW32__
int FNameCheck(char* buf)
{
	int	i;

	for (i = 0; i < strlen(buf); i++) {
		switch(buf[i]) {
		case '*' :
		case '?' :
		case '\"' :
		case '<' :
		case '>' :
		case '|' :
			buf[i] = 0;
			return 0;
			break;
		}
		if (buf[i] == 0) {
			return 1;
			break;
		}
	}
	return 1;
}

int CmdExec(char* arg0, char* arg1)
{
	std::string s = arg0;
	s += " ";
	s += arg1;

//printf("CmdExec %s \n", s.c_str());
	int r = system(s.c_str());
	
	return r == 0;
}

int CmdExec(char* arg0)
{
	int r = system(arg0);

	return r == 0;
}

#endif


char* tmppath;

void GetTmpPath()
{
	tmppath = getenv(TMPPATH);
	if (tmppath == NULL) {
		tmppath = "/tmp";
	}
}

char* editorpath;

void GetEditorPath()
{
	editorpath = getenv(DEDITORPATH);
	if (editorpath == NULL) {
		editorpath = getenv(EDITORPATH);
		if (editorpath == NULL) {
#ifndef __MINGW32__
			editorpath = "vi";
#else
			editorpath = "notepad";
#endif
		}
	}
}


int ListLength(Node* n)
{
	int	i;

	if ((n->kind() != LIST) && (n->kind() != PRED)) {
		return 0;
	}

	for (i = 0; n->kind() != ATOM; i++, n=n->Cdr()) 
		;

	return i;
}


int builtin(Context* cx, Node* goalscar, Node* &goalscdr, 
				Node* &goals, List* module, int& r)
{
	if (goalscar->Val()->Car()->kind() == ATOM) {
		std::string	s;
		((Atom*)(goalscar->Val()->Car()))->toString(s);
		if (s == "help") {
			r = Help(cx, goalscar);
			return 1;
		} else if (s == "module") {
			r = GetModule(cx, goalscar);
			return 1;
		} else if (s == "list") {
			r = Plist(cx, goalscar);
			return 1;
		} else if (s == "bye") {
			r = Quit(cx, goalscar);
			return 1;
		} else if (s == "quit") {
			r = Quit(cx, goalscar);
			return 1;
		} else if (s == "new") {
			r = DoNew(cx, goalscar);
			return 1;
		} else if (s == "eval") {
			r = Eval(cx, goalscar);
			return 1;
		} else if (s == "print") {
			WriteNl(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "printf") {
			r = Printf(cx, goalscar, module);
			return 1;
		} else if (s == "printlist") {
			r = PrintList(cx, goalscar, module);
			return 1;
		} else if (s == "printlistnl") {
			r = PrintListNL(cx, goalscar, module);
			return 1;
		} else if (s == "warn") {
			r = Warn(cx, goalscar, module);
			return 1;
		} else if (s == "include") {
			r = Include(cx, goalscar);
			return 1;
		} else if (s == "load") {
			r = Load(cx, goalscar);
			return 1;
		} else if (s == "save") {
			r = Save(cx, goalscar);
			return 1;
		} else if (s == "edit") {
			r = Editor(cx, goalscar);
			return 1;
		} else if (s == "cd") {
			r = ChDir(cx, goalscar);
			return 1;
		} else if (s == "pwd") {
			r = GetPwd(cx, goalscar);
			return 1;
		} else if (s == "dir") {
			r = Dir(cx, goalscar);
			return 1;
		} else if (s == "ls") {
			r = Dir(cx, goalscar);
			return 1;
		} else if (s == "quote") {
			r = Quote(cx, goalscar);
			return 1;
		} else if (s == "%") {
			r = Format(cx, goalscar);
			return 1;
		} else if (s == "\\") {
			r = EscSeq(cx, goalscar);
			return 1;
		} else if (s == "obj") {
			r = DoUnify(cx, goalscar, module);
			return 1;
		} else if (s == "unify") {
			r = DoUnify(cx, goalscar, module);
			return 1;
		} else if (s == "timeout") {
			r = TimeOut(cx, goalscar, module);
			return 1;
		} else if (s == "loop") {
			r = DoLoop(cx, goalscar, module);
			return 1;
		} else if (s == "alt") {
			r = DoAlt(cx, goalscar, module);
			return 1;
		} else if (s == "for") {
			r = DoFor(cx, goalscar, module);
			return 1;
		} else if (s == "foreach") {
			r = DoForeach(cx, goalscar, module);
			return 1;
		} else if (s == "map") {
			r = DoForeach(cx, goalscar, module);
			return 1;
		} else if (s == "findall") {
			r = DoFindAll(cx, goalscar, module);
			return 1;
		} else if (s == "or") {
			r = DoOrPred(cx, goalscar, module);
			return 1;
		} else if (s == "not") {
			r = DoNot(cx, goalscar, module);
			return 1;
		} else if (s == "tron") {
			r = Tron();
			return 1;
		} else if (s == "troff") {
			r = Troff();
			return 1;
		} else if (s == "let") {
			r = int_let(cx, goalscar);
			return 1;
		} else if (s == "letf") {
			r = float_let(cx, goalscar);
			return 1;
		} else if (s == "letc") {
			r = complex_let(cx, goalscar);
			return 1;
		} else if (s == "rpnf") {
			r = float_rpn(cx, goalscar);
			return 1;
		} else if (s == "rpnc") {
			r = complex_rpn(cx, goalscar);
			return 1;
		} else if (s == "rpn") {
			r = int_rpn(cx, goalscar);
			return 1;
		} else if (s == "func") {
			r = Func(cx, goalscar, module);
			return 1;
		} else if (s == "f") {
			r = Func(cx, goalscar, module);
			return 1;
		} else if (s == "comparef") {
			r = float_compare(cx, goalscar);
			return 1;
		} else if (s == "compare") {
			r = int_compare(cx, goalscar);
			return 1;
		} else if (s == "TOKEN") {
			r = token(cx, goalscar, goalscdr, goals, module);
			return 1;
		} else if (s == "SKIPSPACE") {
			tokenSkipSpace(cx);
			r = 1;
			return 1;
		} else if (s == "C") {
			r = tokenC(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "N") {
			r = tokenN(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "A") {
			r = tokenA(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "AN") {
			r = tokenAN(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "^") {
			r = tokenLineHead(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "$") {
			r = tokenLineEnd(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "CR") {
			r = tokenCR(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "CNTL") {
			r = tokenCNTL(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "EOF") {
			r = tokenEof(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "SPACE") {
			r = tokenSpace(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "PUNCT") {
			r = tokenPunct(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "STRINGS") {
			r = tokenStrings(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "WORD") {
			r = tokenWORD(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "NUM") {
			r = tokenNum(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "FNUM") {
			r = tokenFNum(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "ID") {
			r = tokenID(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "RANGE") {
			r = tokenRange(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "NONRANGE") {
			r = tokenNonRange(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "GETTOKEN") {
			r = tokenGettoken(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "SKIP") {
			r = tokenSkip(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "SKIPCR") {
			r = tokenSkipCR(cx, goalscar, goalscdr, goals);
			return 1;
		} else if (s == "asserta") {
			r = DoAsserta(cx, goalscar, module);
			return 1;
		} else if (s == "assertz") {
			r = DoAssertz(cx, goalscar, module);
			return 1;
		} else if (s == "assert") {
			r = DoAsserta(cx, goalscar, module);
			return 1;
		} else if (s == "erase") {
			r = DoRetract(cx, goalscar, module);
			return 1;
		} else if (s == "retract") {
			r = DoRetract(cx, goalscar, module);
			return 1;
		} else if (s == "retractpred") {
			r = DoRetractPred(cx, goalscar, module);
			return 1;
		} else if (s == "newObj") {
			r = DoNewObj(cx, goalscar, module);
			return 1;
		} else if (s == "delObj") {
			r = DoDelVar(cx, goalscar, module);
			return 1;
		} else if (s == "objName") {
			r = Self(cx, goalscar, module);
			return 1;
		} else if (s == "self") {
			r = Self(cx, goalscar, module);
			return 1;
		} else if (s == "super") {
			r = Super(cx, goalscar, module);
			return 1;
		} else if (s == "setVar") {
			r = DoSetVar(cx, goalscar, module);
			return 1;
		} else if (s == "setArray") {
			r = DoSetArray(cx, goalscar, module);
			return 1;
		} else if (s == "delVar") {
			r = DoDelVar(cx, goalscar, module);
			return 1;
		} else if (s == "delArray") {
			r = DoDelArray(cx, goalscar, module);
			return 1;
		}
	}
	r = -1;
	return 0;
}


int Eval(Context* cx, Node* goalscar)
{
	if (goalscar->Cdr() != Nil) {
		syserr("usage : <eval> \n");
		return 0;
	}
	
	extern FILE* RdFp;
	FILE* fdsave = RdFp;
	RdFp = cx->ioin;

	cxpush(cx, Module);

	jmp_buf savejb;
	memcpy(&savejb, &program_jb, sizeof(jmp_buf));
	
	extern  int     NwccMain();	
	NwccMain();

	memcpy(&program_jb, &savejb, sizeof(jmp_buf));
	
	cxpop(cx);

	RdFp = fdsave;
	return 1;
}


int Include(Context* cx, Node* goalscar)
{
	Node* g = goalscar->Cdr();
	if (ListLength(g) != 1) {
		syserr("usage : <include OBJ-FILE> or <include MODULE-NAME> \n");
		return 0;
	}

	Node* nname = g->Car()->Val();
	if (nname->kind() != ATOM) {
		syserr("include : name argument of args should be a atom. \n");
		return 0;
	}

	std::string sfile;
	((Atom*)nname)->toString(sfile);

	FILE* fd;

	GetLibPath();

	char* dfile = strdup((char*)sfile.c_str());
	char* bfile = strdup((char*)sfile.c_str());
	char* dname = dirname(dfile);
	char* bname = basename(bfile);
	free(dfile);
	free(bfile);

	if ((dname[0] == '.') && (dname[1] == 0) 
			&& (sfile.c_str()[1] != '/') ) {
		Node* nd;
		fd = NULL;

		if (dlibpathnode == Nil) {
			fd = fopen(sfile.c_str(), "rb");
		} else {			
			for (nd = dlibpathnode; nd != Nil; nd=nd->Cdr()) {
				std::string s = "";

				if (nd->Car()->kind() != ATOM) {
					continue;
				}

				((Atom*)(nd->Car()))->toString(s);
#ifndef __MINGW32__
				s = s + "/" + sfile;
#else
				s = s + "\\" + sfile;
#endif

				fd = fopen(s.c_str(), "rb");
				if (fd != NULL) {
					break;
				}
			}
		}
	} else {
		fd = fopen(sfile.c_str(), "rb");
	}
	if (fd == NULL) {
		PrintNode("include : file name : ", nname);
		printf("include : Can not open include file \n");
		return 0;
	}

	extern FILE* RdFp;
	FILE* fdsave = RdFp;
	RdFp = fd;

	List* modulesave = Module;
	Module = (List*)Nil->Cons(Nil);

	cxpush(cx, Module);
	cxpush(cx, modulesave);

	jmp_buf savejb;
	memcpy(&savejb, &program_jb, sizeof(jmp_buf));

	extern  int     NwccMain();	
	NwccMain();

	memcpy(&program_jb, &savejb, sizeof(jmp_buf));

	cxpop(cx);
	cxpop(cx);

	Assert(modulesave, MkList(MkPred(Cons(nname, Module->Car()))));
	Module = modulesave;
	fclose(fd);
	RdFp = fdsave;
	
	incflag = 1;
	return 1;
	
}

int Load(Context* cx, Node* goalscar)
{
	Node* g = goalscar->Cdr();
	if (ListLength(g) != 1) {
		syserr("usage : <load OBJ-FILE> or <load MODULE-NAME> \n");
		return 0;
	}

	Node* nname = g->Car()->Val();
	if (nname->kind() != ATOM) {
		syserr("load : name argument of args should be a atom. \n");
		return 0;
	}

	std::string sfile;
	((Atom*)nname)->toString(sfile);

	FILE* fd;

	GetLibPath();

	char* dfile = strdup((char*)sfile.c_str());
	char* bfile = strdup((char*)sfile.c_str());
	char* dname = dirname(dfile);
	char* bname = basename(bfile);
	free(dfile);
	free(bfile);

	if ((dname[0] == '.') && (dname[1] == 0) 
			&& (sfile.c_str()[1] != '/') ) {
		Node* nd;
		fd = NULL;

		if (dlibpathnode == Nil) {
			fd = fopen(sfile.c_str(), "rb");
		} else {			
			for (nd = dlibpathnode; nd != Nil; nd=nd->Cdr()) {
				std::string s = "";

				if (nd->Car()->kind() != ATOM) {
					continue;
				}

				((Atom*)(nd->Car()))->toString(s);
#ifndef __MINGW32__
				s = s + "/" + sfile;
#else
				s = s + "\\" + sfile;
#endif

				fd = fopen(s.c_str(), "rb");
				if (fd != NULL) {
					break;
				}
			}
		}
	} else {
		fd = fopen(sfile.c_str(), "rb");
	}
	if (fd == NULL) {
		PrintNode("load : file name : ", nname);
		printf("load : Can not open load file \n");
		return 0;
	}

	extern FILE* RdFp;
	FILE* fdsave = RdFp;
	RdFp = fd;

	cxpush(cx, Module);

	jmp_buf savejb;
	memcpy(&savejb, &program_jb, sizeof(jmp_buf));
	
	extern  int     NwccMain();	
	NwccMain();

	memcpy(&program_jb, &savejb, sizeof(jmp_buf));

	cxpop(cx);

	fclose(fd);
	RdFp = fdsave;

	incflag = 1;
	
	return 1;
	
}

int Save(Context* cx, Node* goalscar)
{
	Node* g = goalscar->Cdr();
	if (ListLength(g) != 1) {
		syserr("usage : <save OBJ-FILE> or <save MODULE-NAME> \n");
		return 0;
	}

	Node* nname = g->Car()->Val();
	if (nname->kind() != ATOM) {
		syserr("save : name argument of args should be a atom. \n");
		return 0;
	}

	std::string sfile;
	((Atom*)nname)->toString(sfile);

	FILE* fd;

	GetLibPath();

	char* dfile = strdup((char*)sfile.c_str());
	char* bfile = strdup((char*)sfile.c_str());
	char* dname = dirname(dfile);
	char* bname = basename(bfile);
	free(dfile);
	free(bfile);

	fd = fopen(sfile.c_str(), "w");
	if (fd == NULL) {
		PrintNode("save : file name : ", nname);
		printf("save : Can not open save file \n");
		return 0;
	}

	printstrflag = 1;

	FILE* fdsave = cx->ioout;
//	cx->ioout = fd;
	
//	Module->print(fd);

	PPmodule(Module, fd);fprintf(fd, "\n");


	cx->ioout = fdsave;
	
	printstrflag = 0;

	fclose(fd);

	incflag = 1;
	
	return 1;
	
}

int Editor(Context* cx, Node* goalscar)
{
	Node* g = goalscar->Cdr();
	if (ListLength(g) != 1) {
		syserr("usage : <edit FILE-NAME>  \n");
		return 0;
	}

	Node* nname = g->Car()->Val();
	if (nname->kind() != ATOM) {
		syserr("editor : name argument of args should be a atom. \n");
		return 0;
	}

	std::string sfile;
	((Atom*)nname)->toString(sfile);

#ifdef __MINGW32__
	// file name check 
	char* sp = (char*)malloc(sfile.length()+1);
	strcpy(sp, sfile.c_str());

	int rf = FNameCheck(sp);

	sfile = sp;
	free(sp);

	if (!rf) {
		return 0;
	}

#endif

	if (!CmdExec(editorpath, (char*)sfile.c_str())) {
		return 0;
	}

#if 0	
	FILE* fd;

	GetLibPath();

	char* dfile = strdup((char*)sfile.c_str());
	char* bfile = strdup((char*)sfile.c_str());
	char* dname = dirname(dfile);
	char* bname = basename(bfile);
	free(dfile);
	free(bfile);

	if ((dname[0] == '.') && (dname[1] == 0) 
			&& (sfile.c_str()[1] != '/') ) {
		Node* nd;
		fd = NULL;

		if (dlibpathnode == Nil) {
			fd = fopen(sfile.c_str(), "rb");
		} else {			
			for (nd = dlibpathnode; nd != Nil; nd=nd->Cdr()) {
				std::string s = "";

				if (nd->Car()->kind() != ATOM) {
					continue;
				}

				((Atom*)(nd->Car()))->toString(s);
#ifndef __MINGW32__
				s = s + "/" + sfile;
#else
				s = s + "\\" + sfile;
#endif

				fd = fopen(s.c_str(), "rb");
				if (fd != NULL) {
					break;
				}
			}
		}
	} else {
		fd = fopen(sfile.c_str(), "rb");
	}
	if (fd == NULL) {
		PrintNode("load : file name : ", nname);
		printf("load : Can not open load file \n");
		return 0;
	}

	extern FILE* RdFp;
	FILE* fdsave = RdFp;
	RdFp = fd;

	cxpush(cx, Module);

	jmp_buf savejb;
	memcpy(&savejb, &program_jb, sizeof(jmp_buf));
	
	extern  int     NwccMain();	
	NwccMain();

	memcpy(&program_jb, &savejb, sizeof(jmp_buf));

	cxpop(cx);

	fclose(fd);
	RdFp = fdsave;

	incflag = 1;
#endif
	
	return 1;
	
}

int ChDir(Context* cx, Node* goalscar)
{
	extern int	pargc;
	extern char**	pargv;

	Node* g = goalscar->Cdr();
	if (ListLength(g) != 1) {
		syserr("usage : <cd PATH> \n");
		return 0;
	}

	Node* npath = g->Car()->Val();

	if (npath->kind() != ATOM) {
		syserr("usage : <cd PATH> \n");
		return 0;
	}

	std::string spath;
	((Atom*)npath)->toString(spath);

	int r = chdir(spath.c_str());
	if (r != 0) {
		return -1;
	}
	return 1;
	
}

int GetPwd(Context* cx, Node* goalscar)
{
	extern int	pargc;
	extern char**	pargv;

	Node* g = goalscar->Cdr();
	if (ListLength(g) != 1) {
		syserr("usage : <pwd VAR> \n");
		return 0;
	}

	Node* nvar = g->Car()->Val();
	if (nvar->kind() != UNDEF) {
		syserr("pwd: argument of args should be a variable. ");
		return 0;
	}

	Node*	npwd = Nil;

	extern char* GetCwd();
	
	char* cpwd = GetCwd();
	if (cpwd == NULL) {
		return 0;
	}
	
	npwd = mka(cpwd);

	free(cpwd);
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)(nvar->Val()))->Set(npwd);

	PushStack(cx, Nil, Nil, env);
	return 1;
	
}

int Dir(Context* cx, Node* goalscar)
{
	Node* g = goalscar->Cdr();
	if (goalscar->Cdr() != Nil) {
		syserr("usage : <dir/ls> \n");
		return 0;
	}

#ifdef __MINGW32__
	CmdExec("dir");
#else 
	CmdExec("ls");
#endif

	return 1;
}

int Plist(Context* cx, Node* goalscar)
{
	Node* g = goalscar->Cdr();
	if (goalscar->Cdr() != Nil) {
		syserr("usage : <list> \n");
		return 0;
	}

	PPmodule(cx->module);

	return 1;
}


int Quit(Context* cx, Node* goalscar)
{

	Node* g = goalscar->Cdr();
	if (goalscar->Cdr() != Nil) {
		syserr("usage : <quit> \n");
		return 0;
	}

	exit(0);
	return 1;
}

int DoNew(Context* cx, Node* goalscar)
{

	Node* g = goalscar->Cdr();
	if (goalscar->Cdr() != Nil) {
		syserr("usage : <new> \n");
		return 0;
	}

	Module = (List*)Nil->Cons(Nil);

	return 1;
}

int Quote(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		syserr("usage : <quote PRED> \n");
		return 0;
	}
	
	return 1;
}

int EscSeq(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		syserr("usage : <\\CHAR> \n");
		return 0;
	}

	Node*	n = goalscar->Cdr()->Val();
	Node*	nvar = n->Car();
	n = n->Cdr();
	Node*	nval = n->Car();

	if (nvar->kind() != UNDEF) {
		syserr("usage : <\\CHAR> \n");
		return 0;
	}

	if (nval->kind() != ATOM) {
		syserr("usage : <\\CHAR> \n");
		return 0;
	}

	std::string s;
	((Atom*)nval)->toString(s);
	
	if (s.length() != 1) {
		return 0;
	}

	char buf[3];

	switch(s[0]) {
	case 'a' :
		buf[0] = 0x07;
		break;
	case 'b' :
		buf[0] = 0x08;
		break;
	case 'f' :
		buf[0] = 0x0c;
		break;
	case 'n' :
		buf[0] = 0x0a;
		break;
	case 'r' :
		buf[0] = 0x0d;
		break;
	case 't' :
		buf[0] = 0x09;
		break;
	default: 
		return 0;
		break;
	}
	buf[1] = 0;
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)(nvar->Val()))->Set(mka(buf));

	PushStack(cx, Nil, Nil, env);

	return 1;
}

int Printf(Context* cx, Node* goalscar, List* module)
{
	Node*	n = goalscar->Cdr()->Val();

	for ( ; n->kind() != ATOM; n=n->Cdr()) {
		int rn;
		Node* np = n->Car();
		
		cxpush(cx, goalscar);	
		cxpush(cx, module);	
		if ((rn = FuncArg(cx, np, module)) <= 0) {
			cxpop(cx);
			cxpop(cx);
			return rn;
		}
		cxpop(cx);
		cxpop(cx);

		np->print(cx->ioout);
	}
	return 1;
}

int PrintList(Context* cx, Node* goalscar, List* module)
{
	Node*	n = goalscar->Cdr()->Val();
	if (ListLength(n) != 1) {
		return 0;
	}
	if (n->Car()->kind() != LIST) {
		return 0;
	}

	n->Car()->printcdr(cx->ioout);
	fprintf(cx->ioout, "\n");
	
	return 1;
}

int PrintListNL(Context* cx, Node* goalscar, List* module)
{
	Node*	n = goalscar->Cdr()->Val();
	if (ListLength(n) != 1) {
		return 0;
	}
	if (n->Car()->kind() != LIST) {
		return 0;
	}

	n = n->Car();

	for ( ; n->kind() != ATOM; n = n->Cdr()) {
		if (n->Car()->kind() == ATOM) {
			n->Car()->print(cx->ioout);
		} else {
			n->Car()->printcdr(cx->ioout);
		}
		fprintf(cx->ioout, "\n");
	}
	
	return 1;
}

int Warn(Context* cx, Node* goalscar, List* module)
{
	Node*	n = goalscar->Cdr()->Val();

	for ( ; n->kind() != ATOM; n=n->Cdr()) {
		int rn;
		Node* np = n->Car();
		
		cxpush(cx, goalscar);	
		cxpush(cx, module);	
		if ((rn = FuncArg(cx, np, module)) <= 0) {
			cxpop(cx);
			cxpop(cx);
			return rn;
		}
		cxpop(cx);
		cxpop(cx);

		np->print(stderr);
	}
	fprintf(stderr, "\n");
	return 1;
}


int GetModule(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		syserr("usage : <getmodule VAR> \n");
		return 0;
	}

	Node*	n = goalscar->Cdr()->Val();
	Node*	nvar = n->Car();
	n = n->Cdr();

	if (n != Nil) {
		return 0;
	}

	if (nvar->Val()->kind() == UNDEF) {
		Node* env = Nil->Cons(Nil);

		SetEnv(env, nvar->Val());
		((Undef*)(nvar->Val()))->Set(cx->module);

		PushStack(cx, Nil, Nil, env);
		return 1;
	}

	return 0;
}

int getvar(Node* var, Node* mod, Node*& val)
{
	val = Nil;

	if (mod->kind() != LIST) {
		return 0;
	}
	Node* m = (Node*)mod;

	for ( ; m->kind() != ATOM; m = m->Cdr()) {
		if (m->Car()->kind() == LIST) {
			if (m->Car()->Car()->kind() == PRED) {

				if (m->Car()->Car()->Car()->Eq(var)) {
					val = m->Car()->Car()->Cdr();
					return 1;
				}
			}
		}
	}
	return 0;
}

// <Unify module goals>
int DoUnify(Context* cx, Node* goalscar, List* module)
{
	int	rn;
	
	if (ListLength(goalscar->Cdr()) < 2) {
		syserr("usage : <unify MODULE PRED> \nusage : <obj OBJ PRED> \n");
		return 0;
	}
	
	Node*	n = goalscar->Cdr();
	Node*	marg = n->Car()->Val();
	Node*	mname = mka("WORLD");
	
	if (marg->kind() == ATOM) {
		if (cx->modulename->Eq(mka("WORLD"))) {
			mname = marg;
		} else {
			mname = cx->modulename;
		}
		
		std::string argname;
		((Atom*)marg)->toString(argname);

		// sys module pred
		if (((Atom*)marg)->EqStr("sys")) {
			int r = 1;
			int rt;
//			cx->inherit = Cons(mka("sys"), cx->inherit);
			Node* g = goalscar->Cdr()->Cdr();
			if (g->Car()->kind() != PRED) {
				g = g->Car();
			}
//			do {
				rt = sysmodule(cx, g->Car(), Nil, Nil, 
							module, r);
				if (rt) {
					if (r>0) {
				    		if (TraceFlag) {
							PrintNode("sys module: ", goalscar->Val(), "...success");
						}
					} else {
					    if (TraceFlag) {
						if (r == 0) {
							PrintNode("sys module: ", goalscar->Val(), "...false");
						} else {	// rval == -1
							PrintNode("sys module: ", goalscar->Val(), "...unkown");
						}
					    }
					    return r;
					}
				} else {
					return -1;
				}
//				g = g->Cdr();
//			} while (g->kind() != ATOM);
			return 1;
		}
		if (ListLength(goalscar->Cdr()->Cdr()->Car()) >= 4) {
			Node* g = goalscar->Cdr()->Cdr();
			if (g->Car()->Car()->kind() == ATOM) {
				std::string s;
				
				((Atom*)g->Car()->Car())->toString(s);
				
				if (s == "setArray") {
					Node* nobj = marg;
					Node* nvar = g->Car()->Cdr()->Car();
					Node* val = g->Car()->Cdr()->Cdr()->Car();
					Node* index = g->Car()->Cdr()->Cdr()->Cdr()->Car();
					return ObjSetArray(nobj, nvar, val, index, module);
				}
			}
		}
		if (ListLength(goalscar->Cdr()->Cdr()->Car()) >= 3) {
			Node* g = goalscar->Cdr()->Cdr();
			if (g->Car()->Car()->kind() == ATOM) {
				std::string s;
				
				((Atom*)g->Car()->Car())->toString(s);
				
				if (s == "setVar") {
					Node* nobj = marg;
					Node* nvar = g->Car()->Cdr()->Car();
					Node* val  = g->Car()->Cdr()->Cdr()->Car();
					return ObjSetVar(nobj, nvar, val, module);
				} else if (s == "delArray") {
					Node* nobj = marg;
					Node* nvar  = g->Car()->Cdr()->Car();
					Node* index = g->Car()->Cdr()->Cdr()
							->Car();
					return ObjDelArray(nobj, nvar, index, 
								module);
				}
			}
		}
		if (ListLength(goalscar->Cdr()->Cdr()->Car()) >= 2) {
			Node* g = goalscar->Cdr()->Cdr();
			if (g->Car()->Car()->kind() == ATOM) {
				std::string s;

				((Atom*)g->Car()->Car())->toString(s);
				
				if (s == "addMethod") {
					Node* nobj = marg;
					Node* npred = g->Car()->Cdr();
					return ObjSetMethoda(nobj, npred, module);
				} else if (s == "addMethoda") {
					Node* nobj = marg;
					Node* npred = g->Car()->Cdr();
					return ObjSetMethoda(nobj, npred, module);
				} else if (s == "addMethodz") {
					Node* nobj = marg;
					Node* npred = g->Car()->Cdr();
					return ObjSetMethodz(nobj, npred, module);
				} else if (s == "delMethod") {
					Node* nobj = marg;
					Node* npred = g->Car()->Cdr()->Car();
					return ObjDelMethoda(nobj, npred, module);
				} else if (s == "delMethoda") {
					Node* nobj = marg;
					Node* npred = g->Car()->Cdr()->Car();
					return ObjDelMethoda(nobj, npred, module);
				} else if (s == "delMethodz") {
					Node* nobj = marg;
					Node* npred = g->Car()->Cdr()->Car();
					return ObjDelMethodz(nobj, npred, module);
				} else if (s == "delVar") {
					Node* nobj = marg;
					Node* nvar = g->Car()->Cdr()->Car();
					return ObjDelVar(nobj, nvar, module);
				}
			}
		}
		
		if (!getvar(marg, module->Car(), marg)) {
			syserr("obj/unify : cannot find obj module %s \n", 
					argname.c_str());
			return 0;
		}
		marg = Append(Dup(marg), module->Car());
		marg = MkList(marg);
	}

	if (marg->kind() != LIST) {
		marg = MkList(marg);
	}

	List*	m = (List*)marg;
	
	n = n->Cdr();

	Node*	gl = n;

	if (gl->kind() != LIST) {
		gl = MkList(gl);
	}

	Context *cx2 = new Context(m, mname);
	cx2->inherit = cx->inherit;
	cx2->ioin = cx->ioin;
	cx2->ioout = cx->ioout;
	cx2->tokenflag = cx->tokenflag;
	cx2->token = cx->token;

	cxpush(cx2, gl);
	cxpush(cx2, goalscar);
	cxpush(cx2, m);
	cxpush(cx2, n);
	if ((rn=Unify(cx2, gl, m))>0) {
		cx->Merge(cx2);

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		delete cx2;
		cx2 = 0;

		return rn;
	} else {
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		delete cx2;
		cx2 = 0;

		return rn;
	}
	return 0;
}

int TimeOut(Context* cx, Node* goalscar, List* module)
{
#if 1
	int	rn;
	
	if (ListLength(goalscar->Cdr()) != 2) {
		syserr("usage : <timeout TIMEOUT(usec) PRED> \n");
		return 0;
	}
	
	Node*	timearg = goalscar->Cdr()->Car();
	if (timearg->kind() != ATOM) {
		syserr("usage : <timeout *TIMEOUT(usec)* PRED> \n");
		return 0;
	}
	long long tm;
	if (!((Atom*)timearg)->toInt(tm)) {
		syserr("usage : <timeout *TIMEOUT(usec)* PRED> \n");
		return 0;
	}
	if (tm < 0) {
		syserr("A negative number cannot be specified as TIMEOUT.\n");
		return 0;
	}
	
	Node*	predarg = goalscar->Cdr()->Cdr()->Car();
	if (predarg->kind() != PRED) {
		syserr("usage : <timeout TIMEOUT(usec) *PRED*> \n");
		return 0;
	}


	timeout* tim = RegistTime(tm);
	if (setjmp(tim->jbuf)) {
		PopContext(cx);

		delete tim;
		
		return -1;
	}

	Context* cx2 = new Context(module);
	cx2->inherit = cx->inherit;
	cx2->ioin = cx->ioin;
	cx2->ioout = cx->ioout;
	cx2->tokenflag = cx->tokenflag;

	cxpush(cx2, goalscar);
	cxpush(cx2, predarg);
	cxpush(cx2, module);
	if ((rn=Unify(cx2, predarg, module))>0) {
		cx->Merge(cx2);

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		delete cx2;
		cx2 = 0;

		delete tim;
		return rn;
	} else {
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		delete cx2;
		cx2 = 0;

		delete tim;
		return rn;
	}
#endif
}

// <loop preds>
// { preds }
int DoLoop(Context* cx, Node* goalscar, List* module)
{
	int	r;
	
	Node*	gl = MkList(goalscar->Cdr());

	Context *cx2 = new Context(module);
	cx2->ioin = cx->ioin;
	cx2->ioout = cx->ioout;
	cx2->tokenflag = cx->tokenflag;
	cx2->token = cx->token;

	cxpush(cx2, gl);

	do {
		long inp = ftell(cx2->ioin);
		
		r = Unify(cx2, gl, module);

		if (r>0) {
			if (cx->tokenflag) cx->token = cx2->token;
			inp = ftell(cx2->ioin);
		}

		cx2->Clear();

		fseek(cx2->ioin, inp, 0);

	} while (r>0);

	cxpop(cx2);
	
	delete cx2;
	cx2 = 0;

	return 1;
}

// <or preds>
// [ preds ]
int DoOrPred(Context* cx, Node* goalscar, List* module)
{
	Node*	gl;
	Context *cx2;

	for (goalscar = goalscar->Cdr(); goalscar->kind() != ATOM; 
					goalscar = goalscar->Cdr()) {
		int r = 0;
		
		gl = goalscar->Car();
		cx2 = new Context(module);
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cxpush(cx2, gl);

		r = Unify(cx2, gl, module);

		cxpop(cx2);

		if (r>0) {
			cx->Merge(cx2);
			delete cx2;
			cx2 = 0;
			return 1;
		} else {
			cx2->Clear();
			delete cx2;
			cx2 = 0;
		}
	}
	return -1;
}

// <alt preds>
// [ preds ]
int DoAlt(Context* cx, Node* goalscar, List* module)
{
	int	rn;
	Node*	gl = MkList(goalscar->Cdr());

	Context *cx2 = new Context(module);
	cx2->ioin = cx->ioin;
	cx2->ioout = cx->ioout;
	cx2->tokenflag = cx->tokenflag;
	cx2->token = cx->token;

	cxpush(cx2, gl);

	if ((rn=Unify(cx2, gl, module))>0) {
		cx->Merge(cx2);
	}

	cxpop(cx2);

	delete cx2;
	cx2 = 0;
	return 1;
}

// <not preds>
int DoNot(Context* cx, Node* goalscar, List* module)
{
	Node*	gl = goalscar->Cdr();
	int	r;
	
	Context *cx2 = new Context(module);
	cx2->ioin = cx->ioin;
	cx2->ioout = cx->ioout;
	cx2->tokenflag = cx->tokenflag;
	cx2->token = cx->token;

	cxpush(cx2, gl);

	r = Unify(cx2, gl, module);

	cxpop(cx2);

	delete cx2;
	cx2 = 0;

	if (r == 1) {
		return 0;
	} else if (r == -1) {
		return -1;
	} else {
		return 1;
	}
}

// <for (#var to_val) block> or <for (#var initval to_val) block>
int DoFor(Context* cx, Node* goalscar, List* module)
{
	long long i;

	if (ListLength(goalscar) < 2) {

		syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
		return 0;
	}
	Node*	gl = goalscar->Cdr()->Cdr();
	Node*	glargs = goalscar->Cdr()->Car();
	
	int nc = ListLength(glargs);
	if (!((nc == 2) || (nc == 3)) ) {

		syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
		return 0;
	}
		
	Node* nvar = glargs->Car()->Val();
	if (nvar->kind() != UNDEF) {

		syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nto_val;
	long long init_val = 0;
	long long to_val;
	if (nc == 2) {
		init_val = 0;
		nto_val = glargs->Car()->Val();
		if (nto_val->kind() != ATOM) {

			syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {

			syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
			return 0;
		}
	} else {
		Node* ninitval = glargs->Car()->Val();
		if (ninitval->kind() != ATOM) {

			syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)ninitval)->toInt(init_val)) {

			syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
			return 0;
		}
		
		nto_val = glargs->Cdr()->Car()->Val();
		if (nto_val->kind() != ATOM) {

			syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
			return 0;
		}
		if (!((Atom*)nto_val)->toInt(to_val)) {

			syserr("usage : <for (VAR LOOP-COUNT) PRED> or <for (VAR FROM TO) PRED>\n");
			return 0;
		}
	}
	
	for (i = init_val; i <= to_val; i++) {
		Context *cx2 = new Context(module);
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		Node* env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(mka(i));

		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
				
		int r = Unify(cx2, gl, module);

		if (r == 1) {
			if (cx->tokenflag) cx->token = cx2->token;
		}

		cx2->Clear();
		
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;

		if (r != 1) {
			return r;
		}
	}		
	return 1;
}

int DoForeach(Context* cx, Node* goalscar, List* module)
{
	int i;
	Node*	gl = goalscar->Cdr();
	Node*	glargs = gl->Car();
	int	rn;
	
	int narg = ListLength(glargs);
	if (narg < 2) {
		syserr("usage : <foreach (VAR LIST) PRED>\n");
		return 0;
	}

	Node* nvar = glargs->Car()->Val();
	if (nvar->kind() != UNDEF) {
		return 0;
	}

	glargs = glargs->Cdr();

	Node* nlist = glargs->Car()->Val();
	if (nlist->kind() != LIST) {
		return 0;
	}

	gl = gl->Cdr();

	for ( ; nlist->kind() != ATOM; nlist=nlist->Cdr()) {
		Context *cx2 = new Context(module);
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		Node* env = Nil->Cons(Nil);
		SetEnv(env, nvar);
		((Undef*)nvar)->Set(nlist->Car());

		cxpush(cx2, env);
		cxpush(cx2, nvar);
		cxpush(cx2, goalscar);
		cxpush(cx2, nlist);
				
		rn = Unify(cx2, gl, module);

		if (rn == 1) {
			if (cx->tokenflag) cx->token = cx2->token;
		}
		
		cx2->Clear();

		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		cxpop(cx2);
		
		UnsetEnv(env);
		
		delete cx2;
		cx2 = 0;
/*
		if (rn != 1) {
			return rn;
		}
*/
	}		
	return 1;
}

int DoFindAll(Context* cx, Node* goalscar, List* module)
{
	int i;
	Node*	gl = goalscar->Cdr();
	int	rn;

	if (gl == Nil) {
		syserr("usage : <findall PRED>\n");
		return 0;
	}

	gl = Append(gl, MkList(MkPred(mka("unknown"))));

	Context *cx2 = new Context(module);
	cx2->ioin = cx->ioin;
	cx2->ioout = cx->ioout;
	cx2->tokenflag = cx->tokenflag;
	cx2->token = cx->token;

	cxpush(cx2, gl);
	cxpush(cx2, goalscar);
				
	rn = Unify(cx2, gl, module);

	if (rn == 1) {
		if (cx->tokenflag) cx->token = cx2->token;
	}
		
	cx2->Clear();

	cxpop(cx2);
	cxpop(cx2);

	delete cx2;
	cx2 = 0;

	return 1;
}

int DoAsserta(Context* cx, Node* goalscar, List* module)
{
	int i;
	Node*	gl = goalscar->Cdr();
	Node* nargs = gl->Val();

	if (nargs->Car()->kind() != PRED) {
		syserr("usage : <asserta PRED-LIST>\n");
		return 0;
	}
	
	Asserta(module, nargs);
	
//	module->SetCar(Append(MkList(nargs), module->Car()));

	return 1;
}

int DoAssertz(Context* cx, Node* goalscar, List* module)
{
	int i;
	Node*	gl = goalscar->Cdr();
	Node* nargs = gl->Val();
	
	if (nargs->Car()->kind() != PRED) {
		syserr("usage : <assert PRED-LIST>\n");
		return 0;
	}

	Assert(module, nargs);

//	module = (List*)Append(module->Car(), MkList(nargs));

	return 1;
}

int DoRetractPred(Context* cx, Node* goalscar, List* module)
{
	int i;
	Node*	gl = goalscar->Cdr()->Val();

	int l = ListLength(gl);
	if (l != 1) {
		syserr("usage : <retract PRED>\n");
		return 0;
	}
	Node* nargs = gl->Car()->Val();
	if (nargs->kind() != PRED) {
		return 0;
	}

	List* mod = (List*)module->Car();
	List* modsave;
	Node* env = Nil->Cons(Nil);

	int r = Unification(nargs, Dup(mod->Car()->Car()), env, cx);
	
	UnsetEnv(env);
	if (r) {
		module->SetCar(mod->Cdr());
		return 1;
	}

	modsave = mod;
	mod = (List*)mod->Cdr();
	for ( ; mod->kind() != ATOM; mod = (List*)mod->Cdr()) {
		r = Unification(nargs, Dup(mod->Car()->Car()), env, cx);
		UnsetEnv(env);
		if (r) {
			modsave->SetCdr(mod->Cdr());
			return 1;
		}
		modsave = mod;
	}
	return 0;
}

int DoRetract(Context* cx, Node* goalscar, List* module)
{
	int i;
	Node*	gl = goalscar->Cdr()->Val();

	int l = ListLength(gl);
	if (l != 1) {
		syserr("usage : <retractpred PRED_NAME>\n");
		return 0;
	}
	Node* nargs = gl->Car()->Val();
	if (nargs->kind() != ATOM) {
		return 0;
	}

	List* mod = (List*)module->Car();
	List* modsave = mod;
	
	while (mod->Car()->Car()->Car()->Eq(nargs)) {
		module->SetCar(mod->Cdr());
		mod = (List*)mod->Cdr();
	}

	mod = (List*)mod->Cdr();
	for ( ; mod->kind() != ATOM; mod = (List*)mod->Cdr()) {
		if (mod->Car()->Car()->Car()->Eq(nargs)) {
			modsave->SetCdr(mod->Cdr());
		}
		modsave = mod;
	}
	return 1;
}


int Tron()
{
	TraceFlag = 1;
	return 1;
}

int Troff()
{
	TraceFlag = 0;
	return 1;
}


int DoNewObj(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 1) {
		return 0;
	}
	Node* nobj = goalscar->Car()->Val();
	Node* md   = module->Car();

	Asserta(module, MkList(MkPred(Cons(nobj, Nil))));

	return 1;
}

int Self(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 1) {
		return 0;
	}
	Node* nvar = goalscar->Car()->Val();
	if (nvar->kind() != UNDEF) {
		return 0;
	}

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

	SetEnv(env, nvar);
	((Undef*)(nvar->Val()))->Set(cx->modulename);

	PushStack(cx, Nil, Nil, env);

	return 1;
}

int Super(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 1) {
		return 0;
	}
	Node* nvar = goalscar->Car()->Val();
	if (nvar->kind() != UNDEF) {
		return 0;
	}

	Node* nlist = Nil;
	Node* nself = cx->modulename;
	if (!nself->Eq(mka("WORLD"))) {
		Node* val = Nil;

		if (getvar(nself, Module->Car(), val)) {

			for ( ; val->kind() != ATOM; val = val->Cdr()) {
				if (val->Car()->Car()->Eq(mka("inherit"))) {
					nlist = Append(nlist, MkList(val->Car()->Cdr()->Car()));
				}
			}
		}
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)(nvar->Val()))->Set(nlist);

	PushStack(cx, Nil, Nil, env);

	return 1;
}



static int CheckMethod(Node* method)
{
	Node* n;

	if (method->kind() != LIST) {
		return 0;
	}
	
	if ((ListLength(method) == 2)
	     && method->Car()->Eq(mka("inherit")) 
	     && (method->Cdr()->Car()->Val()->kind() == ATOM)) {
		return 1;
	}

	if (method->Car()->kind() != PRED) {
		return 0;
	}

	return 1;
}


int DoSetMethoda(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll < 2) {
		return 0;
	}
	Node* nobj = goalscar->Car()->Val();
	Node* npred = goalscar->Cdr()->Val();

	return ObjSetMethoda(nobj, npred, module);
}


int ObjSetMethoda(Node* nobj, Node* npred, Node* module)
{
	Node* md   = module->Car();
	
	if (!CheckMethod(npred)) {
		syserr("An argument is not a method.\n");
		return 0;
	}
	
	for ( ; md != Nil; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car()->Car(), nobj) == 0) {
			Node* cdr = Cons(npred, md->Car()->Car()->Cdr());

			if (md->Car()->Car()->kind() != PRED) {
				continue;
			}
			Node* mdpred = ((Pred*)(md->Car()->Car()))->Node();
			((List*)mdpred)->SetCdr(cdr);
			
			return 1;
		}
	}

	return 0;
}

int DoSetMethodz(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll < 2) {
		return 0;
	}

	Node* nobj = goalscar->Car()->Val();
	Node* npred = goalscar->Cdr()->Val();

	return ObjSetMethodz(nobj, npred, module);
}


int ObjSetMethodz(Node* nobj, Node* npred, Node* module)
{
	Node* md   = module->Car();

	if (!CheckMethod(npred)) {
		syserr("An argument is not a method.\n");
		return 0;
	}
	
	for ( ; md != Nil; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car()->Car(), nobj) == 0) {
			Node* cdr = Append(md->Car()->Cdr(), MkList(npred));

			if (md->Car()->Car()->kind() != PRED) {
				continue;
			}
			Append(((Pred*)(md->Car()->Car()))->Node(), cdr);
			return 1;
		}
	}

	return 0;
}

int DoDelMethoda(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		return 0;
	}
	Node* nobj = goalscar->Car()->Val();
	Node* npred = goalscar->Cdr()->Car()->Val();


	return ObjDelMethoda(nobj, npred, module);
}


int ObjDelMethoda(Node* nobj, Node* npred, Node* module)
{
	Node* md   = module->Car(); 

	for ( ; md->kind() != ATOM; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nobj) == 0) {
			Node* n = md->Car()->Car()->Cdr();
			if (ModuleCompare(n->Car()->Car()->Car(), 
							npred) == 0) {
				((List*)((Pred*)(md->Car()->Car()))->Node())
							->SetCdr(n->Cdr());
				return 1;
			}
			Node* nprev = n; 
			n = n->Cdr();
			for ( ; n->kind() != ATOM; n = n->Cdr()) {
				if (ModuleCompare(n->Car()->Car()->Car(), 
								npred) == 0) {
					((List*)nprev)->SetCdr(n->Cdr());
					return 1;
				}
				nprev = n;
			}

		}
	}

	return 0;
}

int DoDelMethodz(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		return 0;
	}
	Node* nobj = goalscar->Car()->Val();
	Node* npred = goalscar->Cdr()->Car()->Val();


	return ObjDelMethodz(nobj, npred, module);
}


int ObjDelMethodz(Node* nobj, Node* npred, Node* module)
{
	Node* md   = module->Car();

	for ( ; md->kind() != ATOM; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nobj) == 0) {
			Node* n = md->Car()->Car()->Cdr();
			if (ModuleCompare(n->Car()->Car()->Car(), 
							npred) == 0) {
				((List*)((Pred*)(md->Car()->Car()))->Node())
							->SetCdr(n->Cdr());
				return 1;
			}
			Node* nprev = n; 
			Node* nsave = Nil;
			Node* nprevsave = Nil;
			n = n->Cdr();
			for ( ; n->kind() != ATOM; n = n->Cdr()) {
				if (ModuleCompare(n->Car()->Car()->Car(), 
								npred) == 0) {
					nsave = n;
					nprevsave = nprev;
				}
				nprev = n;
			}
			if (nsave != Nil) {
				((List*)nprevsave)->SetCdr(nsave->Cdr());
				return 1;
			}
		}
	}

	return 0;
}

int DoSetVar(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll < 2) {
		return 0;
	}
	Node* nvar = goalscar->Car()->Val();
	Node* val  = goalscar->Cdr()->Car()->Val();
	Node* md   = module->Car();

	for ( ; md != Nil; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nvar) == 0) {
			((List*)md->Car())->SetCar(MkPred(Cons(nvar, MkList(val))));
			return 1;
		}
	}
	Asserta(module, MkList(MkPred(Cons(nvar, MkList(val)))));

	return 1;
}

int DoDelVar(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 1) {
		return 0;
	}
	Node* nvar = goalscar->Car()->Val();
	Node* md   = module->Car();

	if (ModuleCompare(md->Car()->Car()->Car(), nvar) == 0) {
		((List*)module)->SetCar(md->Cdr());
		return 1;
	}

	Node* mdprev = md;
	md = md->Cdr();

	for ( ; md != Nil; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nvar) == 0) {
			((List*)mdprev)->SetCdr(md->Cdr());
			return 1;
		}
		mdprev = md;
	}

	return 0;
}


int DoSetArray(Context* cx, Node* goalscar, List* module)
{
	goalscar = goalscar->Cdr();

	int ll = ListLength(goalscar);
	if (ll < 3) {
		return 0;
	}
	Node* nvar  = goalscar->Car()->Val();
	Node* val   = goalscar->Cdr()->Car()->Val();
	Node* index = goalscar->Cdr()->Cdr()->Val();
	Node* md = module->Car();

	for ( ; md != Nil; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nvar) == 0) {
			if (md->Car()->Car()->Cdr()->Cdr()->Eq(index)) {
				((List*)md->Car())->SetCar(
					MkPred(Cons(nvar, Cons(val, index))));
				return 1;
			}
		}
	}
	Asserta(module, MkList(MkPred(Cons(nvar, Cons(val, index)))));

	return 1;
}

int DoDelArray(Context* cx, Node* goalscar, List* module)
{
	int flg = 0;
	
	goalscar = goalscar->Cdr();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		return 0;
	}
	Node* nvar = goalscar->Car()->Val();
	Node* index = goalscar->Cdr()->Car()->Val();
	Node* md   = module->Car();

	if (ModuleCompare(md->Car()->Car()->Car(), nvar) == 0) {
		if (ModuleCompare(md->Car()->Car()->Cdr()->Cdr()->Car(), 
						index) == 0) {
			((List*)module)->SetCar(md->Cdr());
			flg++;
			md = md->Cdr();
		}
	}

	Node* mdprev = md;
	md = md->Cdr();

	for ( ; md != Nil; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nvar) == 0) {
			if (ModuleCompare(
					md->Car()->Car()->Cdr()->Cdr()->Car(), 
						index) == 0) {
				((List*)mdprev)->SetCdr(md->Cdr());
				flg++;
				break;
			}
		}
		md = md->Cdr();
		mdprev = md;
	}

	if (flg) {
		return 1;
	} 
	return 0;
}




int ObjSetVar(Node* nobj, Node* nvar, Node* val, List* module)
{
	Node* md   = module->Car(); 

	for ( ; md->kind() != ATOM; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nobj) == 0) {
			Node* n = md->Car()->Car()->Cdr();
			if (ModuleCompare(n->Car()->Car()->Car(), 
							nvar) == 0) {
				((List*)((Pred*)(md->Car()->Car()))->Node())
					->SetCdr(Cons(MkList(
					  MkPred(MkList(nvar, val))), n->Cdr()));

				return 1;
			}
			Node* nprev = n; 
			n = n->Cdr();
			for ( ; n->kind() != ATOM; n = n->Cdr()) {
				if (ModuleCompare(n->Car()->Car()->Car(), 
								nvar) == 0) {
					((List*)nprev)->SetCdr(
					  Cons(MkList(MkPred(
					  	MkList(nvar, val))), n->Cdr()));
					return 1;
				}
				nprev = n;
			}

			((List*)((Pred*)(md->Car()->Car()))->Node())
				->SetCdr(Cons(MkList(MkPred(MkList(nvar, val))), 
					md->Car()->Car()->Cdr()));
			return 1;
		}
	}

	return 0;
}

int ObjDelVar(Node* nobj, Node* nvar, List* module)
{
	Node* md   = module->Car(); 

	for ( ; md->kind() != ATOM; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nobj) == 0) {
			Node* n = md->Car()->Car()->Cdr();
			if (ModuleCompare(n->Car()->Car()->Car(), 
							nvar) == 0) {
				((List*)((Pred*)(md->Car()->Car()))->Node())
					->SetCdr(n->Cdr());

				return 1;
			}
			Node* nprev = n; 
			n = n->Cdr();
			for ( ; n->kind() != ATOM; n = n->Cdr()) {
				if (ModuleCompare(n->Car()->Car()->Car(), 
								nvar) == 0) {
					((List*)nprev)->SetCdr(n->Cdr());
					return 1;
				}
				nprev = n;
			}
		}
	}

	return 0;
}

int ObjSetArray(Node* nobj, Node* nvar, Node* val, Node* index, List* module)
{
	Node* md   = module->Car(); 

	for ( ; md->kind() != ATOM; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nobj) == 0) {
			Node* n = md->Car()->Car()->Cdr();
			if ((ModuleCompare(n->Car()->Car()->Car(), 
							nvar) == 0) 
			  && (ModuleCompare(n->Car()->Car()->Cdr()->Cdr(), 
			  				index) == 0)) {
				((List*)((Pred*)(md->Car()->Car()))->Node())
					->SetCdr(Cons(MkList(
					  MkPred(MkList(nvar, val, index))), n->Cdr()));

				return 1;
			}
			Node* nprev = n; 
			n = n->Cdr();
			for ( ; n->kind() != ATOM; n = n->Cdr()) {
				if ((ModuleCompare(n->Car()->Car()->Car(), 
								nvar) == 0) 
				  && (ModuleCompare(n->Car()->Car()->Cdr()->Cdr(),
				  			index) == 0)) {
					((List*)nprev)->SetCdr(
					  Cons(MkList(MkPred(
					  	MkList(nvar, val, index))), n->Cdr()));
					return 1;
				}
				nprev = n;
			}

			((List*)((Pred*)(md->Car()->Car()))->Node())
				->SetCdr(Cons(MkList(MkPred(MkList(nvar, val, index))), 
					md->Car()->Car()->Cdr()));
			return 1;
		}
	}

	return 0;
}


int ObjDelArray(Node* nobj, Node* nvar, Node* index, List* module)
{
	int flg = 0;

	Node* md   = module->Car(); 

	for ( ; md->kind() != ATOM; md = md->Cdr()) {
		if (ModuleCompare(md->Car()->Car()->Car(), nobj) == 0) {
			Node* n = md->Car()->Car()->Cdr();

			if (ModuleCompare(n->Car()->Car()->Car(), 
							nvar) == 0) {
				if (ModuleCompare(
					n->Car()->Car()->Cdr()->Cdr()->Car(),
							index) == 0) { 
					((List*)((Pred*)(md->Car()->Car()))
						->Node())
						->SetCdr(n->Cdr());
					flg++;
					return 1;
				}
			}

			Node* nprev = n; 
			n = n->Cdr();
			for ( ; n->kind() != ATOM; n = n->Cdr()) {

				if (ModuleCompare(n->Car()->Car()->Car(), 
								nvar) == 0) {
					if (ModuleCompare(
					  n->Car()->Car()->Cdr()->Cdr()->Car(),
							index) == 0) { 
					
						((List*)nprev)->SetCdr(
								n->Cdr());
						n = n->Cdr();
						flg++;
						return 1;
					}
				}
				nprev = n;
			}
		}
	}

	if (flg) {
		return 1;
	}
	return 0;
}

