#include <stdlib.h>

#include <string.h>

#include <math.h>

#include <xexpr.h>

#include "xexprprivate.h"

/**

 * SECTION:xexprtypes

 * @short_description: Types defined in libxexpr

 * @stability: Stable

 * @include: libxexpr/xexpr.h

 *

 * The various types defined in libxexpr and the functions that support them.

 */

static XexprEnvironment *xexpr_environment_new(const char *function,

  XexprEnvironment *outer);

/**

 * xexpr_binding_free:

 * @binding: an #XexprBinding

 *

 * Frees the memory allocated for the #XexprBinding.

 */

void xexpr_binding_free(XexprBinding *binding)

{

    g_free(binding->id);

    xexpr_constant_free(binding->value);

    g_slice_free(XexprBinding,binding);

}

/**

 * xexpr_environment_free:

 * @environment: an #XexprEnvironment

 *

 * Frees the memory allocated for the #XexprEnvironment.

 */

static void xexpr_environment_free(XexprEnvironment *environment)

{

    g_warn_if_fail(environment->refcount==1);

    if (environment->outer)

	environment->outer->refcount--;

    g_free(environment->function);

    g_slist_foreach(environment->bindings,(GFunc)xexpr_binding_free,NULL);

    g_slist_free(environment->bindings);

    g_slice_free(XexprEnvironment,environment);

}

/*

 * xexpr_invocation_free:

 * @invocation: an #XexprInvocation

 *

 * Frees the memory allocated for the #XexprInvocation.

 */

static void xexpr_invocation_free(XexprInvocation *invocation)

{

    g_free(invocation->function);

    g_slist_foreach(invocation->bindings,(GFunc)xexpr_binding_free,NULL);

    g_slist_free(invocation->bindings);

    g_slist_foreach(invocation->constants,(GFunc)xexpr_constant_free,NULL);

    g_slist_free(invocation->constants);

    g_slice_free(XexprInvocation,invocation);

}

/*

 * xexpr_function_free:

 * @function: an #XexprFunction

 *

 * Frees the memory allocated for the #XexprFunction.

 */

static void xexpr_function_free(XexprFunction *function)

{

    g_slist_foreach(function->args,(GFunc)g_free,NULL);

    g_slist_free(function->args);

    g_slist_foreach(function->constants,(GFunc)xexpr_constant_free,NULL);

    g_slist_free(function->constants);

    g_slice_free(XexprFunction,function);

}

/**

 * xexpr_constant_free:

 * @constant: an #XexprConstant

 *

 * Frees the memory allocated for the #XexprConstant.

 */

void xexpr_constant_free(XexprConstant *constant)

{

    switch(constant->type)

    {

	case XEXPR_TYPE_INVOCATION:

	    xexpr_invocation_free(constant->u.invocation);

	    break;

	case XEXPR_TYPE_FUNCTION:

	    xexpr_function_free(constant->u.function);

	    break;

	case XEXPR_TYPE_STRING:

	    g_free(constant->u.string);

	    break;

	case XEXPR_TYPE_INTEGER:

	case XEXPR_TYPE_NUMBER:

	    break;

    }

    g_slice_free(XexprConstant,constant);

}

/**

 * xexpr_free:

 * @xexpr: an #Xexpr

 *

 * Frees the memory allocated for the #Xexpr.

 */

void xexpr_free(Xexpr *xexpr)

{

    g_slist_foreach(xexpr->tracing,(GFunc)g_free,NULL);

    g_slist_free(xexpr->tracing);

    g_slist_foreach(xexpr->constants,(GFunc)xexpr_constant_free,NULL);

    g_slist_free(xexpr->constants);

    g_slice_free(Xexpr,xexpr);

}

/**

 * xexpr_new:

 *

 * Creates a new #Xexpr.

 *

 * Returns: the new #Xexpr

 */

Xexpr *xexpr_new(void)

{

    xexpr_register_extension(NULL);

    return g_slice_new0(Xexpr);

}

/**

 * xexpr_sub:

 * @xexpr: an #Xexpr to copy the initial options from

 *

 * Creates a new #Xexpr, copying options from @xexpr.

 *

 * Returns: the new #Xexpr

 */

Xexpr *xexpr_sub(Xexpr *xexpr)

{

    GSList *lnk;

    Xexpr *sub=xexpr_new();

    sub->tracing=g_slist_copy(xexpr->tracing);

    for(lnk=sub->tracing;lnk;lnk=lnk->next)

	lnk->data=g_strdup(lnk->data);

    return sub;

}

/**

 * xexpr_is_tracing:

 * @xexpr: an #Xexpr

 * @id: the symbol to test for

 *

 * Checks if a symbol is currently being traced, returning %TRUE if it is.

 *

 * Returns: %TRUE if @id is being traced

 */

gboolean xexpr_is_tracing(Xexpr *xexpr,const char *id)

{

    return !!g_slist_find_custom(xexpr->tracing,id,(GCompareFunc)g_strcmp0);

}

/**

 * xexpr_start_tracing:

 * @xexpr: an #Xexpr

 * @id: the symbol to trace

 *

 * Adds @id to the set of symbols to trace.

 *

 * When variables with the name of a traced symbol are created or changed,

 * the evaluator will output a suitable tracing message and a stack dump.

 *

 * <example>

 *   <title>Example Tracing Output</title>

 *   <screen>

 *     Created new variable x in frame \#0

 *     \#0  test1 (x = <nil/>)

 *     \#1  eq ()

 *     \#2  if ()

 *     \#3  and ()

 *     \#4  expr ()

 *     

 *     Set variable x

 *     \#0  test1 (x = <integer>1</integer>)

 *     \#1  eq ()

 *     \#2  if ()

 *     \#3  and ()

 *     \#4  expr ()

 *   </screen>

 * </example>

 */

void xexpr_start_tracing(Xexpr *xexpr,const char *id)

{

    if (!xexpr_is_tracing(xexpr,id))

	xexpr->tracing=g_slist_prepend(xexpr->tracing,g_strdup(id));

}

/**

 * xexpr_get_environment:

 * @xexpr: an #Xexpr

 *

 * Gets the #XexprEnvironment of the given #Xexpr.

 *

 * Returns: (transfer none): the innermost environment

 */

XexprEnvironment *xexpr_get_environment(Xexpr *xexpr)

{

    if (!xexpr->environment)

	xexpr->environment=xexpr_environment_new(NULL,NULL);

    return xexpr->environment;

}

/**

 * xexpr_set_constants_take_ownership:

 * @xexpr: an #Xexpr

 * @constants: (transfer full) (element-type XexprConstant): A list of 

 *   constants to use, replacing any existing constants

 *

 * Sets the list of constants which make up the expression.

 */

void xexpr_set_constants_take_ownership(Xexpr *xexpr,GSList *constants)

{

    g_slist_foreach(xexpr->constants,(GFunc)xexpr_constant_free,NULL);

    g_slist_free(xexpr->constants);

    xexpr->constants=constants;

}

/**

 * xexpr_set_constants:

 * @xexpr: an #Xexpr

 * @constants: (transfer none) (element-type XexprConstant): A list of 

 *   constants to use, replacing any existing constants

 *

 * Sets the list of constants which make up the expression.

 */

void xexpr_set_constants(Xexpr *xexpr,GSList *constants)

{

    GSList *lnk,*copy=NULL;

    for(lnk=constants;lnk;lnk=lnk->next)

	copy=g_slist_prepend(copy,xexpr_constant_dup(lnk->data));

    copy=g_slist_reverse(copy);

    xexpr_set_constants_take_ownership(xexpr,copy);

}

void _xexpr_push_environment(Xexpr *xexpr,const char *id)

{

    xexpr->environment=xexpr_environment_new(id,xexpr_get_environment(xexpr));

}

void _xexpr_pop_environment(Xexpr *xexpr)

{

    XexprEnvironment *outer=xexpr->environment->outer;

    if (outer)

    {

	xexpr_environment_free(xexpr->environment);

	xexpr->environment=outer;

    }

}

/**

 * xexpr_new_invocation_take_ownership:

 * @ns: (transfer full): the namespace to which @function belongs, or %NULL

 * @function: (transfer full): the name of the function to be invoked

 * @bindings: (transfer full) (element-type XexprBinding): the pre-bound

 *   arguments

 * @constants: (transfer full) (element-type XexprConstant): the other

 *   arguments

 *

 * Create a new #XexprConstant that invokes @function with pre-bound arguments

 * @bindings and with @constants as further arguments. Functions with named

 * parameters will use the pre-bound arguments first if present, otherwise

 * the other arguments will be bound to the unbound parameters as needed.

 *

 * @ns should be %NULL, the empty string or %XEXPR_NS for XEXPR functions.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_invocation_take_ownership(char *ns,char *function,

  GSList *bindings,GSList *constants)

{

    XexprConstant *constant;

    constant=g_slice_new(XexprConstant);

    constant->type=XEXPR_TYPE_INVOCATION;

    constant->u.invocation=g_slice_new(XexprInvocation);

    if (ns && (!*ns || !strcmp(ns,XEXPR_NS)))

    {

	g_free(ns);

	ns=NULL;

    }

    constant->u.invocation->ns=ns;

    constant->u.invocation->function=function;

    constant->u.invocation->bindings=bindings;

    constant->u.invocation->constants=constants;

    return constant;

}

/**

 * xexpr_new_invocation:

 * @ns: (transfer none): the namespace to which @function belongs, or %NULL

 * @function: (transfer none): the name of the function to be invoked

 * @bindings: (transfer none) (element-type XexprBinding): the pre-bound

 *   arguments

 * @constants: (transfer none) (element-type XexprConstant): the other

 *   arguments

 *

 * Create a new #XexprConstant that invokes @function with pre-bound arguments

 * @bindings and with @constants as further arguments. Functions with named

 * parameters will use the pre-bound arguments first if present, otherwise

 * the other arguments will be bound to the unbound parameters as needed.

 *

 * @ns should be %NULL, the empty string or %XEXPR_NS for XEXPR functions.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_invocation(const char *ns,const char *function,

  GSList *bindings,GSList *constants)

{

    GSList *list,*lnk;

    list=g_slist_copy(constants);

    for(lnk=list;lnk;lnk=lnk->next)

	lnk->data=xexpr_constant_dup(lnk->data);

    if (ns && (!*ns || !strcmp(ns,XEXPR_NS)))

	ns=NULL;

    return xexpr_new_invocation_take_ownership(g_strdup(ns),g_strdup(function),

      xexpr_bindings_dup(bindings),list);

}

/**

 * xexpr_new_function_take_ownership:

 * @args: (transfer full) (element-type utf8): the parameter names

 * @constants: (transfer full) (element-type XexprConstant): the constants

 *   which will be evaluated when the function is invoked

 *

 * Create a new #XexprConstant that defines an unnamed function. Creating a

 * function definition is the first step in defining a function. The second

 * step is to bind the definition to a name, eg., using xexpr_var_new().

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_function_take_ownership(GSList *args,GSList *constants)

{

    XexprConstant *constant;

    constant=g_slice_new(XexprConstant);

    constant->type=XEXPR_TYPE_FUNCTION;

    constant->u.function=g_slice_new(XexprFunction);

    constant->u.function->args=args;

    constant->u.function->constants=constants;

    return constant;

}

/**

 * xexpr_new_function:

 * @args: (transfer none) (element-type utf8): the parameter names

 * @constants: (transfer none) (element-type XexprConstant): the constants

 *   which will be evaluated when the function is invoked

 *

 * Create a new #XexprConstant that defines an unnamed function. Creating a

 * function definition is the first step in defining a function. The second

 * step is to bind the definition to a name, eg., using xexpr_var_new().

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_function(GSList *args,GSList *constants)

{

    GSList *lnk;

    args=g_slist_copy(args);

    for(lnk=args;lnk;lnk=lnk->next)

	lnk->data=g_strdup(lnk->data);

    constants=g_slist_copy(constants);

    for(lnk=constants;lnk;lnk=lnk->next)

	lnk->data=xexpr_constant_dup(lnk->data);

    return xexpr_new_function_take_ownership(args,constants);

}

/**

 * xexpr_new_string_take_ownership:

 * @s: (transfer full): the string

 *

 * Create a new #XexprConstant that consists of the given string.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_string_take_ownership(char *s)

{

    XexprConstant *constant;

    constant=g_slice_new(XexprConstant);

    constant->type=XEXPR_TYPE_STRING;

    constant->u.string=s;

    return constant;

}

/**

 * xexpr_new_string:

 * @s: (transfer none): the string

 * @len: length of @s to use, or -1 to treat @s as nul-terminated

 *

 * Create a new #XexprConstant that consists of the given string.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_string(const char *s,gssize len)

{

    if (len<0)

	len=strlen(s);

    return xexpr_new_string_take_ownership(g_strndup(s,len));

}

/**

 * xexpr_new_integer:

 * @integer: the integer

 *

 * Create a new #XexprConstant that consists of the given integer.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_integer(long long int integer)

{

    XexprConstant *constant;

    constant=g_slice_new(XexprConstant);

    constant->type=XEXPR_TYPE_INTEGER;

    constant->u.integer=integer;

    return constant;

}

/**

 * xexpr_new_number:

 * @number: the number

 *

 * Create a new #XexprConstant that consists of the given floating-point number.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_new_number(double number)

{

    XexprConstant *constant;

    constant=g_slice_new(XexprConstant);

    constant->type=XEXPR_TYPE_NUMBER;

    constant->u.number=number;

    return constant;

}

static XexprEnvironment *xexpr_environment_new(const char *function,

  XexprEnvironment *outer)

{

    XexprEnvironment *environment=g_slice_new0(XexprEnvironment);

    environment->function=g_strdup(function);

    environment->refcount=1;

    environment->outer=outer;

    if (outer)

	outer->refcount++;

    return environment;

}

/**

 * xexpr_environment_foreach:

 * @environment: an #XexprEnvironment

 * @func: the function to call with each active variable

 * @user_data: user data to pass to the function

 *

 * Calls a function for each active variable in an #XexprEnvironment.

 */

void xexpr_environment_foreach(XexprEnvironment *environment,GTraverseFunc func,

  gpointer user_data)

{

    GSList *lnk;

    GSList *environments=NULL;

    GTree *active;

    XexprBinding *binding;

    while(environment)

    {

	environments=g_slist_prepend(environments,environment);

	environment=environment->outer;

    }

    active=g_tree_new((GCompareFunc)strcmp);

    while(environments)

    {

	environment=environments->data;

	environments=g_slist_delete_link(environments,environments);

	for(lnk=environment->bindings;lnk;lnk=lnk->next)

	{

	    binding=lnk->data;

	    g_tree_insert(active,binding->id,binding->value);

	}

    }

    g_tree_foreach(active,func,user_data);

    g_tree_destroy(active);

}

/**

 * xexpr_bindings_get:

 * @bindings: (transfer none) (element-type XexprBinding): the bindings to

 *   search

 * @id: the symbol to search for

 *

 * Look for a binding of symbol @id in @bindings and return the value if

 * found.

 *

 * Returns: (transfer none): the found #XexprConstant or %NULL

 */

XexprConstant *xexpr_bindings_get(GSList *bindings,const char *id)

{

    GSList *lnk;

    XexprBinding *binding;

    for(lnk=bindings;lnk;lnk=lnk->next)

    {

	binding=lnk->data;

	if (!strcmp(binding->id,id))

	    return binding->value;

    }

    return NULL;

}

/**

 * xexpr_bindings_set:

 * @bindings: (transfer none) (element-type XexprBinding): the bindings to

 *   update

 * @id: an existing symbol to set

 * @value: (transfer none): the new value

 *

 * Update an existing binding of symbol @id in @bindings with the new value

 * @value. If no existing binding is found, return %FALSE.

 *

 * Returns: %TRUE if @id was found and updated

 */

gboolean xexpr_bindings_set(GSList *bindings,const char *id,

  XexprConstant *value)

{

    GSList *lnk;

    XexprBinding *binding;

    for(lnk=bindings;lnk;lnk=lnk->next)

    {

	binding=lnk->data;

	if (!strcmp(binding->id,id))

	{

	    xexpr_constant_free(binding->value);

	    binding->value=xexpr_constant_dup(value);

	    return TRUE;

	}

    }

    return FALSE;

}

/**

 * xexpr_bindings_new:

 * @bindings: (transfer full) (element-type XexprBinding): the bindings to

 *   modify

 * @id: a symbol to set or create

 * @value: (transfer none): the new value

 *

 * Update an existing binding of symbol @id or create a new one in @bindings

 * with the new value @value.

 *

 * Returns: (transfer full) (element-type XexprBinding): the new bindings list

 */

GSList *xexpr_bindings_new(GSList *bindings,const char *id,XexprConstant *value)

{

    XexprBinding *binding;

    if (!xexpr_bindings_set(bindings,id,value))

    {

	binding=g_slice_new(XexprBinding);

	binding->id=g_strdup(id);

	binding->value=xexpr_constant_dup(value);

	bindings=g_slist_prepend(bindings,binding);

    }

    return bindings;

}

/**

 * xexpr_var_get:

 * @xexpr: an #Xexpr

 * @id: a symbol to look up

 *

 * Look for a definition of symbol @id in @xexpr and return its value. If

 * no definition exists, return %NULL.

 *

 * Returns: (transfer none): the bound value, or %NULL if not found.

 */

XexprConstant *xexpr_var_get(Xexpr *xexpr,const char *id)

{

    XexprConstant *value=NULL;

    XexprEnvironment *environment=xexpr_get_environment(xexpr);

    while(environment && !value)

    {

	value=xexpr_bindings_get(environment->bindings,id);

	environment=environment->outer;

    }

    return value;

}

/**

 * xexpr_var_new:

 * @xexpr: an #Xexpr

 * @id: a symbol to set or create

 * @value: (transfer none): the new value

 *

 * Update an existing binding of symbol @id in the innermost environment of

 * @xexpr or create a new one with the new value @value.

 */

void xexpr_var_new(Xexpr *xexpr,const char *id,XexprConstant *value)

{

    XexprEnvironment *environment=xexpr_get_environment(xexpr);

    environment->bindings=xexpr_bindings_new(environment->bindings,id,value);

    if (xexpr_is_tracing(xexpr,id))

    {

	printf("\nCreated new variable %s in frame #0\n",id);

	xexpr_stack_dump(xexpr,stdout);

    }

}

/**

 * xexpr_var_set:

 * @xexpr: an #Xexpr

 * @id: a symbol to set or create

 * @value: (transfer none): the new value

 *

 * Update the active binding of symbol @id in @xexpr if such exists or create 

 * create a new one in the outermost environment with the new value @value.

 */

void xexpr_var_set(Xexpr *xexpr,const char *id,XexprConstant *value)

{

    XexprEnvironment *environment=xexpr_get_environment(xexpr);

    while(environment)

    {

	if (xexpr_bindings_set(environment->bindings,id,value))

	{

	    if (xexpr_is_tracing(xexpr,id))

	    {

		printf("\nSet variable %s\n",id);

		xexpr_stack_dump(xexpr,stdout);

	    }

	    return;

	}

	if (environment->outer)

	    environment=environment->outer;

	else

	    break;

    }

    environment->bindings=xexpr_bindings_new(environment->bindings,id,value);

    if (xexpr_is_tracing(xexpr,id))

    {

	printf("\nCreated new global variable %s\n",id);

	xexpr_stack_dump(xexpr,stdout);

    }

}

/**

 * xexpr_constant_dup:

 * @constant: an #XexprConstant to duplicate

 *

 * Duplicate @constant.

 *

 * Returns: (transfer full): the new #XexprConstant

 */

XexprConstant *xexpr_constant_dup(XexprConstant *constant)

{

    switch(constant->type)

    {

	case XEXPR_TYPE_INVOCATION:

	    return xexpr_new_invocation(constant->u.invocation->ns,

	      constant->u.invocation->function,constant->u.invocation->bindings,

	      constant->u.invocation->constants);

	    break;

	case XEXPR_TYPE_FUNCTION:

	    return xexpr_new_function(constant->u.function->args,

	      constant->u.function->constants);

	    break;

	case XEXPR_TYPE_STRING:

	    return xexpr_new_string(constant->u.string,-1);

	    break;

	case XEXPR_TYPE_INTEGER:

	    return xexpr_new_integer(constant->u.integer);

	    break;

	case XEXPR_TYPE_NUMBER:

	    return xexpr_new_number(constant->u.number);

	    break;

    }

    return NULL;

}

/**

 * xexpr_bindings_dup:

 * @bindings: (transfer none) (element-type XexprBinding): a list of bindings

 *   to duplicate

 *

 * Duplicate @bindings.

 *

 * Returns: (transfer full) (element-type XexprBinging): the new bindings list

 */

GSList *xexpr_bindings_dup(GSList *bindings)

{

    GSList *lnk,*list=NULL;

    XexprBinding *binding,*dup;

    for(lnk=bindings;lnk;lnk=lnk->next)

    {

	binding=lnk->data;

	dup=g_slice_new(XexprBinding);

	dup->id=g_strdup(binding->id);

	dup->value=xexpr_constant_dup(binding->value);

	list=g_slist_prepend(list,dup);

    }

    return g_slist_reverse(list);

}