1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/22/14 */
5 /* */
6 /* ARGUMENT ACCESS MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Provides access routines for accessing arguments */
11 /* passed to user or system functions defined using the */
12 /* DefineFunction protocol. */
13 /* */
14 /* Principal Programmer(s): */
15 /* Gary D. Riley */
16 /* */
17 /* Contributing Programmer(s): */
18 /* Brian L. Dantes */
19 /* */
20 /* Revision History: */
21 /* */
22 /* 6.24: Renamed BOOLEAN macro type to intBool. */
23 /* */
24 /* Added IllegalLogicalNameMessage function. */
25 /* */
26 /* 6.30: Support for long long integers. */
27 /* */
28 /* Added const qualifiers to remove C++ */
29 /* deprecation warnings. */
30 /* */
31 /* Converted API macros to function calls. */
32 /* */
33 /* Support for fact-address arguments. */
34 /* */
35 /*************************************************************/
36
37 #define _ARGACCES_SOURCE_
38
39 #include "setup.h"
40
41 #include <stdio.h>
42 #define _STDIO_INCLUDED_
43 #include <string.h>
44 #include <ctype.h>
45 #include <stdlib.h>
46
47 #include "envrnmnt.h"
48 #include "extnfunc.h"
49 #include "router.h"
50 #include "cstrnchk.h"
51 #include "insfun.h"
52 #include "factmngr.h"
53 #include "prntutil.h"
54 #include "sysdep.h"
55
56 #include "argacces.h"
57
58 /***************************************/
59 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
60 /***************************************/
61
62 static void NonexistantError(void *,const char *,const char *,int);
63 static void ExpectedTypeError3(void *,const char *,const char *,int,const char *);
64
65 /*******************************************************************/
66 /* EnvRtnLexeme: Access function to retrieve the nth argument from */
67 /* a user or system function defined using the DefineFunction */
68 /* protocol. The argument retrieved must be a symbol, string, or */
69 /* instance name, otherwise an error is generated. Only the */
70 /* value of the argument is returned (i.e. the string "a" would */
71 /* be returned for a, "a", and [a]). */
72 /*******************************************************************/
EnvRtnLexeme(void * theEnv,int argumentPosition)73 globle const char *EnvRtnLexeme(
74 void *theEnv,
75 int argumentPosition)
76 {
77 int count = 1;
78 DATA_OBJECT result;
79 struct expr *argPtr;
80
81 /*=====================================================*/
82 /* Find the appropriate argument in the argument list. */
83 /*=====================================================*/
84
85 for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
86 (argPtr != NULL) && (count < argumentPosition);
87 argPtr = argPtr->nextArg)
88 { count++; }
89
90 if (argPtr == NULL)
91 {
92 NonexistantError(theEnv,"RtnLexeme",
93 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
94 argumentPosition);
95 SetHaltExecution(theEnv,TRUE);
96 SetEvaluationError(theEnv,TRUE);
97 return(NULL);
98 }
99
100 /*============================================*/
101 /* Return the value of the nth argument if it */
102 /* is a symbol, string, or instance name. */
103 /*============================================*/
104
105 EvaluateExpression(theEnv,argPtr,&result);
106
107 if ((result.type == SYMBOL) ||
108 #if OBJECT_SYSTEM
109 (result.type == INSTANCE_NAME) ||
110 #endif
111 (result.type == STRING))
112 { return(ValueToString(result.value));}
113
114 /*======================================================*/
115 /* Generate an error if the argument is the wrong type. */
116 /*======================================================*/
117
118 ExpectedTypeError3(theEnv,"RtnLexeme",
119 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
120 argumentPosition,"symbol, string, or instance name");
121 SetHaltExecution(theEnv,TRUE);
122 SetEvaluationError(theEnv,TRUE);
123 return(NULL);
124 }
125
126 /*******************************************************************/
127 /* EnvRtnDouble: Access function to retrieve the nth argument from */
128 /* a user or system function defined using the DefineFunction */
129 /* protocol. The argument retrieved must be a either a float or */
130 /* an integer (type conversion to a float is performed for */
131 /* integers), otherwise an error is generated. Only the value of */
132 /* the argument is returned (i.e. the float 3.0 would be */
133 /* returned for 3.0 and 3). */
134 /*******************************************************************/
EnvRtnDouble(void * theEnv,int argumentPosition)135 globle double EnvRtnDouble(
136 void *theEnv,
137 int argumentPosition)
138 {
139 int count = 1;
140 DATA_OBJECT result;
141 struct expr *argPtr;
142
143 /*=====================================================*/
144 /* Find the appropriate argument in the argument list. */
145 /*=====================================================*/
146
147 for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
148 (argPtr != NULL) && (count < argumentPosition);
149 argPtr = argPtr->nextArg)
150 { count++; }
151
152 if (argPtr == NULL)
153 {
154 NonexistantError(theEnv,"RtnDouble",
155 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
156 argumentPosition);
157 SetHaltExecution(theEnv,TRUE);
158 SetEvaluationError(theEnv,TRUE);
159 return(1.0);
160 }
161
162 /*======================================*/
163 /* Return the value of the nth argument */
164 /* if it is a float or integer. */
165 /*======================================*/
166
167 EvaluateExpression(theEnv,argPtr,&result);
168
169 if (result.type == FLOAT)
170 { return(ValueToDouble(result.value)); }
171 else if (result.type == INTEGER)
172 { return((double) ValueToLong(result.value)); }
173
174 /*======================================================*/
175 /* Generate an error if the argument is the wrong type. */
176 /*======================================================*/
177
178 ExpectedTypeError3(theEnv,"RtnDouble",
179 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
180 argumentPosition,"number");
181 SetHaltExecution(theEnv,TRUE);
182 SetEvaluationError(theEnv,TRUE);
183 return(1.0);
184 }
185
186 /*****************************************************************/
187 /* EnvRtnLong: Access function to retrieve the nth argument from */
188 /* a user or system function defined using the DefineFunction */
189 /* protocol. The argument retrieved must be a either a float */
190 /* or an integer (type conversion to an integer is performed */
191 /* for floats), otherwise an error is generated. Only the */
192 /* value of the argument is returned (i.e. the integer 4 */
193 /* would be returned for 4.3 and 4). */
194 /*****************************************************************/
EnvRtnLong(void * theEnv,int argumentPosition)195 globle long long EnvRtnLong(
196 void *theEnv,
197 int argumentPosition)
198 {
199 int count = 1;
200 DATA_OBJECT result;
201 struct expr *argPtr;
202
203 /*=====================================================*/
204 /* Find the appropriate argument in the argument list. */
205 /*=====================================================*/
206
207 for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
208 (argPtr != NULL) && (count < argumentPosition);
209 argPtr = argPtr->nextArg)
210 { count++; }
211
212 if (argPtr == NULL)
213 {
214 NonexistantError(theEnv,"RtnLong",
215 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
216 argumentPosition);
217 SetHaltExecution(theEnv,TRUE);
218 SetEvaluationError(theEnv,TRUE);
219 return(1L);
220 }
221
222 /*======================================*/
223 /* Return the value of the nth argument */
224 /* if it is a float or integer. */
225 /*======================================*/
226
227 EvaluateExpression(theEnv,argPtr,&result);
228
229 if (result.type == FLOAT)
230 { return((long) ValueToDouble(result.value)); }
231 else if (result.type == INTEGER)
232 { return(ValueToLong(result.value)); }
233
234 /*======================================================*/
235 /* Generate an error if the argument is the wrong type. */
236 /*======================================================*/
237
238 ExpectedTypeError3(theEnv,"RtnLong",
239 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
240 argumentPosition,"number");
241 SetHaltExecution(theEnv,TRUE);
242 SetEvaluationError(theEnv,TRUE);
243 return(1L);
244 }
245
246 /********************************************************************/
247 /* EnvRtnUnknown: Access function to retrieve the nth argument from */
248 /* a user or system function defined using the DefineFunction */
249 /* protocol. The argument retrieved can be of any type. The value */
250 /* and type of the argument are returned in a DATA_OBJECT */
251 /* structure provided by the calling function. */
252 /********************************************************************/
EnvRtnUnknown(void * theEnv,int argumentPosition,DATA_OBJECT_PTR returnValue)253 globle DATA_OBJECT_PTR EnvRtnUnknown(
254 void *theEnv,
255 int argumentPosition,
256 DATA_OBJECT_PTR returnValue)
257 {
258 int count = 1;
259 struct expr *argPtr;
260
261 /*=====================================================*/
262 /* Find the appropriate argument in the argument list. */
263 /*=====================================================*/
264
265 for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
266 (argPtr != NULL) && (count < argumentPosition);
267 argPtr = argPtr->nextArg)
268 { count++; }
269
270 if (argPtr == NULL)
271 {
272 NonexistantError(theEnv,"RtnUnknown",
273 ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
274 argumentPosition);
275 SetHaltExecution(theEnv,TRUE);
276 SetEvaluationError(theEnv,TRUE);
277 return(NULL);
278 }
279
280 /*=======================================*/
281 /* Return the value of the nth argument. */
282 /*=======================================*/
283
284 EvaluateExpression(theEnv,argPtr,returnValue);
285 return(returnValue);
286 }
287
288 /***********************************************************/
289 /* EnvRtnArgCount: Returns the length of the argument list */
290 /* for the function call currently being evaluated. */
291 /***********************************************************/
EnvRtnArgCount(void * theEnv)292 globle int EnvRtnArgCount(
293 void *theEnv)
294 {
295 int count = 0;
296 struct expr *argPtr;
297
298 for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
299 argPtr != NULL;
300 argPtr = argPtr->nextArg)
301 { count++; }
302
303 return(count);
304 }
305
306 /************************************************************************/
307 /* EnvArgCountCheck: Given the expected number of arguments, determines */
308 /* if the function currently being evaluated has the correct number */
309 /* of arguments. Three types of argument checking are provided by */
310 /* this function: 1) The function has exactly the expected number of */
311 /* arguments; 2) The function has at least the expected number of */
312 /* arguments; 3) The function has at most the expected number of */
313 /* arguments. The number of arguments is returned if no error occurs, */
314 /* otherwise -1 is returned. */
315 /************************************************************************/
EnvArgCountCheck(void * theEnv,const char * functionName,int countRelation,int expectedNumber)316 globle int EnvArgCountCheck(
317 void *theEnv,
318 const char *functionName,
319 int countRelation,
320 int expectedNumber)
321 {
322 int numberOfArguments;
323
324 /*==============================================*/
325 /* Get the number of arguments for the function */
326 /* currently being evaluated. */
327 /*==============================================*/
328
329 numberOfArguments = EnvRtnArgCount(theEnv);
330
331 /*=========================================================*/
332 /* If the function satisfies expected number of arguments, */
333 /* constraint, then return the number of arguments found. */
334 /*=========================================================*/
335
336 if (countRelation == EXACTLY)
337 { if (numberOfArguments == expectedNumber) return(numberOfArguments); }
338 else if (countRelation == AT_LEAST)
339 { if (numberOfArguments >= expectedNumber) return(numberOfArguments); }
340 else if (countRelation == NO_MORE_THAN)
341 { if (numberOfArguments <= expectedNumber) return(numberOfArguments); }
342
343 /*================================================*/
344 /* The correct number of arguments was not found. */
345 /* Generate an error message and return -1. */
346 /*================================================*/
347
348 ExpectedCountError(theEnv,functionName,countRelation,expectedNumber);
349
350 SetHaltExecution(theEnv,TRUE);
351 SetEvaluationError(theEnv,TRUE);
352
353 return(-1);
354 }
355
356 /****************************************************************/
357 /* EnvArgRangeCheck: Checks that the number of arguments passed */
358 /* to a function falls within a specified minimum and maximum */
359 /* range. The number of arguments passed to the function is */
360 /* returned if no error occurs, otherwise -1 is returned. */
361 /****************************************************************/
EnvArgRangeCheck(void * theEnv,const char * functionName,int min,int max)362 globle int EnvArgRangeCheck(
363 void *theEnv,
364 const char *functionName,
365 int min,
366 int max)
367 {
368 int numberOfArguments;
369
370 numberOfArguments = EnvRtnArgCount(theEnv);
371 if ((numberOfArguments < min) || (numberOfArguments > max))
372 {
373 PrintErrorID(theEnv,"ARGACCES",1,FALSE);
374 EnvPrintRouter(theEnv,WERROR,"Function ");
375 EnvPrintRouter(theEnv,WERROR,functionName);
376 EnvPrintRouter(theEnv,WERROR," expected at least ");
377 PrintLongInteger(theEnv,WERROR,(long) min);
378 EnvPrintRouter(theEnv,WERROR," and no more than ");
379 PrintLongInteger(theEnv,WERROR,(long) max);
380 EnvPrintRouter(theEnv,WERROR," arguments.\n");
381 SetHaltExecution(theEnv,TRUE);
382 SetEvaluationError(theEnv,TRUE);
383 return(-1);
384 }
385
386 return(numberOfArguments);
387 }
388
389 /*************************************************************/
390 /* EnvArgTypeCheck: Retrieves the nth argument passed to the */
391 /* function call currently being evaluated and determines */
392 /* if it matches a specified type. Returns TRUE if the */
393 /* argument was successfully retrieved and is of the */
394 /* appropriate type, otherwise returns FALSE. */
395 /*************************************************************/
EnvArgTypeCheck(void * theEnv,const char * functionName,int argumentPosition,int expectedType,DATA_OBJECT_PTR returnValue)396 globle int EnvArgTypeCheck(
397 void *theEnv,
398 const char *functionName,
399 int argumentPosition,
400 int expectedType,
401 DATA_OBJECT_PTR returnValue)
402 {
403 /*========================*/
404 /* Retrieve the argument. */
405 /*========================*/
406
407 EnvRtnUnknown(theEnv,argumentPosition,returnValue);
408 if (EvaluationData(theEnv)->EvaluationError) return(FALSE);
409
410 /*========================================*/
411 /* If the argument's type exactly matches */
412 /* the expected type, then return TRUE. */
413 /*========================================*/
414
415 if (returnValue->type == expectedType) return (TRUE);
416
417 /*=============================================================*/
418 /* Some expected types encompass more than one primitive type. */
419 /* If the argument's type matches one of the primitive types */
420 /* encompassed by the expected type, then return TRUE. */
421 /*=============================================================*/
422
423 if ((expectedType == INTEGER_OR_FLOAT) &&
424 ((returnValue->type == INTEGER) || (returnValue->type == FLOAT)))
425 { return(TRUE); }
426
427 if ((expectedType == SYMBOL_OR_STRING) &&
428 ((returnValue->type == SYMBOL) || (returnValue->type == STRING)))
429 { return(TRUE); }
430
431 #if OBJECT_SYSTEM
432 if (((expectedType == SYMBOL_OR_STRING) || (expectedType == SYMBOL)) &&
433 (returnValue->type == INSTANCE_NAME))
434 { return(TRUE); }
435
436 if ((expectedType == INSTANCE_NAME) &&
437 ((returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL)))
438 { return(TRUE); }
439
440 if ((expectedType == INSTANCE_OR_INSTANCE_NAME) &&
441 ((returnValue->type == INSTANCE_ADDRESS) ||
442 (returnValue->type == INSTANCE_NAME) ||
443 (returnValue->type == SYMBOL)))
444 { return(TRUE); }
445 #endif
446
447 /*===========================================================*/
448 /* If the expected type is float and the argument's type is */
449 /* integer (or vice versa), then convert the argument's type */
450 /* to match the expected type and then return TRUE. */
451 /*===========================================================*/
452
453 if ((returnValue->type == INTEGER) && (expectedType == FLOAT))
454 {
455 returnValue->type = FLOAT;
456 returnValue->value = (void *) EnvAddDouble(theEnv,(double) ValueToLong(returnValue->value));
457 return(TRUE);
458 }
459
460 if ((returnValue->type == FLOAT) && (expectedType == INTEGER))
461 {
462 returnValue->type = INTEGER;
463 returnValue->value = (void *) EnvAddLong(theEnv,(long long) ValueToDouble(returnValue->value));
464 return(TRUE);
465 }
466
467 /*=====================================================*/
468 /* The argument's type didn't match the expected type. */
469 /* Print an error message and return FALSE. */
470 /*=====================================================*/
471
472 if (expectedType == FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"float");
473 else if (expectedType == INTEGER) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer");
474 else if (expectedType == SYMBOL) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol");
475 else if (expectedType == STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"string");
476 else if (expectedType == MULTIFIELD) ExpectedTypeError1(theEnv,functionName,argumentPosition,"multifield");
477 else if (expectedType == INTEGER_OR_FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer or float");
478 else if (expectedType == SYMBOL_OR_STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol or string");
479 else if (expectedType == FACT_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"fact address");
480 #if OBJECT_SYSTEM
481 else if (expectedType == INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance name");
482 else if (expectedType == INSTANCE_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address");
483 else if (expectedType == INSTANCE_OR_INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address or instance name");
484 #endif
485
486 SetHaltExecution(theEnv,TRUE);
487 SetEvaluationError(theEnv,TRUE);
488
489 return(FALSE);
490 }
491
492 /******************************************************************/
493 /* GetNumericArgument: Evaluates an expression to yield a numeric */
494 /* argument. This provides quicker retrieval than using some of */
495 /* the other argument access routines. The numeric argument is */
496 /* returned in a DATA_OBJECT supplied by the calling function. */
497 /* TRUE is returned if a numeric argument was successfully */
498 /* retrieved, otherwise FALSE is returned. */
499 /******************************************************************/
GetNumericArgument(void * theEnv,struct expr * theArgument,const char * functionName,DATA_OBJECT * result,intBool convertToFloat,int whichArgument)500 globle intBool GetNumericArgument(
501 void *theEnv,
502 struct expr *theArgument,
503 const char *functionName,
504 DATA_OBJECT *result,
505 intBool convertToFloat,
506 int whichArgument)
507 {
508 unsigned short theType;
509 void *theValue;
510
511 /*==================================================================*/
512 /* Evaluate the expression (don't bother calling EvaluateExpression */
513 /* if the type is float or integer). */
514 /*==================================================================*/
515
516 switch(theArgument->type)
517 {
518 case FLOAT:
519 case INTEGER:
520 theType = theArgument->type;
521 theValue = theArgument->value;
522 break;
523
524 default:
525 EvaluateExpression(theEnv,theArgument,result);
526 theType = result->type;
527 theValue = result->value;
528 break;
529 }
530
531 /*==========================================*/
532 /* If the argument is not float or integer, */
533 /* print an error message and return FALSE. */
534 /*==========================================*/
535
536 if ((theType != FLOAT) && (theType != INTEGER))
537 {
538 ExpectedTypeError1(theEnv,functionName,whichArgument,"integer or float");
539 SetHaltExecution(theEnv,TRUE);
540 SetEvaluationError(theEnv,TRUE);
541 result->type = INTEGER;
542 result->value = (void *) EnvAddLong(theEnv,0LL);
543 return(FALSE);
544 }
545
546 /*==========================================================*/
547 /* If the argument is an integer and the "convert to float" */
548 /* flag is TRUE, then convert the integer to a float. */
549 /*==========================================================*/
550
551 if ((convertToFloat) && (theType == INTEGER))
552 {
553 theType = FLOAT;
554 theValue = (void *) EnvAddDouble(theEnv,(double) ValueToLong(theValue));
555 }
556
557 /*============================================================*/
558 /* The numeric argument was successfully retrieved. Store the */
559 /* argument in the user supplied DATA_OBJECT and return TRUE. */
560 /*============================================================*/
561
562 result->type = theType;
563 result->value = theValue;
564
565 return(TRUE);
566 }
567
568 /*********************************************************************/
569 /* GetLogicalName: Retrieves the nth argument passed to the function */
570 /* call currently being evaluated and determines if it is a valid */
571 /* logical name. If valid, the logical name is returned, otherwise */
572 /* NULL is returned. */
573 /*********************************************************************/
GetLogicalName(void * theEnv,int whichArgument,const char * defaultLogicalName)574 globle const char *GetLogicalName(
575 void *theEnv,
576 int whichArgument,
577 const char *defaultLogicalName)
578 {
579 const char *logicalName;
580 DATA_OBJECT result;
581
582 EnvRtnUnknown(theEnv,whichArgument,&result);
583
584 if ((GetType(result) == SYMBOL) ||
585 (GetType(result) == STRING) ||
586 (GetType(result) == INSTANCE_NAME))
587 {
588 logicalName = ValueToString(result.value);
589 if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
590 { logicalName = defaultLogicalName; }
591 }
592 else if (GetType(result) == FLOAT)
593 {
594 logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result))));
595 }
596 else if (GetType(result) == INTEGER)
597 {
598 logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result))));
599 }
600 else
601 { logicalName = NULL; }
602
603 return(logicalName);
604 }
605
606 /************************************************************/
607 /* GetFileName: Retrieves the nth argument passed to the */
608 /* function call currently being evaluated and determines */
609 /* if it is a valid file name. If valid, the file name is */
610 /* returned, otherwise NULL is returned. */
611 /************************************************************/
GetFileName(void * theEnv,const char * functionName,int whichArgument)612 globle const char *GetFileName(
613 void *theEnv,
614 const char *functionName,
615 int whichArgument)
616 {
617 DATA_OBJECT result;
618
619 EnvRtnUnknown(theEnv,whichArgument,&result);
620 if ((GetType(result) != STRING) && (GetType(result) != SYMBOL))
621 {
622 ExpectedTypeError1(theEnv,functionName,whichArgument,"file name");
623 return(NULL);
624 }
625
626 return(DOToString(result));
627 }
628
629 /******************************************************************/
630 /* OpenErrorMessage: Generalized error message for opening files. */
631 /******************************************************************/
OpenErrorMessage(void * theEnv,const char * functionName,const char * fileName)632 globle void OpenErrorMessage(
633 void *theEnv,
634 const char *functionName,
635 const char *fileName)
636 {
637 PrintErrorID(theEnv,"ARGACCES",2,FALSE);
638 EnvPrintRouter(theEnv,WERROR,"Function ");
639 EnvPrintRouter(theEnv,WERROR,functionName);
640 EnvPrintRouter(theEnv,WERROR," was unable to open file ");
641 EnvPrintRouter(theEnv,WERROR,fileName);
642 EnvPrintRouter(theEnv,WERROR,".\n");
643 }
644
645 /************************************************************/
646 /* GetModuleName: Retrieves the nth argument passed to the */
647 /* function call currently being evaluated and determines */
648 /* if it is a valid module name. If valid, the module */
649 /* name is returned or NULL is returned to indicate all */
650 /* modules. */
651 /************************************************************/
GetModuleName(void * theEnv,const char * functionName,int whichArgument,int * error)652 globle struct defmodule *GetModuleName(
653 void *theEnv,
654 const char *functionName,
655 int whichArgument,
656 int *error)
657 {
658 DATA_OBJECT result;
659 struct defmodule *theModule;
660
661 *error = FALSE;
662
663 /*========================*/
664 /* Retrieve the argument. */
665 /*========================*/
666
667 EnvRtnUnknown(theEnv,whichArgument,&result);
668
669 /*=================================*/
670 /* A module name must be a symbol. */
671 /*=================================*/
672
673 if (GetType(result) != SYMBOL)
674 {
675 ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
676 *error = TRUE;
677 return(NULL);
678 }
679
680 /*=======================================*/
681 /* Check to see that the symbol actually */
682 /* corresponds to a defined module. */
683 /*=======================================*/
684
685 if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
686 {
687 if (strcmp("*",DOToString(result)) != 0)
688 {
689 ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
690 *error = TRUE;
691 }
692 return(NULL);
693 }
694
695 /*=================================*/
696 /* Return a pointer to the module. */
697 /*=================================*/
698
699 return(theModule);
700 }
701
702 /****************************************************************/
703 /* GetConstructName: Retrieves the 1st argument passed to the */
704 /* function call currently being evaluated and determines if */
705 /* it is a valid name for a construct. Also checks that the */
706 /* function is only passed a single argument. This routine */
707 /* is used by functions such as ppdeftemplate, undefrule, */
708 /* etc... to retrieve the construct name on which to operate. */
709 /****************************************************************/
GetConstructName(void * theEnv,const char * functionName,const char * constructType)710 globle const char *GetConstructName(
711 void *theEnv,
712 const char *functionName,
713 const char *constructType)
714 {
715 DATA_OBJECT result;
716
717 if (EnvRtnArgCount(theEnv) != 1)
718 {
719 ExpectedCountError(theEnv,functionName,EXACTLY,1);
720 return(NULL);
721 }
722
723 EnvRtnUnknown(theEnv,1,&result);
724
725 if (GetType(result) != SYMBOL)
726 {
727 ExpectedTypeError1(theEnv,functionName,1,constructType);
728 return(NULL);
729 }
730
731 return(DOToString(result));
732 }
733
734 /**************************************************************************/
735 /* NonexistantError: Prints the error message for a nonexistant argument. */
736 /**************************************************************************/
NonexistantError(void * theEnv,const char * accessFunction,const char * functionName,int argumentPosition)737 static void NonexistantError(
738 void *theEnv,
739 const char *accessFunction,
740 const char *functionName,
741 int argumentPosition)
742 {
743 PrintErrorID(theEnv,"ARGACCES",3,FALSE);
744 EnvPrintRouter(theEnv,WERROR,"Function ");
745 EnvPrintRouter(theEnv,WERROR,accessFunction);
746 EnvPrintRouter(theEnv,WERROR," received a request from function ");
747 EnvPrintRouter(theEnv,WERROR,functionName);
748 EnvPrintRouter(theEnv,WERROR," for argument #");
749 PrintLongInteger(theEnv,WERROR,(long int) argumentPosition);
750 EnvPrintRouter(theEnv,WERROR," which is non-existent\n");
751 }
752
753 /*********************************************************/
754 /* ExpectedCountError: Prints the error message for an */
755 /* incorrect number of arguments passed to a function. */
756 /*********************************************************/
ExpectedCountError(void * theEnv,const char * functionName,int countRelation,int expectedNumber)757 globle void ExpectedCountError(
758 void *theEnv,
759 const char *functionName,
760 int countRelation,
761 int expectedNumber)
762 {
763 PrintErrorID(theEnv,"ARGACCES",4,FALSE);
764 EnvPrintRouter(theEnv,WERROR,"Function ");
765 EnvPrintRouter(theEnv,WERROR,functionName);
766
767 if (countRelation == EXACTLY)
768 { EnvPrintRouter(theEnv,WERROR," expected exactly "); }
769 else if (countRelation == AT_LEAST)
770 { EnvPrintRouter(theEnv,WERROR," expected at least "); }
771 else if (countRelation == NO_MORE_THAN)
772 { EnvPrintRouter(theEnv,WERROR," expected no more than "); }
773 else
774 { EnvPrintRouter(theEnv,WERROR," generated an illegal argument check for "); }
775
776 PrintLongInteger(theEnv,WERROR,(long int) expectedNumber);
777 EnvPrintRouter(theEnv,WERROR," argument(s)\n");
778 }
779
780 /*************************************************************/
781 /* NAME : CheckFunctionArgCount */
782 /* DESCRIPTION : Checks the number of arguments against */
783 /* the system function restriction list */
784 /* INPUTS : 1) Name of the calling function */
785 /* 2) The restriction list can be NULL */
786 /* 3) The number of arguments */
787 /* RETURNS : TRUE if OK, FALSE otherwise */
788 /* SIDE EFFECTS : EvaluationError set on errrors */
789 /* NOTES : Used to check generic function implicit */
790 /* method (system function) calls and system */
791 /* function calls which have the sequence */
792 /* expansion operator in their argument list */
793 /*************************************************************/
CheckFunctionArgCount(void * theEnv,const char * functionName,const char * restrictions,int argumentCount)794 globle intBool CheckFunctionArgCount(
795 void *theEnv,
796 const char *functionName,
797 const char *restrictions,
798 int argumentCount)
799 {
800 register int minArguments, maxArguments;
801 char theChar[2];
802
803 theChar[0] = '0';
804 theChar[1] = EOS;
805
806 /*=====================================================*/
807 /* If there are no restrictions, then there is no need */
808 /* to check for the correct number of arguments. */
809 /*=====================================================*/
810
811 if (restrictions == NULL) return(TRUE);
812
813 /*===========================================*/
814 /* Determine the minimum number of arguments */
815 /* required by the function. */
816 /*===========================================*/
817
818 if (isdigit(restrictions[0]))
819 {
820 theChar[0] = restrictions[0];
821 minArguments = atoi(theChar);
822 }
823 else
824 { minArguments = -1; }
825
826 /*===========================================*/
827 /* Determine the maximum number of arguments */
828 /* required by the function. */
829 /*===========================================*/
830
831 if (isdigit(restrictions[1]))
832 {
833 theChar[0] = restrictions[1];
834 maxArguments = atoi(theChar);
835 }
836 else
837 { maxArguments = 10000; }
838
839 /*==============================================*/
840 /* If the function expects exactly N arguments, */
841 /* then check to see if there are N arguments. */
842 /*==============================================*/
843
844 if (minArguments == maxArguments)
845 {
846 if (argumentCount != minArguments)
847 {
848 ExpectedCountError(theEnv,functionName,EXACTLY,minArguments);
849 SetEvaluationError(theEnv,TRUE);
850 return(FALSE);
851 }
852 return(TRUE);
853 }
854
855 /*==================================*/
856 /* Check to see if there were fewer */
857 /* arguments passed than expected. */
858 /*==================================*/
859
860 if (argumentCount < minArguments)
861 {
862 ExpectedCountError(theEnv,functionName,AT_LEAST,minArguments);
863 SetEvaluationError(theEnv,TRUE);
864 return(FALSE);
865 }
866
867 /*=================================*/
868 /* Check to see if there were more */
869 /* arguments passed than expected. */
870 /*=================================*/
871
872 if (argumentCount > maxArguments)
873 {
874 ExpectedCountError(theEnv,functionName,NO_MORE_THAN,maxArguments);
875 SetEvaluationError(theEnv,TRUE);
876 return(FALSE);
877 }
878
879 /*===============================*/
880 /* The number of arguments falls */
881 /* within the expected range. */
882 /*===============================*/
883
884 return(TRUE);
885 }
886
887 /*******************************************************************/
888 /* ExpectedTypeError1: Prints the error message for the wrong type */
889 /* of argument passed to a user or system defined function. The */
890 /* expected type is passed as a string to this function. */
891 /*******************************************************************/
ExpectedTypeError1(void * theEnv,const char * functionName,int whichArg,const char * expectedType)892 globle void ExpectedTypeError1(
893 void *theEnv,
894 const char *functionName,
895 int whichArg,
896 const char *expectedType)
897 {
898 PrintErrorID(theEnv,"ARGACCES",5,FALSE);
899 EnvPrintRouter(theEnv,WERROR,"Function ");
900 EnvPrintRouter(theEnv,WERROR,functionName);
901 EnvPrintRouter(theEnv,WERROR," expected argument #");
902 PrintLongInteger(theEnv,WERROR,(long int) whichArg);
903 EnvPrintRouter(theEnv,WERROR," to be of type ");
904 EnvPrintRouter(theEnv,WERROR,expectedType);
905 EnvPrintRouter(theEnv,WERROR,"\n");
906 }
907
908 /**************************************************************/
909 /* ExpectedTypeError2: Prints the error message for the wrong */
910 /* type of argument passed to a user or system defined */
911 /* function. The expected type is derived by examining the */
912 /* function's argument restriction list. */
913 /**************************************************************/
ExpectedTypeError2(void * theEnv,const char * functionName,int whichArg)914 globle void ExpectedTypeError2(
915 void *theEnv,
916 const char *functionName,
917 int whichArg)
918 {
919 struct FunctionDefinition *theFunction;
920 const char *theType;
921
922 theFunction = FindFunction(theEnv,functionName);
923
924 if (theFunction == NULL) return;
925
926 theType = GetArgumentTypeName(GetNthRestriction(theFunction,whichArg));
927
928 ExpectedTypeError1(theEnv,functionName,whichArg,theType);
929 }
930
931 /*******************************************************************/
932 /* ExpectedTypeError3: Prints the error message for the wrong type */
933 /* of argument passed to a user or system defined function when */
934 /* the argument was requested by calling RtnLexeme, RtnLong, or */
935 /* RtnDouble. */
936 /*******************************************************************/
ExpectedTypeError3(void * theEnv,const char * accessFunction,const char * functionName,int argumentPosition,const char * type)937 static void ExpectedTypeError3(
938 void *theEnv,
939 const char *accessFunction,
940 const char *functionName,
941 int argumentPosition,
942 const char *type)
943 {
944 PrintErrorID(theEnv,"ARGACCES",6,FALSE);
945 EnvPrintRouter(theEnv,WERROR,"Function ");
946 EnvPrintRouter(theEnv,WERROR,accessFunction);
947 EnvPrintRouter(theEnv,WERROR," received a request from function ");
948 EnvPrintRouter(theEnv,WERROR,functionName);
949 EnvPrintRouter(theEnv,WERROR," for argument #");
950 PrintLongInteger(theEnv,WERROR,(long int) argumentPosition);
951 EnvPrintRouter(theEnv,WERROR," which is not of type ");
952 EnvPrintRouter(theEnv,WERROR,type);
953 EnvPrintRouter(theEnv,WERROR,"\n");
954 }
955
956 /***************************************************/
957 /* GetFactOrInstanceArgument: Utility routine for */
958 /* retrieving a fact or instance argument */
959 /***************************************************/
GetFactOrInstanceArgument(void * theEnv,int thePosition,DATA_OBJECT * item,const char * functionName)960 void *GetFactOrInstanceArgument(
961 void *theEnv,
962 int thePosition,
963 DATA_OBJECT *item,
964 const char *functionName)
965 {
966 #if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM
967 void *ptr;
968 #endif
969
970 /*==============================*/
971 /* Retrieve the first argument. */
972 /*==============================*/
973
974 EnvRtnUnknown(theEnv,thePosition,item);
975
976 /*==================================================*/
977 /* Fact and instance addresses are valid arguments. */
978 /*==================================================*/
979
980 if ((GetpType(item) == FACT_ADDRESS) ||
981 (GetpType(item) == INSTANCE_ADDRESS))
982 { return(GetpValue(item)); }
983
984 /*==================================================*/
985 /* An integer is a valid argument if it corresponds */
986 /* to the fact index of an existing fact. */
987 /*==================================================*/
988
989 #if DEFTEMPLATE_CONSTRUCT
990 else if (GetpType(item) == INTEGER)
991 {
992 if ((ptr = (void *) FindIndexedFact(theEnv,DOPToLong(item))) == NULL)
993 {
994 char tempBuffer[20];
995 gensprintf(tempBuffer,"f-%lld",DOPToLong(item));
996 CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
997 }
998 return(ptr);
999 }
1000 #endif
1001
1002 /*================================================*/
1003 /* Instance names and symbols are valid arguments */
1004 /* if they correspond to an existing instance. */
1005 /*================================================*/
1006
1007 #if OBJECT_SYSTEM
1008 else if ((GetpType(item) == INSTANCE_NAME) || (GetpType(item) == SYMBOL))
1009 {
1010 if ((ptr = (void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) GetpValue(item))) == NULL)
1011 {
1012 CantFindItemErrorMessage(theEnv,"instance",ValueToString(GetpValue(item)));
1013 }
1014 return(ptr);
1015 }
1016 #endif
1017
1018 /*========================================*/
1019 /* Any other type is an invalid argument. */
1020 /*========================================*/
1021
1022 ExpectedTypeError2(theEnv,functionName,thePosition);
1023 return(NULL);
1024 }
1025
1026 /****************************************************/
1027 /* IllegalLogicalNameMessage: Generic error message */
1028 /* for illegal logical names. */
1029 /****************************************************/
IllegalLogicalNameMessage(void * theEnv,const char * theFunction)1030 void IllegalLogicalNameMessage(
1031 void *theEnv,
1032 const char *theFunction)
1033 {
1034 PrintErrorID(theEnv,"IOFUN",1,FALSE);
1035 EnvPrintRouter(theEnv,WERROR,"Illegal logical name used for ");
1036 EnvPrintRouter(theEnv,WERROR,theFunction);
1037 EnvPrintRouter(theEnv,WERROR," function.\n");
1038 }
1039
1040 /*#####################################*/
1041 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
1042 /*#####################################*/
1043
1044 #if ALLOW_ENVIRONMENT_GLOBALS
1045
ArgCountCheck(const char * functionName,int countRelation,int expectedNumber)1046 globle int ArgCountCheck(
1047 const char *functionName,
1048 int countRelation,
1049 int expectedNumber)
1050 {
1051 return EnvArgCountCheck(GetCurrentEnvironment(),functionName,countRelation,expectedNumber);
1052 }
1053
ArgRangeCheck(const char * functionName,int min,int max)1054 globle int ArgRangeCheck(
1055 const char *functionName,
1056 int min,
1057 int max)
1058 {
1059 return EnvArgRangeCheck(GetCurrentEnvironment(),functionName,min,max);
1060 }
1061
ArgTypeCheck(const char * functionName,int argumentPosition,int expectedType,DATA_OBJECT_PTR returnValue)1062 globle int ArgTypeCheck(
1063 const char *functionName,
1064 int argumentPosition,
1065 int expectedType,
1066 DATA_OBJECT_PTR returnValue)
1067 {
1068 return EnvArgTypeCheck(GetCurrentEnvironment(),functionName,argumentPosition,expectedType,returnValue);
1069 }
1070
RtnArgCount()1071 globle int RtnArgCount()
1072 {
1073 return EnvRtnArgCount(GetCurrentEnvironment());
1074 }
1075
RtnDouble(int argumentPosition)1076 globle double RtnDouble(
1077 int argumentPosition)
1078 {
1079 return EnvRtnDouble(GetCurrentEnvironment(),argumentPosition);
1080 }
1081
RtnLexeme(int argumentPosition)1082 globle const char *RtnLexeme(
1083 int argumentPosition)
1084 {
1085 return EnvRtnLexeme(GetCurrentEnvironment(),argumentPosition);
1086 }
1087
RtnLong(int argumentPosition)1088 globle long long RtnLong(
1089 int argumentPosition)
1090 {
1091 return EnvRtnLong(GetCurrentEnvironment(),argumentPosition);
1092 }
1093
RtnUnknown(int argumentPosition,DATA_OBJECT_PTR returnValue)1094 globle DATA_OBJECT_PTR RtnUnknown(
1095 int argumentPosition,
1096 DATA_OBJECT_PTR returnValue)
1097 {
1098 return EnvRtnUnknown(GetCurrentEnvironment(),argumentPosition,returnValue);
1099 }
1100
1101 #endif
1102
1103