globle struct expr *FunctionReferenceExpression(
void *theEnv,
const char *name)
{
#if DEFGENERIC_CONSTRUCT
void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
void *dptr;
#endif
struct FunctionDefinition *fptr;
/*=====================================================*/
/* Check to see if the function call is a deffunction. */
/*=====================================================*/
#if DEFFUNCTION_CONSTRUCT
if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL)
{ return(GenConstant(theEnv,PCALL,dptr)); }
#endif
/*====================================================*/
/* Check to see if the function call is a defgeneric. */
/*====================================================*/
#if DEFGENERIC_CONSTRUCT
if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL)
{ return(GenConstant(theEnv,GCALL,gfunc)); }
#endif
/*======================================*/
/* Check to see if the function call is */
/* a system or user defined function. */
/*======================================*/
if ((fptr = FindFunction(theEnv,name)) != NULL)
{ return(GenConstant(theEnv,FCALL,fptr)); }
/*===================================================*/
/* The specified function name is not a deffunction, */
/* defgeneric, or user/system defined function. */
/*===================================================*/
return(NULL);
}
/************************************************************
NAME : ValidDeffunctionName
DESCRIPTION : Determines if a new deffunction of the given
name can be defined in the current module
INPUTS : The new deffunction name
RETURNS : TRUE if OK, FALSE otherwise
SIDE EFFECTS : Error message printed if not OK
NOTES : GetConstructNameAndComment() (called before
this function) ensures that the deffunction
name does not conflict with one from
another module
************************************************************/
static BOOLEAN ValidDeffunctionName(
void *theEnv,
char *theDeffunctionName)
{
struct constructHeader *theDeffunction;
#if DEFGENERIC_CONSTRUCT
struct defmodule *theModule;
struct constructHeader *theDefgeneric;
#endif
/* ============================================
A deffunction cannot be named the same as a
construct type, e.g, defclass, defrule, etc.
============================================ */
if (FindConstruct(theEnv,theDeffunctionName) != NULL)
{
PrintErrorID(theEnv,"DFFNXPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n");
return(FALSE);
}
/* ============================================
A deffunction cannot be named the same as a
pre-defined system function, e.g, watch,
list-defrules, etc.
============================================ */
if (FindFunction(theEnv,theDeffunctionName) != NULL)
{
PrintErrorID(theEnv,"DFFNXPSR",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n");
return(FALSE);
}
#if DEFGENERIC_CONSTRUCT
/* ============================================
A deffunction cannot be named the same as a
generic function (either in this module or
imported from another)
============================================ */
theDefgeneric =
(struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName);
if (theDefgeneric != NULL)
{
theModule = GetConstructModuleItem(theDefgeneric)->theModule;
if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{
PrintErrorID(theEnv,"DFFNXPSR",5,FALSE);
EnvPrintRouter(theEnv,WERROR,"Defgeneric ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric));
EnvPrintRouter(theEnv,WERROR," imported from module ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));
EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n");
return(FALSE);
}
else
{
PrintErrorID(theEnv,"DFFNXPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n");
}
return(FALSE);
}
#endif
theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName);
if (theDeffunction != NULL)
{
/* ===========================================
And a deffunction in the current module can
only be redefined if it is not executing.
=========================================== */
if (((DEFFUNCTION *) theDeffunction)->executing)
{
PrintErrorID(theEnv,"DFNXPSR",4,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunction ");
EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));
EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n");
return(FALSE);
}
}
return(TRUE);
}
globle BOOLEAN GetFunctionReference(
char *name,
FUNCTION_REFERENCE *theReference)
{
#if DEFGENERIC_CONSTRUCT
void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
void *dptr;
#endif
struct FunctionDefinition *fptr;
theReference->nextArg = NULL;
theReference->argList = NULL;
theReference->type = RVOID;
theReference->value = NULL;
/*=====================================================*/
/* Check to see if the function call is a deffunction. */
/*=====================================================*/
#if DEFFUNCTION_CONSTRUCT
if ((dptr = (void *) LookupDeffunctionInScope(name)) != NULL)
{
theReference->type = PCALL;
theReference->value = dptr;
return(TRUE);
}
#endif
/*====================================================*/
/* Check to see if the function call is a defgeneric. */
/*====================================================*/
#if DEFGENERIC_CONSTRUCT
if ((gfunc = (void *) LookupDefgenericInScope(name)) != NULL)
{
theReference->type = GCALL;
theReference->value = gfunc;
return(TRUE);
}
#endif
/*======================================*/
/* Check to see if the function call is */
/* a system or user defined function. */
/*======================================*/
if ((fptr = FindFunction(name)) != NULL)
{
theReference->type = FCALL;
theReference->value = fptr;
return(TRUE);
}
/*===================================================*/
/* The specified function name is not a deffunction, */
/* defgeneric, or user/system defined function. */
/*===================================================*/
return(FALSE);
}
globle struct expr *Function2Parse(
void *theEnv,
char *logicalName,
char *name)
{
struct FunctionDefinition *theFunction;
struct expr *top;
#if DEFGENERIC_CONSTRUCT
void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
void *dptr;
#endif
/*=========================================================*/
/* Module specification cannot be used in a function call. */
/*=========================================================*/
if (FindModuleSeparator(name))
{
IllegalModuleSpecifierMessage(theEnv);
return(NULL);
}
/*================================*/
/* Has the function been defined? */
/*================================*/
theFunction = FindFunction(theEnv,name);
#if DEFGENERIC_CONSTRUCT
gfunc = (void *) LookupDefgenericInScope(theEnv,name);
#endif
#if DEFFUNCTION_CONSTRUCT
if ((theFunction == NULL)
#if DEFGENERIC_CONSTRUCT
&& (gfunc == NULL)
#endif
)
dptr = (void *) LookupDeffunctionInScope(theEnv,name);
else
dptr = NULL;
#endif
/*=============================*/
/* Define top level structure. */
/*=============================*/
#if DEFFUNCTION_CONSTRUCT
if (dptr != NULL)
top = GenConstant(theEnv,PCALL,dptr);
else
#endif
#if DEFGENERIC_CONSTRUCT
if (gfunc != NULL)
top = GenConstant(theEnv,GCALL,gfunc);
else
#endif
if (theFunction != NULL)
top = GenConstant(theEnv,FCALL,theFunction);
else
{
PrintErrorID(theEnv,"EXPRNPSR",3,TRUE);
EnvPrintRouter(theEnv,WERROR,"Missing function declaration for ");
EnvPrintRouter(theEnv,WERROR,name);
EnvPrintRouter(theEnv,WERROR,".\n");
return(NULL);
}
/*=======================================================*/
/* Check to see if function has its own parsing routine. */
/*=======================================================*/
PushRtnBrkContexts(theEnv);
ExpressionData(theEnv)->ReturnContext = FALSE;
ExpressionData(theEnv)->BreakContext = FALSE;
#if DEFGENERIC_CONSTRUCT || DEFFUNCTION_CONSTRUCT
if (top->type == FCALL)
#endif
{
if (theFunction->parser != NULL)
{
top = (*theFunction->parser)(theEnv,top,logicalName);
PopRtnBrkContexts(theEnv);
if (top == NULL) return(NULL);
if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"),
FindFunction(theEnv,"expand$")))
{
ReturnExpression(theEnv,top);
return(NULL);
}
return(top);
}
}
/*========================================*/
/* Default parsing routine for functions. */
/*========================================*/
top = CollectArguments(theEnv,top,logicalName);
PopRtnBrkContexts(theEnv);
if (top == NULL) return(NULL);
if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"),
FindFunction(theEnv,"expand$")))
{
ReturnExpression(theEnv,top);
return(NULL);
}
/*============================================================*/
/* If the function call uses the sequence expansion operator, */
/* its arguments cannot be checked until runtime. */
/*============================================================*/
if (top->value == (void *) FindFunction(theEnv,"(expansion-call)"))
{ return(top); }
/*============================*/
/* Check for argument errors. */
/*============================*/
if ((top->type == FCALL) && EnvGetStaticConstraintChecking(theEnv))
{
if (CheckExpressionAgainstRestrictions(theEnv,top,theFunction->restrictions,name))
{
ReturnExpression(theEnv,top);
return(NULL);
}
}
#if DEFFUNCTION_CONSTRUCT
else if (top->type == PCALL)
{
if (CheckDeffunctionCall(theEnv,top->value,CountArguments(top->argList)) == FALSE)
{
ReturnExpression(theEnv,top);
return(NULL);
}
}
#endif
/*========================*/
/* Return the expression. */
/*========================*/
return(top);
}
