#include <string.h>
#include <math.h>
#include <ctype.h>
#include <stdio.h>
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifndef NOMALLOC_H
#include <malloc.h>
#endif

#include "fudgit.h"
#include "symbol.h"
#include "code.h"
#ifdef VMS
#include "math_tab.h"
#else
#include "math.tab.h"
#endif
#include "head.h"

#ifndef M_PI
#define M_PI		3.14159265358979323846
#endif
#ifndef M_E
#define M_E	 2.7182818284590452354
#endif

extern double Ft_Log(double x),
  Ft_Log10(double x),
  Ft_Sqrt(double x),
  Ft_Exp(double x),
  Ft_integer(double x),
  Ft_Srand(double x),
  Ft_vread(void),
  Ft_Rand(void),
  Ft_Sec(double x),
  Ft_Sech(double x),
  Ft_Cot(double x),
  Ft_Coth(double x),
  Ft_Csc(double x),
  Ft_Csch(double x),
#ifndef NOJN_YN
  Ft_Jn(double i, double d),
  Ft_Yn(double i, double d),
#endif
#ifndef NOY0_Y1
  Ft_Y0(double d),
  Ft_Y1(double d),
#endif
  Ft_Asin(double x),
  Ft_Acos(double x),
  Ft_Acosh(double x),
  Ft_Asinh(double x),
  Ft_Atanh(double x),
  Ft_Cbrt(double x),
  Ft_Cosh(double x),
  Ft_Sinh(double x),
  Ft_Tanh(double x),
  Ft_Tan(double x),
  Ft_Lgamma(double x),
  Ft_Hypot(double x, double y),
  Ft_Atan2(double x, double y),
  Ft_Atan(double x),
  Ft_octal(double x),
  trunc(double x),
  rint(double x),
  Ft_dbscan(char *s1, char *s2),
  Ft_interp(double x),
  Ft_minimum(double x, double y),
  Ft_maximum(double x, double y),
  Ft_sum(double *vec);

extern char *Ft_Read(void),
  *Ft_Scan(char *s1, char *s2),
  *Ft_DirName(char *s),
  *Ft_FileName(char *s);

static struct {   /* Can never be erased  */
	char	 *name;
	int	  kval;
} keywords[] = {
	{"while", WHILE},
	{"return", RETURN},
	{"proc", PROC},
	{"print", PRINT},
	{"if",	IF},
	{"func", FUNC},
	{"for", FOR},
	{"else",  ELSE},
	{"continue", CONTINUE},
	{"break", BREAK},
	{"auto", AUTO},
	{0, 0}
};

static struct { /* can never be erased */
	char *name;
	double val;
} bltinvars[] = {
	{"if_value",  0},
	{0, 0}
};

static struct { /* can never be erased */
	char *name;
	double val;
} bltinconsts[] = {
	{"pi", M_PI},
	{"param", 0},
	{"e",  M_E},
	{"data",  0},
	{"chi2",  0},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	char *string;
} bltinstrconsts[] = {
	{"Tmp",  ""},
	{"ReadFile", ""},
	{"Cwd", ""},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	double (*func)();
} builtins0[] = {
	{"vread", Ft_vread},
	{"rand", Ft_Rand},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	double (*func)();
} builtins1vec[] = {
	{"sum", Ft_sum},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	double (*func)();
} builtins1[] = {
	{"trunc", trunc},
	{"tanh", Ft_Tanh},
	{"tan", Ft_Tan},
	{"srand", Ft_Srand},
	{"sqrt", Ft_Sqrt},
	{"sinh", Ft_Sinh},
	{"sin", sin},
	{"sech", Ft_Sech},
	{"sec", Ft_Sec},
	{"rint", rint},
	{"octal", Ft_octal},
	{"log", Ft_Log10},
	{"ln", Ft_Log},
	{"lgamma", Ft_Lgamma},
	{"interp", Ft_interp},
	{"int", Ft_integer},
	{"floor", floor},
	{"exp", Ft_Exp},
#if !defined(HPUX) && !defined(VMS)
	{"erfc", erfc},
	{"erf", erf},
#endif
	{"csch", Ft_Csch},
	{"csc", Ft_Csc},
	{"coth", Ft_Coth},
	{"cot", Ft_Cot},
	{"cosh", Ft_Cosh},
	{"cos", cos},
	{"ceil", ceil},
	{"cbrt", Ft_Cbrt},
#ifndef NOY0_Y1
	{"besy1", Ft_Y1},
	{"besy0", Ft_Y0},
#endif
#if !defined(HPUX) && !defined(VMS)
	{"besj1", j1},
	{"besj0", j0},
#endif
	{"atanh", Ft_Atanh},
	{"atan", Ft_Atan},
	{"asinh", Ft_Asinh},
	{"asin", Ft_Asin},
	{"acosh", Ft_Acosh},
	{"acos", Ft_Acos},
	{"abs", fabs},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	double (*func)();
} builtins2[] = {
	{"min", Ft_minimum},
	{"max", Ft_maximum},
	{"hypot", Ft_Hypot},
#ifndef NOJN_YN
	{"besyn", Ft_Yn},
	{"besjn", Ft_Jn},
#endif
	{"atan2", Ft_Atan2},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	double (*func)();
} strbuiltins2[] = {
	{"scan", Ft_dbscan},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	char *(*func)();
} builtins0str[] = {
	{"Read", Ft_Read},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	char *(*func)();
} builtins1str[] = {
	{"DirName", Ft_DirName},
	{"FileName", Ft_FileName},
	{0, 0}
};

static struct {  /* can never be erased */
	char *name;
	char *(*func)();
} builtins2str[] = {
	{"Scan", Ft_Scan},
	{0, 0}
};

static int Argno = 0;


extern void Ft_matherror (char *s1, char *s2, int lino);

void Ft_initparser(void)
{
	int i;
	Symbol *s;

	for (i = 0;keywords[i].name; i++) {
		s = Ft_install(keywords[i].name, keywords[i].kval, 1);
	}
	for (i = 0;bltinstrconsts[i].name; i++) {
		s = Ft_install(bltinstrconsts[i].name, BLTINSTRCONST, 1);
		s->u.str = "undefined";
	}
	for (i = 0;bltinvars[i].name; i++) {
		s = Ft_install(bltinvars[i].name, BLTINVAR, 1);
		s->u.val = bltinvars[i].val;
	}
	for (i = 0;bltinconsts[i].name; i++) {
		s = Ft_install(bltinconsts[i].name, BLTINCONST, 1);
		s->u.val = bltinconsts[i].val;
	}
	for (i = 0;builtins0[i].name; i++) {
		s = Ft_install(builtins0[i].name, BLTIN0, 1);
		s->u.ptr = builtins0[i].func;
	}
	for (i = 0;builtins1[i].name; i++) {
		s = Ft_install(builtins1[i].name, BLTIN1, 1);
		s->u.ptr = builtins1[i].func;
	}
	for (i = 0;builtins2[i].name; i++) {
		s = Ft_install(builtins2[i].name, BLTIN2, 1);
		s->u.ptr = builtins2[i].func;
	}
	for (i = 0;builtins0str[i].name; i++) {
		s = Ft_install(builtins0str[i].name, BLTIN0STR, 1);
		s->u.ptr = (double (*)()) (builtins0str[i].func);
	}
	for (i = 0;builtins1str[i].name; i++) {
		s = Ft_install(builtins1str[i].name, BLTIN1STR, 1);
		s->u.ptr = (double (*)()) (builtins1str[i].func);
	}
	for (i = 0;builtins2str[i].name; i++) {
		s = Ft_install(builtins2str[i].name, BLTIN2STR, 1);
		s->u.ptr = (double (*)()) (builtins2str[i].func);
	}
	for (i = 0;strbuiltins2[i].name; i++) {
		s = Ft_install(strbuiltins2[i].name, STRBLTIN2, 1);
		s->u.ptr = strbuiltins2[i].func;
	}
	for (i = 0;builtins1vec[i].name; i++) {
		s = Ft_install(builtins1vec[i].name, BLTIN1VEC, 1);
		s->u.ptr = builtins1vec[i].func;
	}
}

static Symbol *symlist = 0;
static AutoSymbol *autosymlist = 0;

#include <stdio.h>
#include <string.h>

Symbol *Ft_Symlist(void)
{
	return(symlist);
}

Symbol *Ft_lookup(char *s)
{
	Symbol *sp;

	if (!s)
		return(NULL);
	for (sp = symlist; sp != (Symbol *)0; sp = sp->next) {
		if (strcmp(sp->name, s) == 0) {
			return(sp);
		}
	}
	return(NULL);
}

int Ft_autolookup(char *s, int level)
{
	AutoSymbol *sp;

	if (!s)
		return(0);
	for (sp = autosymlist; sp != (AutoSymbol *)0; sp = sp->next) {
		if (strcmp(sp->name, s) == 0) {
			if (level) {
				if (sp->level >= level) {
					return(sp->argno);
				}
				else {  /* larger level is at the beginning */
					return(0);
				}
			}
			else if (sp->level == 0) {
				return(sp->argno);
			}
		}
	}
	return(0);
}

int Ft_autoinstall(char *s, int type, int level)
{
	AutoSymbol *sp;
	extern int Argno;

	if (strlen(s) > MAXVARNAME) {
		Ft_matherror("autoinstall: %s: Name too long.", s, 0);
	}
	if ((sp = (AutoSymbol *)malloc(sizeof(AutoSymbol))) == (AutoSymbol *)0) {
		Ft_matherror("autoinstall: Allocation error.", NULL, 0);
	}
	if ((sp->name = (char *)malloc(strlen(s)+1)) == (char *)0) {
		Ft_matherror("autoinstall: Allocation error.", NULL, 0);
	}
	strcpy(sp->name, s);
	sp->level = level;
	sp->type = type;
	sp->argno = ++Argno;
	sp->next = autosymlist;
	autosymlist = sp;
	return(Argno);
}

Symbol *Ft_install(char *s, int t, int size)
{
	Symbol *sp;

	sp = Ft_geninstall(s, t, size);
	sp->next = symlist;
	symlist = sp;
	return(sp);
}

Symbol *Ft_geninstall(char *s, int t, int size)
{
	Symbol *sp;
	extern double *Ft_dvector(int nl, int nh);

	if (strlen(s) > MAXVARNAME) {
		Ft_matherror("install: %s: Name too long.", s, 0);
	}
	if ((sp = (Symbol *)malloc(sizeof(Symbol))) == (Symbol *)0) {
		Ft_matherror("install: Allocation error.", NULL, 0);
	}
	if ((sp->name = (char *)malloc(strlen(s)+1)) == (char *)0) {
		Ft_matherror("install: Allocation error.", NULL, 0);
	}
	if (t == VEC || t == UNDEFVEC || t == PARAM) {
		if ((sp->u.vec = Ft_dvector(1, size)) == (double *)0) {
			Ft_matherror("install: Allocation error.", NULL, 0);
		}
	}
	else if (t == STRING || t == UNDEFSTRVAR ||
			 t == STRVAR || t == BLTINCONST) {
		if (t != UNDEFSTRVAR) {
			if ((sp->u.str = (char *)malloc(size+1)) == NULL) {
				Ft_matherror("install: Allocation error.", NULL, 0);
			}
		}
		else {
			sp->u.str = (char *)NULL;
		}
	}
	sp->size.val = size;
	strcpy(sp->name, s);
	sp->type = t;
	return(sp);
}

int Ft_autosymremove(int level)
{
	AutoSymbol *sp, *sprevious;
	AutoSymbol *spresent;
	extern int Argno;
	int removed = 0;

	sprevious = sp = autosymlist;
	while (sp != (AutoSymbol *)0) {
		if (sp->level >= level) {
			if (sp->type == AUTO)
				removed++;
			spresent = sp;
			if (spresent == autosymlist) {  /* first one ? */
				autosymlist = sp->next;
				sp = sp->next;
			}
			else {
				sprevious->next = sp->next;
				sp = sp->next;
			}
			free(spresent->name);
			free((char *)spresent);
			Argno--;
		}
		else {
			sprevious = sp;
			sp = sp->next;
		}
	}
	return(removed);
}

	/* remove vectors or variables on request */
int Ft_symremove(char *name, int verb)
{
	Symbol *sp, *sprevious;
	Symbol *spresent;
	int found = 0;
	int all, allvec;
	extern void Ft_free_dvector(double *v, int nl, int nh);
	extern void Ft_resetprog(void);

	all = (strcmp(name, "@all") == 0);
	allvec = (all || (strcmp(name, "@allvec") == 0));
	if (all) {  /* reset machine vector */
		Ft_resetprog();
	}
	if (all || allvec) {
		name = "";  /* avoid testing */
		found = 1;
	}
	sprevious = sp = symlist;
	while (sp != (Symbol *)0) {
		switch(sp->type) {
			case BLTINVAR:
			case BLTINSTRVAR:
			case BLTINCONST:
			case BLTINSTRCONST:
				if (strcmp(sp->name, name) == 0) {
					fprintf(stderr, "free: %s: Cannot be removed.\n", name);
					return(ERRR);
				}
				break;
			case STRCONST:
			case CONST:
				if (strcmp(sp->name, name) == 0) {
					fprintf(stderr,
					"free: %s now a constant. Unlock first.\n", name);
					return(ERRR);
				}
				break;
			case STRING:
				if (!all) {
					break;
				}
			case STRVAR:
			case UNDEFSTRVAR:
			case VAR:
			case UNDEFVAR:
			case PARAM:
			case FUNCSYM:
			case PROCSYM:
				if (strcmp(sp->name, name) != 0 && !all) {
					break;
				}
			case VEC:
			case UNDEFVEC:
				if (strcmp(sp->name, name) != 0 && !allvec) {
					break;
				}
				found = 1;
				spresent = sp;
				if (spresent == symlist) {  /* first one ? */
					symlist = sp->next;
					sp = sp->next;
				}
				else {
					sprevious->next = sp->next;
					sp = sp->next;
				}
				free(spresent->name);
				if (spresent->type == VEC || spresent->type == UNDEFVEC
				|| spresent->type == PARAM) {
					Ft_free_dvector(spresent->u.vec, 1, spresent->size.val);
				}
				if (spresent->type == STRVAR || spresent->type == STRCONST ||
				spresent->type == UNDEFSTRVAR) {
					if (spresent->u.str)
						free(spresent->u.str);
				}
				free((char *)spresent);
				continue;
		default:
			if (strcmp(sp->name, name) == 0) {
				fprintf(stderr,
				"%s: Not allowed to remove built-in definitions.\n", name);
				return(ERRR);
			}
			break;
		}
		sprevious = sp;
		sp = sp->next;
	}

	if (!found && verb) {
		fprintf(stderr, "%s: No such variable.\n", name);
		return(ERRR);
	}
	return(0);
}

#ifndef NOMALLINFO
int Ft_showmem(void)
{
	struct mallinfo mal;

	mal = mallinfo();
	fprintf(stderr, "%28s: %d\n", "Arena", mal.arena);
	fprintf(stderr, "%28s: %d\n", "Number of ordinary blocks", mal.ordblks);
	fprintf(stderr, "%28s: %d\n", "Ordinary block space in use", mal.uordblks);
	fprintf(stderr, "%28s: %d\n", "Ordinary block space free", mal.fordblks);
	fprintf(stderr, "%28s: %d\n", "Number of small blocks", mal.smblks);
	fprintf(stderr, "%28s: %d\n", "Small block space in use", mal.usmblks);
	fprintf(stderr, "%28s: %d\n", "Small block space free", mal.fsmblks);
	fprintf(stderr, "%28s: %d\n", "Number of holding blocks", mal.hblks);
	fprintf(stderr, "%28s: %d\n", "Block header space", mal.hblkhd);
	fprintf(stderr, "%28s: %d\n", "Keepcost space", mal.keepcost);
	return(0);
}
#endif

int Ft_lock(int i, char *name, char *fname)  /* lock on 1, unlock on 0  */
{
	static char *vnam[] = {"constant", "variable", 0};
	static int type[] = {CONST, VAR, 0};
	static int bltintype[] = {BLTINCONST, BLTINVAR, 0};
	static int strtype[] = {STRCONST, STRVAR, 0};
	static int bltinstrtype[] = {BLTINSTRCONST, BLTINSTRVAR, 0};
	Symbol *sp;

	if ((sp = Ft_lookup(name)) == 0) {
		if (i) {
			fprintf(stderr, "%s: %s: No such variable or constant.\n",
			fname, name);
			return(ERRR);
		}
		fprintf(stderr, "Warning: %s: %s: No such variable or constant.\n",
		fname, name);
		return(0);
	}
	if (sp->type == type[i]) {
		sp->type = type[!i];
	}
	else if (sp->type == bltintype[i]) {
		sp->type = bltintype[!i];
	}
	else if (sp->type == strtype[i]) {
		sp->type = strtype[!i];
	}
	else if (sp->type == bltinstrtype[i]) {
		sp->type = bltinstrtype[!i];
	}
	else if (sp->type == type[!i] || sp->type == strtype[!i] ||
	sp->type == bltintype[!i] || sp->type == bltinstrtype[!i]) {
		fprintf(stderr, "Warning: %s: %s: Already a %s.\n",
		fname, name, vnam[!i]);
	}
	else {
		fprintf(stderr, "%s: %s: Not a regular variable.\n", fname, name);
	}
	return(0);
}

char *Ft_var_generator(char *text, int state)
{
	static int len;
	static Symbol *smp;
	register Symbol *sp;
	register int tp;
	char *fname;
	extern int Ft_Mode;

	if (state == 0) {
		smp = symlist;
		len = strlen(text);
	}
	while (smp != (Symbol *)0) {
		sp = smp;
		smp = smp->next;
		tp = sp->type;
		if (tp == STRING)
			continue;
		/* the following line depends on the order in parse.y */
		if (Ft_Mode == FMODE && (tp < VAR || tp > BLTINSTRCONST))
			continue;
		if (strncmp(sp->name, text, len) == 0) {
			if ((fname = (char *) malloc(strlen(sp->name)+1)) == NULL) {
				fputs("Allocation error in var_gen.\n", stderr);
				Ft_catcher(ERRR);
			}
			strcpy(fname, sp->name);
			return(fname);
		}
	}
	return(NULL);
}

int Ft_cleansym(void)
{
	Symbol *sp, *sprevious;
	Symbol *spresent;
	extern void Ft_free_dvector(double *v, int nl, int nh);

	sprevious = sp = symlist;
	while (sp != (Symbol *)0) {
		if (sp->type == UNDEFVEC || sp->type == UNDEFVAR ||
			sp->type == UNDEFSTRVAR) {
			spresent = sp;
			if (spresent == symlist) {  /* first one ? */
				symlist = sp->next;
				sp = sp->next;
			}
			else {
				sprevious->next = sp->next;
				sp = sp->next;
			}
			free(spresent->name);
			if (spresent->type == UNDEFVEC) {
				Ft_free_dvector(spresent->u.vec, 1, spresent->size.val);
			}
			if (spresent->type == UNDEFSTRVAR) {
				if (spresent->u.str)
					free(spresent->u.str);
			}
			free((char *)spresent);
			continue;
		}
		sprevious = sp;
		sp = sp->next;
	}
	return(0);
}

