/******************************************************************** NAME : ExpandFuncCall DESCRIPTION : This function is a wrap-around for a normal function call. It preexamines the argument expression list and expands any references to the sequence operator. It builds a copy of the function call expression with these new arguments inserted and evaluates the function call. INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Expressions alloctaed/deallocated Function called and arguments evaluated EvaluationError set on errors NOTES : None *******************************************************************/ globle void ExpandFuncCall( void *theEnv, DATA_OBJECT *result) { EXPRESSION *newargexp,*fcallexp; struct FunctionDefinition *func; /* ====================================================================== Copy the original function call's argument expression list. Look for expand$ function callsexpressions and replace those with the equivalent expressions of the expansions of evaluations of the arguments. ====================================================================== */ newargexp = CopyExpression(theEnv,GetFirstArgument()->argList); ExpandFuncMultifield(theEnv,result,newargexp,&newargexp, (void *) FindFunction(theEnv,"expand$")); /* =================================================================== Build the new function call expression with the expanded arguments. Check the number of arguments, if necessary, and call the thing. =================================================================== */ fcallexp = get_struct(theEnv,expr); fcallexp->type = GetFirstArgument()->type; fcallexp->value = GetFirstArgument()->value; fcallexp->nextArg = NULL; fcallexp->argList = newargexp; if (fcallexp->type == FCALL) { func = (struct FunctionDefinition *) fcallexp->value; if (CheckFunctionArgCount(theEnv,ValueToString(func->callFunctionName), func->restrictions,CountArguments(newargexp)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); return; } } #if DEFFUNCTION_CONSTRUCT else if (fcallexp->type == PCALL) { if (CheckDeffunctionCall(theEnv,fcallexp->value, CountArguments(fcallexp->argList)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); SetEvaluationError(theEnv,TRUE); return; } } #endif EvaluateExpression(theEnv,fcallexp,result); ReturnExpression(theEnv,fcallexp); }
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); }
globle void FuncallFunction( void *theEnv, DATA_OBJECT *returnValue) { int argCount, i, j; DATA_OBJECT theValue; FUNCTION_REFERENCE theReference; char *name; struct multifield *theMultifield; struct expr *lastAdd = NULL, *nextAdd, *multiAdd; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=================================================*/ /* The funcall function has at least one argument: */ /* the name of the function being called. */ /*=================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return; /*============================================*/ /* Get the name of the function to be called. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE) { return; } /*====================*/ /* Find the function. */ /*====================*/ name = DOToString(theValue); if (! GetFunctionReference(theEnv,name,&theReference)) { ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name"); return; } ExpressionInstall(theEnv,&theReference); /*======================================*/ /* Add the arguments to the expression. */ /*======================================*/ for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theValue); if (GetEvaluationError(theEnv)) { ExpressionDeinstall(theEnv,&theReference); return; } switch(GetType(theValue)) { case MULTIFIELD: nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; multiAdd = NULL; theMultifield = (struct multifield *) GetValue(theValue); for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++) { nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j)); if (multiAdd == NULL) { lastAdd->argList = nextAdd; } else { multiAdd->nextArg = nextAdd; } multiAdd = nextAdd; } ExpressionInstall(theEnv,lastAdd); break; default: nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue)); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; ExpressionInstall(theEnv,lastAdd); break; } } /*===========================================================*/ /* Verify a deffunction has the correct number of arguments. */ /*===========================================================*/ #if DEFFUNCTION_CONSTRUCT if (theReference.type == PCALL) { if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE) { PrintErrorID(theEnv,"MISCFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value)); EnvPrintRouter(theEnv,WERROR,"\n"); ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); return; } } #endif /*======================*/ /* Call the expression. */ /*======================*/ EvaluateExpression(theEnv,&theReference,returnValue); /*========================================*/ /* Return the expression data structures. */ /*========================================*/ ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); }