/*
 * Electric(tm) VLSI Design System
 *
 * File: dblang.c
 * Interpretive language interface module
 * Written by: Steven M. Rubin, Static Free Software
 *
 * Copyright (c) 2000 Static Free Software.
 *
 * Electric(tm) is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * Electric(tm) 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 Electric(tm); see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, Mass 02111-1307, USA.
 *
 * Static Free Software
 * 4119 Alpine Road
 * Portola Valley, California 94028
 * info@staticfreesoft.com
 */

#include "global.h"
#include "database.h"
#include "dblang.h"

#define EVALUATIONCACHESIZE 10
typedef struct
{
	UINTBIG  changetimestamp;
	UINTBIG  traversaltimestamp;
	char    *code;
	UINTBIG  type;
	INTBIG   value;
} EVALUATIONCACHE;

static EVALUATIONCACHE db_evaluationcache[EVALUATIONCACHESIZE];
static INTBIG db_evaluationcachesize = 0;
static INTBIG db_evaluationcachelast = 0;

/* prototypes for local routines */
static void db_enterqueryincache(char *code, INTBIG type, INTBIG value);

/****************************** LANGUAGE INTERFACE ******************************/

/*
 * routine to return a string describing the currently available languages
 */
char *languagename(void)
{
	char *pt;

	(void)initinfstr();
#if	LANGJAVA
	(void)addstringtoinfstr(", Java");
#endif
#if LANGLISP
	(void)addstringtoinfstr(", ELK Lisp");
#endif
#if LANGTCL
	(void)addstringtoinfstr(", TCL ");
	(void)addstringtoinfstr(TCL_PATCH_LEVEL);
#endif
	pt = returninfstr();
	if (*pt == 0) return(NOSTRING);
	return(&pt[2]);
}

/*
 * routine to load the code in the file "program" into the language interpreter
 * specified by "language".  Returns true on error.
 */
BOOLEAN loadcode(char *program, INTBIG language)
{
#if LANGTCL
	REGISTER INTBIG code;
#endif

	switch (language)
	{
#if LANGLISP
		case VLISP:
			lsp_init();
			(void)General_Load(Make_String(program, strlen(program)), The_Environment);
			return(FALSE);
#endif

#if LANGTCL
		case VTCL:
			code = Tcl_EvalFile(tcl_interp, program);
			if (code != TCL_OK)
				ttyputerr("%s", tcl_interp->result);
			break;
#endif

#if LANGJAVA
		case VJAVA:
			ttyputerr(_("Unable to load code into Java"));
			break;
#endif
	}
	return(TRUE);
}

/*
 * routine to evaluate string "code" in the specified "language" and return the
 * evaluation in "retval" to match type "type" (which may get changed, depending on
 * the results of the evaluation).  The routine returns true on error.
 */
BOOLEAN doquerry(char *code, INTBIG language, UINTBIG *type, INTBIG *retval)
{
#if LANGTCL
	INTBIG result;
#endif
#if LANGLISP
	ELKObject obj;
#endif
#if LANGJAVA
	char *str;
	INTBIG methodreturntype;
#endif
#if	LANGMM
	char *str;
	static INTBIG retarray[1];
	long ival;
	double fval;
#endif
	REGISTER INTBIG i, index;

	/* search cache of evaluations */
	for(i=0; i<db_evaluationcachesize; i++)
	{
		index = db_evaluationcachelast - i - 1;
		if (index < 0) index += EVALUATIONCACHESIZE;
		if (db_evaluationcache[index].changetimestamp != db_changetimestamp) continue;
		if (db_evaluationcache[index].traversaltimestamp != db_traversaltimestamp) continue;
		if (strcmp(db_evaluationcache[index].code, code) != 0) continue;
		if (db_evaluationcache[index].type != *type) continue;

		/* found in cache: return value */
		*retval = db_evaluationcache[index].value;
		return(FALSE);
	}

	switch (language)
	{
#if LANGLISP
		case VLISP:
			/* make sure Lisp is initialized */
			lsp_init();

			/* convert the string to a Lisp form */
			obj = lsp_makeobject(code);
			if (EQ(obj, Eof)) break;

			/* evaluate the string */
			obj = Eval(obj);

			/* convert the evaluation to a string */
			if (lsp_describeobject(obj, *type, retval)) return(TRUE);
			db_enterqueryincache(code, *type, *retval);
			return(FALSE);
#endif

#if LANGTCL
		case VTCL:
			/* evaluate the string */
			result = Tcl_Eval(tcl_interp, code);
			if (result != TCL_OK)
			{
				ttyputerr("%s", tcl_interp->result);
				return(TRUE);
			}

			/* convert the result to the desired type */
			*retval = tcl_converttoelectric(tcl_interp->result, *type);
			db_enterqueryincache(code, *type, *retval);
			return(FALSE);
#endif

#if LANGJAVA
		case VJAVA:
			/* evaluate the string */
			java_init();
			str = java_query(code, &methodreturntype);
			if (str == 0) return(TRUE);
			getsimpletype(str, &methodreturntype, retval);
			*type = ((*type) & ~VTYPE) | (methodreturntype & VTYPE);
			db_enterqueryincache(code, *type, *retval);
			return(FALSE);
#endif

#if LANGMM
		case VMATHEMATICA:
			/* make sure Mathematica is initialized */
			if (db_mathematicainit() != 0) break;

			/* send the string to Mathematica */
			MLPutFunction(db_mathematicalink, "EvaluatePacket", 1);
				MLPutFunction(db_mathematicalink, "ToExpression",1);
					MLPutString(db_mathematicalink, code);
			MLEndPacket(db_mathematicalink);
			if (MLError(db_mathematicalink) != MLEOK)
			{
				ttyputerr("Mathematica error: %s", MLErrorMessage(db_mathematicalink));
				break;
			}

			/* get the return expression */
			db_mathematicaprocesspackets(0);
			switch ((*type)&VTYPE)
			{
				case VSTRING:
					(void)initinfstr();
					(void)db_mathematicagetstring(0);
					*retval = (INTBIG)returninfstr();
					break;

				case VINTEGER:
				case VSHORT:
				case VADDRESS:
					switch (MLGetType(db_mathematicalink))
					{
						case MLTKSTR:
							MLGetString(db_mathematicalink, &str);
							*retval = myatoi(str);
							break;
						case MLTKINT:
							MLGetLongInteger(db_mathematicalink, &ival);
							*retval = ival;
							break;
						case MLTKREAL:
							MLGetReal(db_mathematicalink, &fval);
							*retval = fval;
							break;
						default:
							MLNewPacket(db_mathematicalink);
							return(TRUE);
					}
					break;

				case VFLOAT:
				case VDOUBLE:
					switch (MLGetType(db_mathematicalink))
					{
						case MLTKSTR:
							MLGetString(db_mathematicalink, &str);
							*retval = castint((float)myatoi(str));
							break;
						case MLTKINT:
							MLGetLongInteger(db_mathematicalink, &ival);
							*retval = castint((float)ival);
							break;
						case MLTKREAL:
							MLGetReal(db_mathematicalink, &fval);
							*retval = castint((float)fval);
							break;
						default:
							MLNewPacket(db_mathematicalink);
							return(TRUE);
					}
					break;

				case VFRACT:
					switch (MLGetType(db_mathematicalink))
					{
						case MLTKSTR:
							MLGetString(db_mathematicalink, &str);
							*retval = myatoi(str) * WHOLE;
							break;
						case MLTKINT:
							MLGetLongInteger(db_mathematicalink, &ival);
							*retval = ival * WHOLE;
							break;
						case MLTKREAL:
							MLGetReal(db_mathematicalink, &fval);
							*retval = fval * WHOLE;
							break;
						default:
							MLNewPacket(db_mathematicalink);
							return(TRUE);
					}
					break;

				default:
					MLNewPacket(db_mathematicalink);
					return(TRUE);
			}

			if (((*type)&VISARRAY) != 0)
			{
				retarray[0] = *retval;
				*retval = (INTBIG)retarray;
			}
			db_enterqueryincache(code, *type, *retval);
			return(FALSE);
#endif
	}
	return(TRUE);
}

/*
 * language interpreter.  Called the first time with "language" set to the desired
 * interpreter.  On repeated calls, "language" is zero.  Returns true when
 * termination is requested
 */
BOOLEAN languageconverse(INTBIG language)
{
	static INTBIG curlang;
#if LANGTCL
	static BOOLEAN gotPartial;
	char *cmd, *tstr, *promptCmd;
	REGISTER INTBIG code;
	static Tcl_DString command;
	Tcl_Obj *objv[3];
#endif
#if LANGLISP
	ELKObject pred;
#endif
#if LANGMM
	char *mstr;
#endif
#if LANGJAVA
	char *jstr;
#endif

	/* on the first call, initialize the interpreter */
	if (language != 0)
	{
		curlang = language;
		switch (curlang)
		{
			case VLISP:
#if LANGLISP
				ttyputmsg(_("ELK Lisp 3.0, type %s to quit"), getmessageseofkey());
				lsp_init();
#else
				ttyputerr(_("LISP Interpreter is not installed"));
				return(TRUE);
#endif
				break;

			case VTCL:
#if LANGTCL
				ttyputmsg(_("TCL Interpreter, type %s to quit"), getmessageseofkey());
				Tcl_DStringInit(&command);
#else
				ttyputerr(_("TCL Interpreter is not installed"));
				return(TRUE);
#endif
				break;

			case VJAVA:
#if LANGJAVA
				jstr = java_init();
				if (jstr == 0) return(TRUE);
				ttyputmsg(_("%s Interpreter, type %s to quit"), jstr, getmessageseofkey());
#else
				ttyputerr(_("Java Interpreter is not installed"));
				return(TRUE);
#endif
				break;

#if LANGMM
			case VMATHEMATICA:
				if (db_mathematicainit() != 0) return(TRUE);
				ttyputmsg(_("Mathematica reader, type %s to quit"), getmessageseofkey());
				break;
#endif
		}
	}

	switch (curlang)
	{
#if LANGLISP
		case VLISP:
			pred = Eval(Intern("the-top-level"));
			(void)Funcall(pred, Null, 0);
			break;
#endif

#if LANGTCL
		case VTCL:
			promptCmd = Tcl_GetVar(tcl_interp, (char *)(gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
				TCL_GLOBAL_ONLY);
			if (promptCmd != NULL)
			{
				code = Tcl_Eval(tcl_interp, promptCmd);
				if (code != TCL_OK)
				{
					ttyputerr("%s (script that generates prompt)", tcl_interp->result);
					promptCmd = NULL;
				}
			}
			if (promptCmd == NULL && !gotPartial)
			{
				objv[1] = Tcl_NewStringObj("-nonewline", -1);
				objv[2] = Tcl_NewStringObj("% ", -1);
				Tcl_PutsObjCmd(0, tcl_interp, 3, objv);
			}

			/* get input using queued output as prompt */
			*tcl_outputloc = 0;
			tstr = ttygetlinemessages(tcl_outputbuffer);
			tcl_outputloc = tcl_outputbuffer;
			if (tstr == 0) return(TRUE);

			/* evaluate and print result */
			cmd = Tcl_DStringAppend(&command, tstr, -1);
			if ((tstr[0] != 0) && !Tcl_CommandComplete(cmd))
			{
				gotPartial = TRUE;
				return(FALSE);
			}
			gotPartial = FALSE;
			code = Tcl_RecordAndEval(tcl_interp, cmd, 0);
			Tcl_DStringFree(&command);
			if (code != TCL_OK)
			{
				ttyputerr("%s", tcl_interp->result);
			} else if (*tcl_interp->result != 0)
			{
				ttyputmsg("%s", tcl_interp->result);
			}
			return(FALSE);
#endif

#if LANGJAVA
		case VJAVA:
			jstr = ttygetlinemessages("> ");
			if (jstr == 0) return(TRUE);

			/* send the string to Java */
			if (java_evaluate(jstr)) return(TRUE);
			return(FALSE);
#endif

#if LANGMM
		case VMATHEMATICA:
			mstr = ttygetlinemessages("> ");
			if (mstr == 0) return(TRUE);

			/* send the string to Mathematica */
			MLPutFunction(db_mathematicalink, "ToExpression", 1);
				MLPutString(db_mathematicalink, mstr);
			MLEndPacket(db_mathematicalink);

			if (MLError(db_mathematicalink) != MLEOK)
			{
				ttyputerr(_("Mathematica error: %s"), MLErrorMessage(db_mathematicalink));
				return(TRUE);
			}

			/* handle the result */
			db_mathematicaprocesspackets(1);
			return(FALSE);
#endif
	}
	return(TRUE);
}

/*
 * Routine to enter code "code" which returns "value" of type "type" into the
 * cache of evaluations.
 */
void db_enterqueryincache(char *code, INTBIG type, INTBIG value)
{
	if (db_evaluationcachelast < db_evaluationcachesize)
	{
		efree((char *)db_evaluationcache[db_evaluationcachelast].code);
		if ((db_evaluationcache[db_evaluationcachelast].type&VTYPE) == VSTRING)
			efree((char *)db_evaluationcache[db_evaluationcachelast].value);
	}
	db_evaluationcache[db_evaluationcachelast].changetimestamp = db_changetimestamp;
	db_evaluationcache[db_evaluationcachelast].traversaltimestamp = db_traversaltimestamp;
	(void)allocstring(&db_evaluationcache[db_evaluationcachelast].code, code, db_cluster);
	db_evaluationcache[db_evaluationcachelast].type = type;
	if ((type&VTYPE) == VSTRING)
	{
		(void)allocstring((char **)&db_evaluationcache[db_evaluationcachelast].value,
			(char *)value, db_cluster);
	} else
	{
		db_evaluationcache[db_evaluationcachelast].value = value;
	}
	db_evaluationcachelast++;
	if (db_evaluationcachelast > db_evaluationcachesize)
		db_evaluationcachesize = db_evaluationcachelast;
	if (db_evaluationcachelast >= EVALUATIONCACHESIZE)
		db_evaluationcachelast = 0;
}

/*
 * routine called to shutdown interpreter when the program exits
 */
void db_termlanguage(void)
{
	REGISTER INTBIG i;

	for(i=0; i<db_evaluationcachesize; i++)
	{
		efree((char *)db_evaluationcache[i].code);
		if ((db_evaluationcache[i].type&VTYPE) == VSTRING)
			efree((char *)db_evaluationcache[i].value);
	}
#if LANGMM
	if (db_mathematicalink != NULL)
	{
		MLPutFunction(db_mathematicalink, "Exit", 0);
		MLEndPacket(db_mathematicalink);
		MLClose(db_mathematicalink);
	}
#endif
#if LANGJAVA
	java_freememory();
#endif
}
