/*
 * sys module 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 __MINGW32__ 
#include <sys/times.h>
#include <readline/readline.h>
#include <readline/history.h>
#endif /* __MINGW32__ */

#include <string>

#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;

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

extern Node* UTF8Char(char* str);
extern Node* SJISChar(char* str);
extern Node* EUCChar(char* str);

extern FILE* MksTemp(char* templ);

#if defined(__CYGWIN__) && !defined(__MINGW32__)
#define sinl(x)		sin(x)
#define cosl(x)		cos(x)
#define tanl(x)		tan(x)
#define asinl(x)	asin(x)
#define acosl(x)	acos(x)
#define atanl(x)	atan(x)
#define sinhl(x)	sinh(x)
#define coshl(x)	cosh(x)
#define tanhl(x)	tanh(x)
#define asinhl(x)	asinh(x)
#define acoshl(x)	acosh(x)
#define atanhl(x)	atanh(x)

#define logl(x)		log(x)
#define log10l(x)	log10(x)
#define expl(x)		exp(x)
#define sqrtl(x)	sqrt(x)
#define fabsl(x)	fabs(x)

#endif

int CmdArgs(Context* cx, Node* goalscar);
int DlibPath(Context* cx, Node* goalscar);
int CutAll(Context* cx, Node* goalscar);
int Write(Context* cx, Node* goalscar, List* module);
int WriteNl(Context* cx, Node* goalscar, List* module);

int wnl(Context* cx, Node* goalscar, List* module);
int wo(Context* cx, Node* goalscar, List* module);
int wx(Context* cx, Node* goalscar, List* module);
int wf(Context* cx, Node* goalscar, List* module);
int wg(Context* cx, Node* goalscar, List* module);
int wtab(Context* cx, Node* goalscar, List* module);

int fr(Context* cx, Node* n);
int fl(Context* cx, Node* n);

int eq(Context* cx, Node* n);
int noteq(Context* cx, Node* n);
int isNil(Node* n);
int isAtom(Node* n);
int isList(Node* n);
int isPred(Node* n);
int isVar(Node* n);
int isUndefVar(Node* n);
int isFloat(Node* n);
int isInteger(Node* n);

int isTrue(Context* cx, Node* goalscar);
int isFalse(Context* cx, Node* goalscar);
int isUnknown(Context* cx, Node* goalscar);

int Max(Context* cx, Node* goalscar);
int Min(Context* cx, Node* goalscar);
int Maxf(Context* cx, Node* goalscar);
int Minf(Context* cx, Node* goalscar);

int DoOpenR(Context* cx, Node* goalscar);
int DoOpenW(Context* cx, Node* goalscar);
int DoOpenWP(Context* cx, Node* goalscar);

int DoGetc(Context* cx, Node* goalscar);
int DoPutc(Context* cx, Node* goalscar);
int GetLine(Context* cx, Node* goalscar);
int SyntaxLine(Context* cx, Node* goalscar);
int TmpFile(Context* cx, Node* goalscar);

int DoRegex(Context* cx, Node* goalscar);
int DoSub(Context* cx, Node* goalscar);
int DoGSub(Context* cx, Node* goalscar);
int Split(Context* cx, Node* goalscar);
int Toupper(Context* cx, Node* goalscar);
int Tolower(Context* cx, Node* goalscar);
int Length(Context* cx, Node* goalscar);

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

int Random(Context* cx, Node* goalscar);
int Sin(Context* cx, Node* goalscar);
int Cos(Context* cx, Node* goalscar);
int Tan(Context* cx, Node* goalscar);
int ASin(Context* cx, Node* goalscar);
int ACos(Context* cx, Node* goalscar);
int ATan(Context* cx, Node* goalscar);
int Sinh(Context* cx, Node* goalscar);
int Cosh(Context* cx, Node* goalscar);
int Tanh(Context* cx, Node* goalscar);
int ASinh(Context* cx, Node* goalscar);
int ACosh(Context* cx, Node* goalscar);
int ATanh(Context* cx, Node* goalscar);
int Log(Context* cx, Node* goalscar);
int Log10(Context* cx, Node* goalscar);
int Exp(Context* cx, Node* goalscar);
int Sqrt(Context* cx, Node* goalscar);
int Abs(Context* cx, Node* goalscar);
int Int(Context* cx, Node* goalscar);
int Floor(Context* cx, Node* goalscar);

int Car(Context* cx, Node* goalscar);
int Cdr(Context* cx, Node* goalscar);
int Cons(Context* cx, Node* goalscar);

int Char(Context* cx, Node* goalscar);
int Concat(Context* cx, Node* goalscar);
int ConcatCode(Context* cx, Node* goalscar);

int SetCode(Context* cx, Node* goalscar);
int CodeCharPrd(Context* cx, Node* goalscar);
int UTF8CharPrd(Context* cx, Node* goalscar);
int EUCCharPrd(Context* cx, Node* goalscar);
int SJISCharPrd(Context* cx, Node* goalscar);

int And(Context* cx, Node* goalscar);
int Or(Context* cx, Node* goalscar);
int Xor(Context* cx, Node* goalscar);
int BitNot(Context* cx, Node* goalscar);
int ShiftL(Context* cx, Node* goalscar);
int ShiftR(Context* cx, Node* goalscar);

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

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

int GetTime(Context* cx, Node* goalscar);
int Time(Context* cx, Node* goalscar);
int Date(Context* cx, Node* goalscar);

// program start time
struct ProgTime progtime;


// lib path
Node*	dlibpathnode = Nil;

int FuncArg(Context* cx, Node*& args, List* module)
{
	Node* retn;
	int rn;
		
	cxpush(cx, args);
	cxpush(cx, module);
	if ((rn=FuncPred(cx, args, module, retn))>0) {
		cxpop(cx);
		cxpop(cx);
		args = retn;
	} else {
		cxpop(cx);
		cxpop(cx);
	}
	return rn;
}

void GetLibPath(char* dlibpath)
{
	if (dlibpath == NULL) {
		dlibpath = "";
	}
	dlibpathnode = Nil;
	if (dlibpath != NULL) {
		int	i, j;
		char*	pathbuf = new char[strlen(dlibpath)];
		
		for (i = 0, j = 0; i <= strlen(dlibpath); i++, j++) {
			switch (dlibpath[i]) {
#ifdef __MINGW32__
			case ';' :	// semicolon
#else 
			case ':' :	
#endif
			case 0 :
				pathbuf[j] = 0;
				dlibpathnode = Append(dlibpathnode, 
							MkList(mka(pathbuf)));
				j = -1;
				break;
			default :
				pathbuf[j] = dlibpath[i];
				break;
			}
		}
		delete pathbuf;
	}

}

void GetLibPath()
{
	char* dlibpath = getenv(DLIBPATH);
	if (dlibpath == NULL) {
		dlibpath = ".";
	}
	GetLibPath(dlibpath);
}

int sysmodule(Context* cx, Node* goalscar, Node* goalscdr, 
				Node* goals, List* module, int& r)
{
	Node* retn;
	int	rn;

	std::string	s;

	if (goalscar->Val()->Car()->kind() == ATOM) {
		((Atom*)(goalscar->Val()->Car()))->toString(s);

		if (s == "args") {
			r = CmdArgs(cx, goalscar);
			return 1;
		} else if (s == "DLIBPATH") {
			r = DlibPath(cx, goalscar);
			return 1;
#if 0
		} else if (s == "cutall") {
			r = CutAll(cx, goalscar);
			return 1;
#endif
		} else if (s == "mkpred") {
			r = DoMkPred(cx, goalscar);
			return 1;
		} else if (s == "writenl") {
			WriteNl(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "writeln") {
			WriteNl(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "print") {
			WriteNl(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "write") {
			Write(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "wcr") {
			wnl(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "wnl") {
			wnl(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "w") {
			Write(cx, goalscar, module);
			r = 1;
			return 1;
		} else if (s == "wo") {
			r = wo(cx, goalscar, module);
			return 1;
		} else if (s == "wx") {
			r = wx(cx, goalscar, module);
			return 1;
		} else if (s == "wf") {
			r = wf(cx, goalscar, module);
			return 1;
		} else if (s == "wg") {
			r = wg(cx, goalscar, module);
			return 1;
		} else if (s == "wtab") {
			r = wtab(cx, goalscar, module);
			return 1;
		} else if (s == "fr") {
			r = fr(cx, goalscar->Val()->Cdr());
			return 1;
		} else if (s == "fl") {
			r = fl(cx, goalscar->Val()->Cdr());
			return 1;
		} else if (s == "isNil") {
			r = isNil(goalscar);
			return 1;
		} else if (s == "isAtom") {
			r = isAtom(goalscar);
			return 1;
		} else if (s == "isList") {
			r = isList(goalscar);
			return 1;
		} else if (s == "isPred") {
			r = isPred(goalscar);
			return 1;
		} else if (s == "isVar") {
			r = isVar(goalscar);
			return 1;
		} else if (s == "isUndefVar") {
			r = isUndefVar(goalscar);
			return 1;
		} else if (s == "isFloat") {
			r = isFloat(goalscar);
			return 1;
		} else if (s == "isInteger") {
			r = isInteger(goalscar);
			return 1;
		} else if (s == "isTrue") {
			r = isTrue(cx, goalscar);
			return 1;
		} else if (s == "isFalse") {
			r = isFalse(cx, goalscar);
			return 1;
		} else if (s == "isUnknown") {
			r = isUnknown(cx, goalscar);
			return 1;
		} else if (s == "max") {
			r = Max(cx, goalscar);
			return 1;
		} else if (s == "min") {
			r = Min(cx, goalscar);
			return 1;
		} else if (s == "maxf") {
			r = Maxf(cx, goalscar);
			return 1;
		} else if (s == "minf") {
			r = Minf(cx, goalscar);
			return 1;
		} else if (s == "regex") {
			r = DoRegex(cx, goalscar);
			return 1;
		} else if (s == "sub") {
			r = DoSub(cx, goalscar);
			return 1;
		} else if (s == "gsub") {
			r = DoGSub(cx, goalscar);
			return 1;
		} else if (s == "split") {
			r = Split(cx, goalscar);
			return 1;
		} else if (s == "toupper") {
			r = Toupper(cx, goalscar);
			return 1;
		} else if (s == "tolower") {
			r = Tolower(cx, goalscar);
			return 1;
		} else if (s == "length") {
			r = Length(cx, goalscar);
			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 == "random") {
			r = Random(cx, goalscar);
			return 1;
		} else if (s == "sin") {
			r = Sin(cx, goalscar);
			return 1;
		} else if (s == "cos") {
			r = Cos(cx, goalscar);
			return 1;
		} else if (s == "tan") {
			r = Tan(cx, goalscar);
			return 1;
		} else if (s == "asin") {
			r = ASin(cx, goalscar);
			return 1;
		} else if (s == "acos") {
			r = ACos(cx, goalscar);
			return 1;
		} else if (s == "atan") {
			r = ATan(cx, goalscar);
			return 1;
		} else if (s == "sinh") {
			r = Sinh(cx, goalscar);
			return 1;
		} else if (s == "cosh") {
			r = Cosh(cx, goalscar);
			return 1;
		} else if (s == "tanh") {
			r = Tanh(cx, goalscar);
			return 1;
		} else if (s == "asinh") {
			r = ASinh(cx, goalscar);
			return 1;
		} else if (s == "acosh") {
			r = ACosh(cx, goalscar);
			return 1;
		} else if (s == "atanh") {
			r = ATan(cx, goalscar);
			return 1;
		} else if (s == "log") {
			r = Log(cx, goalscar);
			return 1;
		} else if (s == "log10") {
			r = Log10(cx, goalscar);
			return 1;
		} else if (s == "exp") {
			r = Exp(cx, goalscar);
			return 1;
		} else if (s == "sqrt") {
			r = Sqrt(cx, goalscar);
			return 1;
		} else if (s == "abs") {
			r = Abs(cx, goalscar);
			return 1;
		} else if (s == "int") {
			r = Int(cx, goalscar);
			return 1;
		} else if (s == "floor") {
			r = Floor(cx, goalscar);
			return 1;
		} else if (s == "car") {
			r = Car(cx, goalscar);
			return 1;
		} else if (s == "cdr") {
			r = Cdr(cx, goalscar);
			return 1;
		} else if (s == "cons") {
			r = Cons(cx, goalscar);
			return 1;
		} else if (s == "code") {
			r = SetCode(cx, goalscar);
			return 1;
		} else if (s == "char") {
			r = CodeCharPrd(cx, goalscar);
			return 1;
		} else if (s == "byte") {
			r = Char(cx, goalscar);
			return 1;
		} else if (s == "asciichar") {
			r = Char(cx, goalscar);
			return 1;
		} else if (s == "utf8char") {
			r = UTF8CharPrd(cx, goalscar);
			return 1;
		} else if (s == "eucchar") {
			r = EUCCharPrd(cx, goalscar);
			return 1;
		} else if (s == "sjischar") {
			r = SJISCharPrd(cx, goalscar);
			return 1;
		} else if (s == "concat") {
			r = Concat(cx, goalscar);
			return 1;
		} else if (s == "concatcode") {
			r = ConcatCode(cx, goalscar);
			return 1;
		} else if (s == "bitand") {
			r = And(cx, goalscar);
			return 1;
		} else if (s == "bitor") {
			r = Or(cx, goalscar);
			return 1;
		} else if (s == "bitxor") {
			r = Xor(cx, goalscar);
			return 1;
		} else if (s == "bitnot") {
			r = BitNot(cx, goalscar);
			return 1;
		} else if (s == "shiftl") {
			r = ShiftL(cx, goalscar);
			return 1;
		} else if (s == "shiftr") {
			r = ShiftR(cx, goalscar);
			return 1;
		} else if (s == "eq") {
			r = eq(cx, goalscar);
			return 1;
		} else if (s == "noteq") {
			r = noteq(cx, goalscar);
			return 1;
		} else if (s == "is") {
			r = eq(cx, goalscar);
			return 1;
		} else if (s == "getc") {
			r = DoGetc(cx, goalscar);
			return 1;
		} else if (s == "putc") {
			r = DoPutc(cx, goalscar);
			r = 1;
			return 1;
		} else if (s == "getline") {
			r = GetLine(cx, goalscar);
			return 1;
		} else if (s == "syntax") {
			r = SyntaxLine(cx, goalscar);
			return 1;
		} else if (s == "tmpfile") {
			r = TmpFile(cx, goalscar);
			return 1;
		} else if (s == "openr") {
			r = DoOpenR(cx, goalscar);
			return 1;
		} else if (s == "openw") {
			r = DoOpenW(cx, goalscar);
			return 1;
		} else if (s == "openwp") {
			r = DoOpenWP(cx, goalscar);
			return 1;
		} else if (s == "gettime") {
			r = GetTime(cx, goalscar);
			return 1;
		} else if (s == "time") {
			r = Time(cx, goalscar);
			return 1;
		} else if (s == "date") {
			r = Date(cx, goalscar);
			return 1;
		} else if (s == "gc") {
			r = 1;
			GC();
			return 1;
		}
	}
	r = -1;
	return 0;
}

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

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

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

	Node*	n = Nil;

	for (int i=1; i < pargc; i++) {
		n = Append(n, MkList(mka(pargv[i])));
	}

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

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

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

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

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

	Node* nvar = g->Car()->Val();
	if (nvar->kind() != UNDEF) {
		if (nvar->kind() == ATOM) {	// set DLIBPATH
			std::string sdpath;
			
			((Atom*)nvar)->toString(sdpath);
			GetLibPath((char*)sdpath.c_str());
#ifndef __MINGW32__
			setenv(DLIBPATH, (char*)sdpath.c_str(), 1);
#else
			std::string s;
			s = DLIBPATH;
			s = s + "=";
			s = s + sdpath;
			putenv((char*)s.c_str());
#endif
			return 1;
		}
		syserr("DLIBPATH: argument of args should be a variable or an atom. \n");
		return 0;		
	}

	GetLibPath();

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

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

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

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


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

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	Node* prd = MkPred(n1);
		
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(prd);
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

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

	int l = ListLength(gl);
	if (l != 3) {
		syserr("usage : <format OUTPUT FORMAT ARG>\n");
		return 0;
	}
	Node* nout = gl->Car();
	if (nout->kind() != UNDEF) {
		return 0;
	}
	Node* nfmt = gl->Cdr()->Car();
	if (nfmt->kind() != ATOM) {
		return 0;
	}
	Node* narg = gl->Cdr()->Cdr()->Car();
	if (narg->kind() != ATOM) {
		return 0;
	}
	
}

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

	cxpush(cx, goalscar);	
	cxpush(cx, module);	
	if ((rn = FuncArg(cx, n, module)) <= 0) {
		cxpop(cx);
		cxpop(cx);
		return rn;
	}
	cxpop(cx);
	cxpop(cx);

	n->Car()->print(cx->ioout);
	n->Cdr()->printcdr(cx->ioout);

	return 1;
}

int WriteNl(Context* cx, Node* goalscar, List* module)
{
	int rn;
	
	if ((rn=Write(cx, goalscar, module)) <= 0) {
		return rn;
	}
	
	fprintf(cx->ioout, "\n");
	return 1;
}


int wnl(Context* cx, Node* goalscar, List* module)
{
	if (ListLength(goalscar->Cdr()) > 0) {
		syserr("usage : <wnl>\n");
		return 0;
	}
	fprintf(cx->ioout, "\n");
	return 1;
}

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

	cxpush(cx, goalscar);
	cxpush(cx, module);	
	if ((rn = FuncArg(cx, n1, module)) <= 0) {
		cxpop(cx);
		cxpop(cx);
		return rn;
	}
	cxpop(cx);
	cxpop(cx);

	if (ListLength(n1) != 1) {
		syserr("usage : <wo NUM>\n");
		return 0;
	}
	
	if (n1->Car()->kind() != ATOM) {
		return 0;
	}
	long long n;
	if (!((Atom*)n1->Car())->toLLInt(n)) {
		return 0;
	}
		
	fprintf(cx->ioout, "%llo", n);
	return 1;
}

int wx(Context* cx, Node* goalscar, List* module)
{
	Node* n1 = goalscar->Cdr();
	int rn;
	
	cxpush(cx, goalscar);
	cxpush(cx, module);	
	if ((rn = FuncArg(cx, n1, module)) <= 0) {
		cxpop(cx);
		cxpop(cx);
		return rn;
	}
	cxpop(cx);
	cxpop(cx);

	if (ListLength(n1) != 1) {
		syserr("usage : <wx NUM>\n");
		return 0;
	}
	
	if (n1->Car()->kind() != ATOM) {
		return 0;
	}
	long long n;
	if (!((Atom*)n1->Car())->toLLInt(n)) {
		return 0;
	}
		
	fprintf(cx->ioout, "%llx", n);
	return 1;
}

int wf(Context* cx, Node* goalscar, List* module)
{
	Node* n1 = goalscar->Cdr();
	int rn;
	
	cxpush(cx, goalscar);
	cxpush(cx, module);	
	if ((rn = FuncArg(cx, n1, module)) <= 0) {
		cxpop(cx);
		cxpop(cx);
		return rn;
	}
	cxpop(cx);
	cxpop(cx);

	if (ListLength(n1) != 1) {
		syserr("usage : <wf NUM>\n");
		return 0;
	}
	
	if (n1->Car()->kind() != ATOM) {
		return 0;
	}
	long double	n;
	if (!((Atom*)n1->Car())->toFloat(n)) {
		return 0;
	}
		
	fprintf(cx->ioout, "%Lf", n);
	return 1;

}

int wg(Context* cx, Node* goalscar, List* module)
{
	Node* n1 = goalscar->Cdr();
	int rn;
	
	cxpush(cx, goalscar);
	cxpush(cx, module);	
	if ((rn = FuncArg(cx, n1, module)) <= 0) {
		cxpop(cx);
		cxpop(cx);
		return rn;
	}
	cxpop(cx);
	cxpop(cx);

	if (ListLength(n1) != 1) {
		syserr("usage : <wg NUM>\n");
		return 0;
	}
	
	if (n1->Car()->kind() != ATOM) {
		return 0;
	}
	long double	n;
	if (!((Atom*)n1->Car())->toFloat(n)) {
		return 0;
	}
		
	fprintf(cx->ioout, "%Lg", n);
	return 1;

}

int wtab(Context* cx, Node* goalscar, List* module)
{
	Node* n1 = goalscar->Cdr();
	int rn;
	
	cxpush(cx, goalscar);
	cxpush(cx, module);	
	if ((rn = FuncArg(cx, n1, module)) <= 0) {
		cxpop(cx);
		cxpop(cx);
		return rn;
	}
	cxpop(cx);
	cxpop(cx);

	if (ListLength(n1) != 0) {
		syserr("usage : <wtab>\n");
		return 0;
	}
	fprintf(cx->ioout, "\t");
	return 1;
}

int fr(Context* cx, Node* n1)
{
	std::string s1;
 	std::string s2 = "";
	long long n;
	int i, s1len;


	n1 = n1->Val();
	
	if (ListLength(n1) != 3) {
		syserr("usage : <fr VAR STRINGS WIDTH>\n");
		return 0;
	}
	
	if (n1->Car()->kind() != UNDEF) {
		return 0;
	}
	Node* nvar = n1->Car();

	if (n1->Cdr()->Car()->kind() != ATOM) {
		return 0;
	}
	if (!((Atom*)n1->Cdr()->Car())->toString(s1)) {
		return 0;
	}
	

	if (n1->Cdr()->Cdr()->Car()->kind() != ATOM) {
		return 0;
	} else if (!((Atom*)n1->Cdr()->Cdr()->Car())->toLLInt(n)) {
		return 0;
	}

	if (n <= 0) {
		return 0;
	}

	s1len = s1.length();
	i = s1len - n;
	if (i < 0) {
		for ( ; i < 0; i++) {
			s2 = s2 + " ";
		}
	}
	for ( ; i < s1len; i++) {
		s2 = s2 + s1[i];
	}
	
	Node* env = Nil->Cons(Nil);
	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka((char*)s2.c_str()));

	PushStack(cx, Nil, Nil, env);

	return 1;
}

int fl(Context* cx, Node* n1)
{
	std::string s1;
 	std::string s2 = "";
	long long n;
	int i, s1len;


	n1 = n1->Val();
	
	if (ListLength(n1) != 3) {
		syserr("usage : <fl VAR STRINGS>\n");
		return 0;
	}
	
	if (n1->Car()->kind() != UNDEF) {
		return 0;
	}
	Node* nvar = n1->Car();

	if (n1->Cdr()->Car()->kind() != ATOM) {
		return 0;
	}
	if (!((Atom*)n1->Cdr()->Car())->toString(s1)) {
		return 0;
	}
	

	if (n1->Cdr()->Cdr()->Car()->kind() != ATOM) {
		return 0;
	} else if (!((Atom*)n1->Cdr()->Cdr()->Car())->toLLInt(n)) {
		return 0;
	}

	if (n <= 0) {
		return 0;
	}

	s1len = s1.length();
	for (i = 0; i < n; i++) {
		if (i >=s1len) {
			s2 = s2 + " ";
		} else {
			s2 = s2 + s1[i];
		}
	}
	
	Node* env = Nil->Cons(Nil);
	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka((char*)s2.c_str()));

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

int isNil(Node* n)
{
	n = n->Cdr()->Val();
	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car() == Nil) {
		return 1;
	} else {
		return -1;
	}
}

int isAtom(Node* n)
{
	n = n->Cdr()->Val();
	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car()->kind() == ATOM) {
		return 1;
	} else {
		return -1;
	}
}

int isList(Node* n)
{
	n = n->Cdr()->Val();
	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car()->kind() == LIST) {
		return 1;
	} else {
		return -1;
	}
}

int isPred(Node* n)
{
	n = n->Cdr()->Val();
	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car()->kind() == PRED) {
		return 1;
	} else {
		return -1;
	}
}

int isVar(Node* n)
{
	n = n->Cdr();
	if (ListLength(n) != 1) {
		return -1;
	}

	if ((n->Car()->kind() == VAR) || (n->Car()->kind() == UNDEF)) {
		return 1;
	} else {
		return -1;
	}

}

int isUndefVar(Node* n)
{
	n = n->Cdr()->Val();
	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car()->kind() == UNDEF) {
		return 1;
	} else {
		return -1;
	}
}

int isFloat(Node* n)
{
	long double	d;
	
	n = n->Cdr()->Val();
	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car()->kind() != ATOM) {
		return 0;
	}
	if (((Atom*)(n->Car()))->toFloat(d)) {
		return 1;
	} else {
		return -1;
	}

}

int isInteger(Node* n)
{
	long long i;
	
	n = n->Cdr()->Val();

	if (ListLength(n) != 1) {
		return -1;
	}

	if (n->Car()->kind() != ATOM) {
		return 0;
	}
	if (((Atom*)(n->Car()))->toLLInt(i)) {
		return 1;
	} else {
		return -1;
	}
}

int isTrue(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return -1;
	}

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

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

	cxpush(cx2, gl);

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

	cxpop(cx2);

	delete cx2;
	cx2 = 0;

	return r;
}

int isFalse(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return -1;
	}

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

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

	cxpush(cx2, gl);

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

	cxpop(cx2);

	delete cx2;
	cx2 = 0;

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

int isUnknown(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return -1;
	}

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

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

	cxpush(cx2, gl);

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

	cxpop(cx2);

	delete cx2;
	cx2 = 0;

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

int Max(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <max VAR LIST> \n");
		return 0;
	}

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

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

	long long max=0, num;
	Node* n;
	n = nlist;

	if ((n->Car()->kind() != ATOM) || !((Atom*)(n->Car()))->toLLInt(max)) {
		return 0;
	}

	for ( ; n->kind() != ATOM; n = n->Cdr()) {
		if ((n->Car()->kind() != ATOM) 
				|| !((Atom*)n->Car())->toLLInt(num)) {
			return 0;
		}
		if (num > max) {
			max = num;
		}
	}

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

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

int Min(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <min VAR LIST> \n");
		return 0;
	}

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

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

	long long min=0, num;
	Node* n;
	n = nlist;

	if ((n->Car()->kind() != ATOM) || !((Atom*)(n->Car()))->toLLInt(min)) {
		return 0;
	}

	for ( ; n->kind() != ATOM; n = n->Cdr()) {
		if ((n->Car()->kind() != ATOM) 
				|| !((Atom*)n->Car())->toLLInt(num)) {
			return 0;
		}
		if (num < min) {
			min = num;
		}
	}

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

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

int Maxf(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <max VAR LIST> \n");
		return 0;
	}

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

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

	long double max=0, num;
	Node* n;
	n = nlist;

	if ((n->Car()->kind() != ATOM) || !((Atom*)(n->Car()))->toFloat(max)) {
		return 0;
	}

	for ( ; n->kind() != ATOM; n = n->Cdr()) {
		if ((n->Car()->kind() != ATOM) 
				|| !((Atom*)n->Car())->toFloat(num)) {
			return 0;
		}
		if (num > max) {
			max = num;
		}
	}

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

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

int Minf(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <min VAR LIST> \n");
		return 0;
	}

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

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

	long double min=0, num;
	Node* n;
	n = nlist;

	if ((n->Car()->kind() != ATOM) || !((Atom*)(n->Car()))->toFloat(min)) {
		return 0;
	}

	for ( ; n->kind() != ATOM; n = n->Cdr()) {
		if ((n->Car()->kind() != ATOM) 
				|| !((Atom*)n->Car())->toFloat(num)) {
			return 0;
		}
		if (num < min) {
			min = num;
		}
	}

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

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


static int CheckDelimiterOne(char* str, int i, char* delm, int j)
{
	int k, ns, nd;

	ns = CharLen(str[i]);
	nd = CharLen(delm[j]);
	if (i+ns > strlen(str)) {
		return 0;
	}
	if (j+nd > strlen(delm)) {
		return 0;
	}
	
	if (ns == nd) {
		for (k = 0; k < nd; k++) {
			if (str[i+k] != delm[j+k]) {
				return 0;
			}
		}
		return 1;
	} else {
		return 0;
	}				
}

static int CheckDelimiter(char* str, int i, char* delm)
{
	int j, nd;

	for (j = 0; j < strlen(delm); j += nd) {
		nd = CharLen(delm[j]);
		if (CheckDelimiterOne(str, i, delm, j)) {
			return 1;
		}
	}
	return 0;
}


int Split(Context* cx, Node* goalscar)
{
	std::string Delimiters = " \t";

	Delimiters = Delimiters + CharSpace();

	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if ((ll != 2) && (ll != 3)) {
		syserr("usage : <split VAR STRINGS> or <split VAR STRINGS DELIMITERS>\n");
		return 0;
	}

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

	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() != ATOM) {
		return 0;
	}
	std::string str;
	((Atom*)nstr)->toString(str);

	if (goalscar->Cdr()->Cdr() != Nil) {
		Node* ndelim = goalscar->Cdr()->Cdr()->Car()->Val();
		if (ndelim->kind() != ATOM) {
			return 0;
		}
		((Atom*)ndelim)->toString(Delimiters);
	}

	// skip space
	std::string tmpstr = "";
	int i, j, ns;
	Node* arg = Nil;
	for (i=0; i < str.length(); i += ns) {
		ns = CharLen(str[i]);
		if (!CheckDelimiter((char*)str.c_str(), i, 
				(char*)Delimiters.c_str())) {
			break;
		}
	}

	// appended terms
	for (; i < str.length(); i += ns) {
		ns = CharLen(str[i]);

		if (CheckDelimiter((char*)str.c_str(), i, 
					(char*)Delimiters.c_str())) {
			if (tmpstr != "") {
				arg = Append(arg, MkList(mka((char*)tmpstr.c_str())));
				tmpstr = "";
			}
		} else {
			for (j = 0; j < ns; j++) {
				tmpstr = tmpstr + str[i+j];
			}
		}
	}
	if (tmpstr != "") {
		arg = Append(arg, MkList(mka((char*)tmpstr.c_str())));
	}

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

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

int Toupper(Context* cx, Node* goalscar)
{
	char* output;
	
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <toupper VAR STRINGS> \n");
		return 0;
	}

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

	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() != ATOM) {
		return 0;
	}
	std::string str;
	((Atom*)nstr)->toString(str);

	output = (char*)malloc(str.length()+1);

	CodeToupper((char*)str.c_str(), output);

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

	free(output);

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


int Tolower(Context* cx, Node* goalscar)
{
	char* output;
	
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <tolower VAR STRINGS> \n");
		return 0;
	}

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

	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() != ATOM) {
		return 0;
	}
	std::string str;
	((Atom*)nstr)->toString(str);

	output = (char*)malloc(str.length()+1);

	CodeTolower((char*)str.c_str(), output);

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

	free(output);

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

int Length(Context* cx, Node* goalscar)
{
	long long n;
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 2) {
		syserr("usage : <length VAR STRINGS>\n");
		return 0;
	}
	Node* nvar = goalscar->Car()->Val();
	if (nvar->kind() != UNDEF) {
		return 0;
	}
	
	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() == LIST) {
		n = ListLength(nstr);
	} else {
		n = 1;
	}

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

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

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 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 Random(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return 0;
	}

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

	if (v->kind() == UNDEF) {
		long long rd;
		Node* env = Nil->Cons(Nil);
#ifndef __MINGW32__
		rd = (long long)random();
#else
		rd = (long long)rand();
#endif /* __MINGW32__ */

		SetEnv(env, v);
		((Undef*)v)->Set(mka(rd));
		PushStack(cx, Nil, Nil, env);
		
		return 1;
	} else {
		return 0;
	}
			
	return 0;
}


int Sin(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)sinl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}


int Cos(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)cosl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Tan(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)tanl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int ASin(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)asinl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int ACos(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)acosl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int ATan(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)atanl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Sinh(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)sinhl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}


int Cosh(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)coshl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Tanh(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)tanhl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int ASinh(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)asinhl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int ACosh(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)acoshl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int ATanh(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)atanhl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Log(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)logl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Log10(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)log10l(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}



int Exp(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)expl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Sqrt(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)sqrtl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Abs(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)fabsl(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Int(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long long)f));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Floor(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();
	long double f;

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	if ((ag->kind() != ATOM) || (!((Atom*)ag)->toFloat(f))) {
		return 0;
	}

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


	SetEnv(env, v);
	((Undef*)v)->Set(mka((long double)floor(f)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Car(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, v);
	((Undef*)v)->Set(ag->Car());
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Cdr(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag = goalscar->Cdr()->Cdr()->Car()->Val();

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, v);
	((Undef*)v)->Set(ag->Cdr());
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Cons(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 3) {
		return 0;
	}

	Node* v = goalscar->Cdr()->Car()->Val();
	Node* ag1 = goalscar->Cdr()->Cdr()->Car()->Val();
	Node* ag2 = goalscar->Cdr()->Cdr()->Cdr()->Car()->Val();

	if (v->kind() != UNDEF) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, v);
	((Undef*)v)->Set(Cons(ag1, ag2));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}


int Char(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}
	
	if (nstr->kind() != ATOM) {
		return 0;
	}

	std::string s;
	((Atom*)nstr)->toString(s);
	Node*	n=Nil;

	int i;
	for (i = 0; i < s.length(); i++) {
		n = Append(n, MkList(mka((long long)(unsigned char)(s[i]))));
	}

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

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(n);
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int Concat(Context* cx, Node* goalscar)
{
	Node* env;
	
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (nlist->kind() == ATOM) {
		env = Nil->Cons(Nil);

		SetEnv(env, nvar);
		((Undef*)nvar)->Set(nlist);
		PushStack(cx, Nil, Nil, env);
		
		return 1;
	}
		
	if (nlist->kind() != LIST) {
		return 0;
	}


	std::string s="";
	std::string sl="";
	Node*	n;
	for (n = nlist; n->kind() != ATOM; n=n->Cdr()) {
		n=n->Val();
		if (n->Car()->kind() == ATOM) {
			if (!((Atom*)(n->Car()))->toString(sl)) {
				return 0;
			}
			s = s+sl;
		} else if (n->Car()->kind() == LIST) {
			Node* n2;
			for (n2 = n->Car(); n2->kind() != ATOM; n2=n2->Cdr()) {
				if (n2->Car()->kind() != ATOM) {
					return 0;
				}
				if (!((Atom*)(n2->Car()))->toString(sl)) {
					return 0;
				}
				s = s+sl;
			}			
		} else {
			return 0;
		}
	}

	
	env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka((char*)s.c_str()));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int ConcatCode(Context* cx, Node* goalscar)
{
	Node* env;
	
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (nlist->kind() != LIST) {
		return 0;
	}


	std::string s="";
	Node*	n;
	long long nn;
	for (n = nlist; n->kind() != ATOM; n=n->Cdr()) {
		n=n->Val();
		if (n->Car()->kind() == ATOM) {
			if (!((Atom*)(n->Car()))->toLLInt(nn)) {
				return 0;
			}
			s = s+char(nn);
		} else if (n->Car()->kind() == LIST) {
			Node* n2;
			for (n2 = n->Car(); n2->kind() != ATOM; n2=n2->Cdr()) {
				if (n2->Car()->kind() != ATOM) {
					return 0;
				}
				if (!((Atom*)(n2->Car()))->toLLInt(nn)) {
					return 0;
				}
				s = s+char(nn);
			}			
		} else {
			return 0;
		}
	}

	
	env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka((char*)s.c_str()));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}


int SetCode(Context* cx, Node* goalscar)
{
	extern std::string code;
	
	if (ListLength(goalscar->Cdr()) != 1) {
		return 0;
	}

	Node* ncode = goalscar->Cdr()->Car()->Val();
	std::string scode;
	if (ncode->kind() == UNDEF) {
		Node* env = Nil->Cons(Nil);

		SetEnv(env, ncode);
		((Undef*)ncode)->Set(mka((char*)code.c_str()));
		PushStack(cx, Nil, Nil, env);

		return 1;
	} else if (ncode->kind() != ATOM) {
		return 0;
	}
	
	((Atom*)ncode)->toString(scode);
	if ((scode == "EUCJP") || (scode == "EUC-JP")|| (scode == "EUC")) {
		code = "EUC";
	} else if ((scode == "SJIS") || (scode == "SHIFT-JIS")) {
		code = "SJIS";
	} else if ((scode == "UTF8") || (scode == "UTF-8")) {
		code = "UTF8";
	}
	return 1;	
}


int CodeCharPrd(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}
	
	if (nstr->kind() != ATOM) {
		return 0;
	}

	std::string s;
	((Atom*)nstr)->toString(s);
	Node*	n=Nil;

	n = CodeChar((char*)s.c_str());
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(n);
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}


int UTF8CharPrd(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}
	
	if (nstr->kind() != ATOM) {
		return 0;
	}

	std::string s;
	((Atom*)nstr)->toString(s);
	Node*	n=Nil;

	n = UTF8Char((char*)s.c_str());
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(n);
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int EUCCharPrd(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}
	
	if (nstr->kind() != ATOM) {
		return 0;
	}

	std::string s;
	((Atom*)nstr)->toString(s);
	Node*	n=Nil;

	n = EUCChar((char*)s.c_str());
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(n);
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int SJISCharPrd(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}
	
	if (nstr->kind() != ATOM) {
		return 0;
	}

	std::string s;
	((Atom*)nstr)->toString(s);
	Node*	n=Nil;

	n = SJISChar((char*)s.c_str());
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(n);
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int And(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 3) {
		return 0;
	}

	Node* g    = goalscar->Cdr()->Val();
	Node* nvar = g->Car()->Val();
	Node* n1   = g->Cdr()->Car()->Val();
	Node* n2   = g->Cdr()->Cdr()->Car()->Val();
	long long nn1, nn2;

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (n1->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n1)->toLLInt(nn1)) {
		return 0;
	}
	
	if (n2->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n2)->toLLInt(nn2)) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	long long nn3;
	if (nn1 != 1) {
		nn3 = -1;
	} else if (nn2 != 1) {
		nn3 = -1;
	} else {
		nn3 = 1;
	}
	
	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(nn3));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Or(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 3) {
		return 0;
	}

	Node* g    = goalscar->Cdr()->Val();
	Node* nvar = g->Car()->Val();
	Node* n1   = g->Cdr()->Car()->Val();
	Node* n2   = g->Cdr()->Cdr()->Car()->Val();
	long long nn1, nn2;


	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (n1->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n1)->toLLInt(nn1)) {
		return 0;
	}
	
	if (n2->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n2)->toLLInt(nn2)) {
		return 0;
	}
	
	long long nn3;
	if (nn1 == 1) {
		nn3 = 1;
	} else if (nn2 == 1) {
		nn3 = 1;
	} else {
		nn3 = -1;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(nn3));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Xor(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 3) {
		return 0;
	}

	Node* g    = goalscar->Cdr()->Val();
	Node* nvar = g->Car()->Val();
	Node* n1   = g->Cdr()->Car()->Val();
	Node* n2   = g->Cdr()->Cdr()->Car()->Val();
	long long nn1, nn2, nn3;

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (n1->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n1)->toLLInt(nn1)) {
		return 0;
	}
	
	if (n2->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n2)->toLLInt(nn2)) {
		return 0;
	}
	
	if ((nn1 == 1) && (nn2 == 1)){
		nn3 = -1;
	} else if (nn1 == 1) {
		nn3 = 1;
	} else if (nn2 == 1) {
		nn3 = 1;
	} else {
		nn3 = -1;
	}

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

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(nn3));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int BitNot(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 2) {
		return 0;
	}

	Node* g    = goalscar->Cdr()->Val();
	Node* nvar = g->Car();
	Node* n1   = g->Cdr()->Car();
	long long nn1;

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (n1->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n1)->toLLInt(nn1)) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(~nn1));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int ShiftL(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 3) {
		return 0;
	}

	Node* g    = goalscar->Cdr()->Val();
	Node* nvar = g->Car()->Val();
	Node* n1   = g->Cdr()->Car()->Val();
	Node* nsft = g->Cdr()->Cdr()->Car()->Val();
	long long nn1, nnsft;

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (n1->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n1)->toLLInt(nn1)) {
		return 0;
	}
	
	if (nsft->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)nsft)->toLLInt(nnsft)) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(nn1<<nnsft));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int ShiftR(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 3) {
		return 0;
	}

	Node* g    = goalscar->Cdr()->Val();
	Node* nvar = g->Car()->Val();
	Node* n1   = g->Cdr()->Car()->Val();
	Node* nsft   = g->Cdr()->Cdr()->Car()->Val();
	long long nn1, nnsft;

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	if (n1->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)n1)->toLLInt(nn1)) {
		return 0;
	}
	
	if (nsft->kind() != ATOM) {
		return 0;
	}
	
	if (!((Atom*)nsft)->toLLInt(nnsft)) {
		return 0;
	}
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(nn1>>nnsft));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}


int eq(Context* cx, Node* goalscar)
{
	Node*	env = Nil->Cons(Nil);
	
	Node* n = goalscar->Cdr()->Val();
	if (ListLength(n) != 2) {
		syserr("usage : <eq LIST1 LIST2>\n");
		return 0;
	}
	Node* n1 = n->Car();
	Node* n2 = n->Cdr()->Car();

	if (Unification(n1, n2, env, cx)) {
		PushStack(cx, Nil, Nil, env);
		return 1;
	}
	return -1;
}

int noteq(Context* cx, Node* goalscar)
{
	Node*	env = Nil->Cons(Nil);
	
	Node* n = goalscar->Cdr()->Val();
	if (ListLength(n) != 2) {
		syserr("usage : <noteq LIST1 LIST2>\n");
		return 0;
	}
	Node* n1 = n->Car();
	Node* n2 = n->Cdr()->Car();

	if (Unification(n1, n2, env, cx)) {
		PushStack(cx, Nil, Nil, env);
		return -1;
	}
	return 1;
}

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

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

	if (goalscar->Cdr()->Cdr() != Nil) {
		return 0;
	}
	
	if (cx->ioin == stdin) {
		syserr("File is not opened");
		return 0;
	}

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

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

		int c = fgetc(cx->ioin);

		if (c == EOF) {
			return 0;
		}

		char ca[2];
		ca[0] = c;
		ca[1] = 0;		
		SetEnv(env, v);
		((Undef*)v)->Set(mka(ca));
		PushStack(cx, Nil, Nil, env);
		
		return 1;
	} else if (v->kind() == ATOM) {
		int c = fgetc(cx->ioin);

		if (c == EOF) {
			return 0;
		}

		std::string s;
		((Atom*)v)->toString(s);
		if (s.length() != 1) {
			return 0;
		}
		
		return ((s.c_str())[0] == c);
	} else {
		return 0;
	}
			
	return 0;
}

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

	Node* g = goalscar->Val();
	if (g->Cdr()->kind() == LIST) {
		if (g->Cdr()->Car()->kind() == ATOM) {
			std::string s;
			((Atom*)g->Cdr()->Car())->toString(s);
			putc(s.c_str()[0], cx->ioout);
			return 1;
		}
	}
	return 0;
				
}

#define MAXCLINE	4096

int GetLine(Context* cx, Node* goalscar)
{
	char*	cline;
	
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll < 1) {
		syserr("usage : <getline VAR [PRED]>\n");
		return 0;
	}
	Node* nvar = goalscar->Car();
	if (nvar->kind() != UNDEF) {
		syserr("getline : the first argument is not a variable.");
		return 0;
	}

	Node* npred;
	if (ll >= 2) {
		npred = goalscar->Cdr();
	}

#ifndef __MINGW32__
	if (cx->ioin == stdin) {
		cline = readline(NULL);
		if (cline != 0) {
			add_history(cline);
		} else {
			cline = (char*)malloc(2);
			cline[0] = 0;
		}
	} else {
		cline = (char*)malloc(MAXCLINE);
		if (fgets(cline, MAXCLINE, cx->ioin) == NULL) {
			free(cline);
			return 0;
		}
		cline[MAXCLINE-1] = 0;
	}
#else
	cline = (char*)malloc(MAXCLINE);
	if (fgets(cline, MAXCLINE-1, cx->ioin) == NULL) {
		free(cline);
		return 0;
	}
	cline[MAXCLINE-1] = 0;
#endif /* __MINGW32__ */

	int n = strlen(cline);
	for (int i = n-1; i >= 0; i--) {
		int c = cline[i];
		if ((c == '\n') || (c == '\r')) {
			cline[i] = 0;
		} else {
			break;
		}
	}
	
	Node* env = Nil->Cons(Nil);
	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(cline));

	if (ll >= 2) {
		char tmpfilename[MAXPATHLEN];
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strcat(tmpfilename, "/descXXXXXX");
		FILE* fd = MksTemp(tmpfilename);
		if (fd == NULL) {
			printf("tmpfile : cannot open tmp file \n");
			return 0;
		}
		
		int rn;
		Context* cx2 = new Context(cx->module);
		cx2->inherit = cx->inherit;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;

		cx2->ioin = fd;

		fprintf(cx2->ioin, "%s", cline);
		free(cline);

		rewind(cx2->ioin);

		cxpush(cx2, goalscar);
		cxpush(cx2, nvar);
		cxpush(cx2, npred);
		cxpush(cx2, env);
//PrintNode("getline npred ", npred);
		if ((rn=Unify(cx2, npred, cx->module))>0) {
			cx->Merge(cx2);

			fclose(cx2->ioin);
			cxpop(cx2);
			cxpop(cx2);
			cxpop(cx2);
			cxpop(cx2);
			delete cx2;
			cx2 = 0;

			PushStack(cx, Nil, Nil, env);

			unlink(tmpfilename);
//printf("getline trace 0 : %d \n", rn);
			return rn;
		} else {
			fclose(cx2->ioin);
			cxpop(cx2);
			cxpop(cx2);
			cxpop(cx2);
			cxpop(cx2);
			delete cx2;
			cx2 = 0;

			unlink(tmpfilename);
//printf("getline trace 1 : %d \n", rn);
			return rn;
		}

	}

	return 1;
}

int SyntaxLine(Context* cx, Node* goalscar)
{
	std::string	sline;
	
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll < 2) {
		syserr("usage : <syntax VAR PRED>\n");
		return 0;
	}
	Node* nval = goalscar->Car()->Val();
#if 0
	if (nval->kind() != ATOM) {
		syserr("syntax : the first argument is not a Atom.");
		return 0;
	}

	((Atom*)nval)->toString(sline);
#endif
	
	Node* npred;

	npred = goalscar->Cdr();
	
	{
		char tmpfilename[MAXPATHLEN];
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strcat(tmpfilename, "/descXXXXXX");
		FILE* fd = MksTemp(tmpfilename);
		if (fd == NULL) {
			syserr("tmpfile : cannot open tmp file \n");
			return 0;
		}
		
		int rn;
		Context* cx2 = new Context(cx->module);
		cx2->inherit = cx->inherit;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;

		cx2->ioin = fd;

//		fprintf(cx2->ioin, "%s", sline.c_str());
		nval->print(cx2->ioin);		

		rewind(cx2->ioin);

		cxpush(cx2, goalscar);
		cxpush(cx2, npred);
//PrintNode("syntax npred 1 ", npred);

		if ((rn=Unify(cx2, npred, cx->module))>0) {

//PrintNode("syntax npred 2 ", npred->Val());
			cx->Merge(cx2);

			fclose(cx2->ioin);
			cxpop(cx2);
			cxpop(cx2);
			delete cx2;
			cx2 = 0;

			unlink(tmpfilename);
//printf("syntax trace 0 : %d \n", rn);
			return rn;
		} else {
			fclose(cx2->ioin);
			cxpop(cx2);
			cxpop(cx2);
			delete cx2;
			cx2 = 0;

			unlink(tmpfilename);
//printf("syntax trace 1 : %d \n", rn);
			return rn;
		}

	}

	return 1;
}


int TmpFile(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	int ll = ListLength(goalscar);
	if (ll != 1) {
		syserr("usage : <tmpfile VAR>\n");
		return 0;
	}
	Node* nvar = goalscar->Car();
	if (nvar->kind() != UNDEF) {
		syserr("tmpfile : the first argument is not a variable.");
		return 0;
	}

	char tmpfilename[MAXPATHLEN];
	strncpy(tmpfilename, tmppath, MAXPATHLEN);
	strcat(tmpfilename, "/descXXXXXX");
	FILE* fd = MksTemp(tmpfilename);
	if (fd == NULL) {
		printf("tmpfile : cannot open tmp file \n");
		return 0;
	}

	fclose(fd);
	
	Node* env = Nil->Cons(Nil);
	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka((char*)tmpfilename));

	unlink(tmpfilename);

	return 1;
}

int DoOpenR(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) < 2) {
		return -1;
	}

	Node* fname = goalscar->Cdr()->Car()->Val();
	if (fname->kind() != ATOM) {
		return -1;
	}
	
	std::string sfname;
	((Atom*)fname)->toString(sfname);

	FILE* fd;
	fd = fopen(sfname.c_str(), "rb");
	if (fd == NULL) {
		return -1;
	}
	

	Node*	gl = goalscar->Cdr()->Cdr();

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

	cxpush(cx2, gl);

	int r;
	r=Unify(cx2, gl, cx->module);

	cxpop(cx2);

	if (cx2->ioin != stdin) {
		fclose(cx2->ioin);
	}

	delete cx2;
	cx2 = 0;

	return r;
}

int DoOpenW(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) < 2) {
		return -1;
	}

	Node* fname = goalscar->Cdr()->Car()->Val();
	if (fname->kind() != ATOM) {
		return -1;
	}
	
	std::string sfname;
	((Atom*)fname)->toString(sfname);
	FILE* fd;
	fd = fopen(sfname.c_str(), "w");
	if (fd == NULL) {
		return -1;
	}


	Node*	gl = goalscar->Cdr()->Cdr();

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

	int r;
	r=Unify(cx2, gl, cx->module);

	cxpop(cx2);

	if (cx2->ioout != stdout) {
		fclose(cx2->ioout);
	}

	delete cx2;
	cx2 = 0;

	return r;
}

int DoOpenWP(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) < 2) {
		return -1;
	}

	Node* fname = goalscar->Cdr()->Car()->Val();
	if (fname->kind() != ATOM) {
		return -1;
	}
	
	std::string sfname;
	((Atom*)fname)->toString(sfname);
	FILE* fd;
	fd = fopen(sfname.c_str(), "w+");
	if (fd == NULL) {
		return -1;
	}


	Node*	gl = goalscar->Cdr()->Cdr();

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

	int r;
	r=Unify(cx2, gl, cx->module);

	cxpop(cx2);

	if (cx2->ioout != stdout) {
		fclose(cx2->ioout);
	}

	delete cx2;
	cx2 = 0;

	return r;
}


int GetlineEval()
{
	char*	cline;
	std::string scline;
	int i;
	
	for(;;) {
#ifndef __MINGW32__
		cline = readline("? ");
		if (cline != 0) {
			add_history(cline);
		} else {
			cline = (char*)malloc(2);
			cline[0] = 0;
		}
#else
		printf("? ");
		cline = (char*)malloc(MAXCLINE);
		if (fgets(cline, MAXCLINE-1, stdin) == NULL) {
			free(cline);
			return 0;
		}
		cline[MAXCLINE-1] = 0;
#endif /* __MINGW32__ */

		// save tmpline
		char tmpfilename[MAXPATHLEN];
		strncpy(tmpfilename, tmppath, MAXPATHLEN);
		strcat(tmpfilename, "/descXXXXXX");
		FILE* fd = MksTemp((char*)tmpfilename);
		if (fd == NULL) {
			printf("getline : cannot open tmp file \n");
			return 0;
		}

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

		// if '<>' is none in cline, added it.
		std::string sline = cline;
		
		for (;;) {
			
			for (i = strlen(cline)-1; i >= 0; i--) {
				if (cline[i] == ';') {
					break;
				}
			}
			if (cline[i] == ';') {
				break;
			}
#ifndef __MINGW32__
			cline = readline(NULL);
			if (cline != 0) {
				add_history(cline);
			} else {
				cline = (char*)malloc(2);
				cline[0] = 0;
			}
#else
			cline = (char*)malloc(MAXCLINE);
			if (fgets(cline, MAXCLINE-1, stdin) == NULL) {
				free(cline);
				return 0;
			}
			cline[MAXCLINE-1] = 0;
#endif /* __MINGW32__ */

			sline = sline + cline;
		}

		std::string sline2 = "";

		for (i = 0; i < sline.length()-1; i++) {
			if (sline[i] == ' ') {
				continue;
			}
			if ((sline[i] == '<') || (sline[i] == ';')) {
				break;
			}
			if ((sline[i] == ':') && (sline[i+1] == ':')) {
				i++;
				char* spc = CharSpace();
				int nspc = strlen(spc);
				for ( ; i < sline.length(); i++) {
					if (isspace(sline[i])) {
						continue;
					}
					if (strncmp(&sline[i], spc, nspc) == 0) {
						i += nspc - 1;
						continue;
					}
					break;
				}
				sline2 = "::";
				for (i++; i < sline.length(); i++) {
					if (isspace(sline[i])) {
						i++;
						break;
					}
					if (strncmp(&sline[i], spc, nspc) == 0) {
						i = i+nspc;
						break;
					}
					sline2 += sline[i];
				}
			}
					

			sline2 += "<";
			sline2 = sline2 + sline.substr(i);

			for (int j = sline2.length(); j >= 0; j--) {
				if (sline2[j] == ';') {
					sline2[j] = '>';
					sline2 = sline2 + ";";
					break;
				}
			}
			sline = sline2;
			break;
		}

		fprintf(RdFp, "?%s\n", sline.c_str());
		
		// eval
		// save tmpline
		rewind(RdFp);

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

		extern  int     NwccMain();	
		NwccMain();

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

		fclose(RdFp);
		RdFp = fdsave;
		
		free(cline);

		unlink(tmpfilename);
	}
}


int DoRegex(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	
	if (ListLength(goalscar) != 5) {
		return 0;
	}

	Node* nptn = goalscar->Car()->Val();
	if (nptn->kind() != ATOM) {
		syserr("usage : <regex pattern strings forestr matchstr reststr> \n");
		return 0;
	}
	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() != ATOM) {
		syserr("usage : <regex pattern strings forestr matchstr reststr> \n");
		return 0;
	}
	Node* nfore = goalscar->Cdr()->Cdr()->Car()->Val();
	if (nfore->kind() != UNDEF) {
		syserr("usage : <regex pattern strings forestr matchstr reststr> \n");
		return 0;
	}
	Node* nmatch = goalscar->Cdr()->Cdr()->Cdr()->Car()->Val();
	if (nmatch->kind() != UNDEF) {
		syserr("usage : <regex pattern strings forestr matchstr reststr> \n");
		return 0;
	}
	Node* nrest = goalscar->Cdr()->Cdr()->Cdr()->Cdr()->Car()->Val();
	if (nrest->kind() != UNDEF) {
		syserr("usage : <regex pattern strings forestr matchstr reststr> \n");
		return 0;
	}

	extern int Regex(std::string ptn, std::string str,
	                std::string& forestr, std::string& matchstr, 
	                	std::string& reststr);
	std::string	str, ptn,  fore, match, rest;

	((Atom*)nstr)->toString(str);
	((Atom*)nptn)->toString(ptn);

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

	if (!Regex(ptn, str, fore, match, rest)) {
		return -1;
	}
	 
	SetEnv(env, nfore);
	((Undef*)nfore)->Set(mka((char*)fore.c_str()));

	SetEnv(env, nmatch);
	((Undef*)nmatch)->Set(mka((char*)match.c_str()));

	SetEnv(env, nrest);
	((Undef*)nrest)->Set(mka((char*)rest.c_str()));

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

int DoSub(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	
	if (ListLength(goalscar) != 4) {
		return 0;
	}

	Node* nptn = goalscar->Car()->Val();
	if (nptn->kind() != ATOM) {
		syserr("usage : <sub pattern strings replacestr outputstr>\n");
		return 0;
	}
	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() != ATOM) {
		syserr("usage : <sub pattern strings replacestr outputstr>\n");
		return 0;
	}
	Node* nreplace = goalscar->Cdr()->Cdr()->Car()->Val();
	if (nreplace->kind() != ATOM) {
		syserr("usage : <sub pattern strings replacestr outputstr>\n");
		return 0;
	}
	Node* noutput = goalscar->Cdr()->Cdr()->Cdr()->Car()->Val();
	if (noutput->kind() != UNDEF) {
		syserr("usage : <sub pattern strings replacestr outputstr>\n");
		return 0;
	}

	extern int Sub(std::string ptn, std::string str,
	                std::string replacestr, std::string& outputstr);
	std::string	str, ptn,  replace, output;

	((Atom*)nptn)->toString(ptn);
	((Atom*)nstr)->toString(str);
	((Atom*)nreplace)->toString(replace);

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

	if (!Sub(ptn, str, replace, output)) {
		return -1;
	}
	 
	SetEnv(env, noutput);
	((Undef*)noutput)->Set(mka((char*)output.c_str()));

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

int DoGSub(Context* cx, Node* goalscar)
{
	goalscar = goalscar->Cdr()->Val();
	
	if (ListLength(goalscar) != 4) {
		return 0;
	}

	Node* nptn = goalscar->Car()->Val();
	if (nptn->kind() != ATOM) {
		syserr("usage : <gsub pattern strings replacestr outputstr>\n");
		return 0;
	}
	Node* nstr = goalscar->Cdr()->Car()->Val();
	if (nstr->kind() != ATOM) {
		syserr("usage : <gsub pattern strings replacestr outputstr>\n");
		return 0;
	}
	Node* nreplace = goalscar->Cdr()->Cdr()->Car()->Val();
	if (nreplace->kind() != ATOM) {
		syserr("usage : <gsub pattern strings replacestr outputstr>\n");
		return 0;
	}
	Node* noutput = goalscar->Cdr()->Cdr()->Cdr()->Car()->Val();
	if (noutput->kind() != UNDEF) {
		syserr("usage : <gsub pattern strings replacestr outputstr>\n");
		return 0;
	}

	extern int GSub(std::string ptn, std::string str,
	                std::string replacestr, std::string& outputstr);
	std::string	str, ptn,  replace, output;

	((Atom*)nptn)->toString(ptn);
	((Atom*)nstr)->toString(str);
	((Atom*)nreplace)->toString(replace);

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

	if (!GSub(ptn, str, replace, output)) {
		return -1;
	}
	 
	SetEnv(env, noutput);
	((Undef*)noutput)->Set(mka((char*)output.c_str()));

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

int DoCountNode(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

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

	long long n = CountNode();
	
	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(n));
	PushStack(cx, Nil, Nil, env);
		
	return 1;
}

int GetTime(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	struct timeval tv;
	gettimeofday (&tv, NULL);
	long long val = tv.tv_sec*1000000+tv.tv_usec;
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(val));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Time(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	struct timeval tv;
	gettimeofday (&tv, NULL);
	long long val = tv.tv_sec*1000000+tv.tv_usec - progtime.start_time;
	long double fval = (long double)val / 1000000.0;
	Node* env = Nil->Cons(Nil);

#ifndef __MINGW32__
	long clk_tck = sysconf(_SC_CLK_TCK);
	struct tms tmsbuf;
	times(&tmsbuf);
	long double fuval = (long double)(tmsbuf.tms_utime - progtime.start_utime)
				/ clk_tck;
	long double fsval = (long double)(tmsbuf.tms_stime - progtime.start_stime)
				/ clk_tck;

	Node* l = MkList(mka(fuval), mka(fsval), mka(fval));
#else
	Node* l = MkList(mka(fval));
#endif

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(l);
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

int Date(Context* cx, Node* goalscar)
{
	if (ListLength(goalscar->Cdr()) != 1) {
		return 0;
	}

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

	if (nvar->kind() != UNDEF) {
		return 0;
	}

	struct timeval tv;
	gettimeofday (&tv, NULL);
	
	Node* env = Nil->Cons(Nil);

	SetEnv(env, nvar);
	((Undef*)nvar)->Set(mka(ctime((const time_t*)&tv.tv_sec)));
	PushStack(cx, Nil, Nil, env);
		
	return 1;

}

