1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 02/05/15 */
5 /* */
6 /* FACT RHS PATTERN PARSER MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Provides a number of routines for parsing fact */
11 /* patterns typically found on the RHS of a rule (such as */
12 /* the assert command). Also contains some functions for */
13 /* parsing RHS slot values (used by functions such as */
14 /* assert, modify, and duplicate). */
15 /* */
16 /* Principal Programmer(s): */
17 /* Gary D. Riley */
18 /* */
19 /* Contributing Programmer(s): */
20 /* Chris Culbert */
21 /* Brian L. Dantes */
22 /* */
23 /* Revision History: */
24 /* */
25 /* 6.30: Added const qualifiers to remove C++ */
26 /* deprecation warnings. */
27 /* */
28 /* Added code to prevent a clear command from */
29 /* being executed during fact assertions via */
30 /* Increment/DecrementClearReadyLocks API. */
31 /* */
32 /* Added code to keep track of pointers to */
33 /* constructs that are contained externally to */
34 /* to constructs, DanglingConstructs. */
35 /* */
36 /*************************************************************/
37
38 #define _FACTRHS_SOURCE_
39
40 #include <stdio.h>
41 #define _STDIO_INCLUDED_
42 #include <string.h>
43
44 #include "setup.h"
45
46 #if DEFTEMPLATE_CONSTRUCT
47
48 #include "constant.h"
49 #include "envrnmnt.h"
50 #include "extnfunc.h"
51 #include "modulutl.h"
52 #include "modulpsr.h"
53 #include "pattern.h"
54 #include "prntutil.h"
55 #include "cstrcpsr.h"
56
57 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
58 #include "bload.h"
59 #endif
60
61 #include "tmpltpsr.h"
62 #include "tmpltrhs.h"
63 #include "tmpltutl.h"
64 #include "exprnpsr.h"
65 #include "strngrtr.h"
66 #include "router.h"
67
68 #include "factrhs.h"
69
70 /***************************************/
71 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
72 /***************************************/
73
74 #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE
75 static void NoSuchTemplateError(void *,const char *);
76 #endif
77
78 #if (! RUN_TIME)
79
80 /**********************************************************************/
81 /* BuildRHSAssert: Parses zero or more RHS fact patterns (the format */
82 /* which is used by the assert command and the deffacts construct). */
83 /* Each of the RHS patterns is attached to an assert command and if */
84 /* there is more than one assert command, then a progn command is */
85 /* wrapped around all of the assert commands. */
86 /**********************************************************************/
BuildRHSAssert(void * theEnv,const char * logicalName,struct token * theToken,int * error,int atLeastOne,int readFirstParen,const char * whereParsed)87 globle struct expr *BuildRHSAssert(
88 void *theEnv,
89 const char *logicalName,
90 struct token *theToken,
91 int *error,
92 int atLeastOne,
93 int readFirstParen,
94 const char *whereParsed)
95 {
96 struct expr *lastOne, *nextOne, *assertList, *stub;
97
98 *error = FALSE;
99
100 /*===============================================================*/
101 /* If the first parenthesis of the RHS fact pattern has not been */
102 /* read yet, then get the next token. If a right parenthesis is */
103 /* encountered then exit (however, set the error return value if */
104 /* at least one fact was expected). */
105 /*===============================================================*/
106
107 if (readFirstParen == FALSE)
108 {
109 if (theToken->type == RPAREN)
110 {
111 if (atLeastOne)
112 {
113 *error = TRUE;
114 SyntaxErrorMessage(theEnv,whereParsed);
115 }
116 return(NULL);
117 }
118 }
119
120 /*================================================*/
121 /* Parse the facts until no more are encountered. */
122 /*================================================*/
123
124 lastOne = assertList = NULL;
125 while ((nextOne = GetRHSPattern(theEnv,logicalName,theToken,
126 error,FALSE,readFirstParen,
127 TRUE,RPAREN)) != NULL)
128 {
129 PPCRAndIndent(theEnv);
130
131 stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"assert"));
132 stub->argList = nextOne;
133 nextOne = stub;
134
135 if (lastOne == NULL)
136 { assertList = nextOne; }
137 else
138 { lastOne->nextArg = nextOne; }
139 lastOne = nextOne;
140
141 readFirstParen = TRUE;
142 }
143
144 /*======================================================*/
145 /* If an error was detected while parsing, then return. */
146 /*======================================================*/
147
148 if (*error)
149 {
150 ReturnExpression(theEnv,assertList);
151 return(NULL);
152 }
153
154 /*======================================*/
155 /* Fix the pretty print representation. */
156 /*======================================*/
157
158 if (theToken->type == RPAREN)
159 {
160 PPBackup(theEnv);
161 PPBackup(theEnv);
162 SavePPBuffer(theEnv,")");
163 }
164
165 /*==============================================================*/
166 /* If no facts are being asserted then return NULL. In addition */
167 /* if at least one fact was required, then signal an error. */
168 /*==============================================================*/
169
170 if (assertList == NULL)
171 {
172 if (atLeastOne)
173 {
174 *error = TRUE;
175 SyntaxErrorMessage(theEnv,whereParsed);
176 }
177
178 return(NULL);
179 }
180
181 /*===============================================*/
182 /* If more than one fact is being asserted, then */
183 /* wrap the assert commands within a progn call. */
184 /*===============================================*/
185
186 if (assertList->nextArg != NULL)
187 {
188 stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"progn"));
189 stub->argList = assertList;
190 assertList = stub;
191 }
192
193 /*==========================================================*/
194 /* Return the expression for asserting the specified facts. */
195 /*==========================================================*/
196
197 return(assertList);
198 }
199
200 #endif
201
202 /***************************************************************/
203 /* GetRHSPattern: Parses a single RHS fact pattern. The return */
204 /* value is the fact just parsed (or NULL if the delimiter */
205 /* for no more facts is the first token parsed). If an error */
206 /* occurs, then the error flag passed as an argument is set. */
207 /***************************************************************/
GetRHSPattern(void * theEnv,const char * readSource,struct token * tempToken,int * error,int constantsOnly,int readFirstParen,int checkFirstParen,int endType)208 globle struct expr *GetRHSPattern(
209 void *theEnv,
210 const char *readSource,
211 struct token *tempToken,
212 int *error,
213 int constantsOnly,
214 int readFirstParen,
215 int checkFirstParen,
216 int endType)
217 {
218 struct expr *lastOne = NULL;
219 struct expr *nextOne, *firstOne, *argHead = NULL;
220 int printError, count;
221 struct deftemplate *theDeftemplate;
222 struct symbolHashNode *templateName;
223 const char *nullBitMap = "\0";
224
225 /*=================================================*/
226 /* Get the opening parenthesis of the RHS pattern. */
227 /*=================================================*/
228
229 *error = FALSE;
230
231 if (readFirstParen) GetToken(theEnv,readSource,tempToken);
232
233 if (checkFirstParen)
234 {
235 if (tempToken->type == endType) return(NULL);
236
237 if (tempToken->type != LPAREN)
238 {
239 SyntaxErrorMessage(theEnv,"RHS patterns");
240 *error = TRUE;
241 return(NULL);
242 }
243 }
244
245 /*======================================================*/
246 /* The first field of an asserted fact must be a symbol */
247 /* (but not = or : which have special significance). */
248 /*======================================================*/
249
250 GetToken(theEnv,readSource,tempToken);
251 if (tempToken->type != SYMBOL)
252 {
253 SyntaxErrorMessage(theEnv,"first field of a RHS pattern");
254 *error = TRUE;
255 return(NULL);
256 }
257 else if ((strcmp(ValueToString(tempToken->value),"=") == 0) ||
258 (strcmp(ValueToString(tempToken->value),":") == 0))
259 {
260 SyntaxErrorMessage(theEnv,"first field of a RHS pattern");
261 *error = TRUE;
262 return(NULL);
263 }
264
265 /*=========================================================*/
266 /* Check to see if the relation name is a reserved symbol. */
267 /*=========================================================*/
268
269 templateName = (struct symbolHashNode *) tempToken->value;
270
271 if (ReservedPatternSymbol(theEnv,ValueToString(templateName),NULL))
272 {
273 ReservedPatternSymbolErrorMsg(theEnv,ValueToString(templateName),"a relation name");
274 *error = TRUE;
275 return(NULL);
276 }
277
278 /*============================================================*/
279 /* A module separator in the name is illegal in this context. */
280 /*============================================================*/
281
282 if (FindModuleSeparator(ValueToString(templateName)))
283 {
284 IllegalModuleSpecifierMessage(theEnv);
285
286 *error = TRUE;
287 return(NULL);
288 }
289
290 /*=============================================================*/
291 /* Determine if there is an associated deftemplate. If so, let */
292 /* the deftemplate parsing functions parse the RHS pattern and */
293 /* then return the fact pattern that was parsed. */
294 /*=============================================================*/
295
296 theDeftemplate = (struct deftemplate *)
297 FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(templateName),
298 &count,TRUE,NULL);
299
300 if (count > 1)
301 {
302 AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(templateName));
303 *error = TRUE;
304 return(NULL);
305 }
306
307 /*======================================================*/
308 /* If no deftemplate exists with the specified relation */
309 /* name, then create an implied deftemplate. */
310 /*======================================================*/
311
312 if (theDeftemplate == NULL)
313 #if (! BLOAD_ONLY) && (! RUN_TIME)
314 {
315 #if BLOAD || BLOAD_AND_BSAVE
316 if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
317 {
318 NoSuchTemplateError(theEnv,ValueToString(templateName));
319 *error = TRUE;
320 return(NULL);
321 }
322 #endif
323 #if DEFMODULE_CONSTRUCT
324 if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(templateName)))
325 {
326 ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(templateName),NULL,NULL);
327 *error = TRUE;
328 return(NULL);
329 }
330 #endif
331 if (! ConstructData(theEnv)->CheckSyntaxMode)
332 { theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) templateName,TRUE); }
333 }
334 #else
335 {
336 NoSuchTemplateError(theEnv,ValueToString(templateName));
337 *error = TRUE;
338 return(NULL);
339 }
340 #endif
341
342 /*=========================================*/
343 /* If an explicit deftemplate exists, then */
344 /* parse the fact as a deftemplate fact. */
345 /*=========================================*/
346
347 if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE))
348 {
349 firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate);
350 firstOne->nextArg = ParseAssertTemplate(theEnv,readSource,tempToken,
351 error,endType,
352 constantsOnly,theDeftemplate);
353
354 #if (! RUN_TIME) && (! BLOAD_ONLY)
355 if (! ConstructData(theEnv)->ParsingConstruct)
356 { ConstructData(theEnv)->DanglingConstructs++; }
357 #endif
358
359 if (*error)
360 {
361 ReturnExpression(theEnv,firstOne);
362 firstOne = NULL;
363 }
364
365 return(firstOne);
366 }
367
368 /*========================================*/
369 /* Parse the fact as an ordered RHS fact. */
370 /*========================================*/
371
372 firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate);
373
374 #if (! RUN_TIME) && (! BLOAD_ONLY)
375 if (! ConstructData(theEnv)->ParsingConstruct)
376 { ConstructData(theEnv)->DanglingConstructs++; }
377 #endif
378
379 #if (! RUN_TIME) && (! BLOAD_ONLY)
380 SavePPBuffer(theEnv," ");
381 #endif
382
383 while ((nextOne = GetAssertArgument(theEnv,readSource,tempToken,
384 error,endType,constantsOnly,&printError)) != NULL)
385 {
386 if (argHead == NULL) argHead = nextOne;
387 else lastOne->nextArg = nextOne;
388 lastOne = nextOne;
389 #if (! RUN_TIME) && (! BLOAD_ONLY)
390 SavePPBuffer(theEnv," ");
391 #endif
392 }
393
394 /*===========================================================*/
395 /* If an error occurred, set the error flag and return NULL. */
396 /*===========================================================*/
397
398 if (*error)
399 {
400 if (printError) SyntaxErrorMessage(theEnv,"RHS patterns");
401 ReturnExpression(theEnv,firstOne);
402 ReturnExpression(theEnv,argHead);
403 return(NULL);
404 }
405
406 /*=====================================*/
407 /* Fix the pretty print representation */
408 /* of the RHS ordered fact. */
409 /*=====================================*/
410
411 #if (! RUN_TIME) && (! BLOAD_ONLY)
412 PPBackup(theEnv);
413 PPBackup(theEnv);
414 SavePPBuffer(theEnv,tempToken->printForm);
415 #endif
416
417 /*==========================================================*/
418 /* Ordered fact assertions are processed by stuffing all of */
419 /* the fact's proposition (except the relation name) into a */
420 /* single multifield slot. */
421 /*==========================================================*/
422
423 firstOne->nextArg = GenConstant(theEnv,FACT_STORE_MULTIFIELD,EnvAddBitMap(theEnv,(void *) nullBitMap,1));
424 firstOne->nextArg->argList = argHead;
425
426 /*==============================*/
427 /* Return the RHS ordered fact. */
428 /*==============================*/
429
430 return(firstOne);
431 }
432
433 /********************************************************************/
434 /* GetAssertArgument: Parses a single RHS slot value and returns an */
435 /* expression representing the value. When parsing a deftemplate */
436 /* slot, the slot name has already been parsed when this function */
437 /* is called. NULL is returned if a slot or fact delimiter is */
438 /* encountered. In the event of a parse error, the error flag */
439 /* passed as an argument is set. */
440 /********************************************************************/
GetAssertArgument(void * theEnv,const char * logicalName,struct token * theToken,int * error,int endType,int constantsOnly,int * printError)441 globle struct expr *GetAssertArgument(
442 void *theEnv,
443 const char *logicalName,
444 struct token *theToken,
445 int *error,
446 int endType,
447 int constantsOnly,
448 int *printError)
449 {
450 #if ! RUN_TIME
451 struct expr *nextField;
452 #else
453 struct expr *nextField = NULL;
454 #endif
455
456 /*=================================================*/
457 /* Read in the first token of the slot's value. If */
458 /* the end delimiter is encountered, then return. */
459 /*=================================================*/
460
461 *printError = TRUE;
462 GetToken(theEnv,logicalName,theToken);
463 if (theToken->type == endType) return(NULL);
464
465 /*=============================================================*/
466 /* If an equal sign of left parenthesis was parsed, then parse */
467 /* a function which is to be evaluated to determine the slot's */
468 /* value. The equal sign corresponds to the return value */
469 /* constraint which can be used in LHS fact patterns. The */
470 /* equal sign is no longer necessary on either the LHS or RHS */
471 /* of a rule to indicate that a function is being evaluated to */
472 /* determine its value either for assignment or pattern */
473 /* matching. */
474 /*=============================================================*/
475
476 if ((theToken->type == SYMBOL) ?
477 (strcmp(ValueToString(theToken->value),"=") == 0) :
478 (theToken->type == LPAREN))
479 {
480 if (constantsOnly)
481 {
482 *error = TRUE;
483 return(NULL);
484 }
485
486 #if ! RUN_TIME
487 if (theToken->type == LPAREN) nextField = Function1Parse(theEnv,logicalName);
488 else nextField = Function0Parse(theEnv,logicalName);
489 if (nextField == NULL)
490 #endif
491 {
492 *printError = FALSE;
493 *error = TRUE;
494 }
495 #if ! RUN_TIME
496 else
497 {
498 theToken->type= RPAREN;
499 theToken->value = (void *) EnvAddSymbol(theEnv,")");
500 theToken->printForm = ")";
501 }
502 #endif
503
504 return(nextField);
505 }
506
507 /*==================================================*/
508 /* Constants are always allowed as RHS slot values. */
509 /*==================================================*/
510
511 if ((theToken->type == SYMBOL) || (theToken->type == STRING) ||
512 #if OBJECT_SYSTEM
513 (theToken->type == INSTANCE_NAME) ||
514 #endif
515 (theToken->type == FLOAT) || (theToken->type == INTEGER))
516 { return(GenConstant(theEnv,theToken->type,theToken->value)); }
517
518 /*========================================*/
519 /* Variables are also allowed as RHS slot */
520 /* values under some circumstances. */
521 /*========================================*/
522
523 if ((theToken->type == SF_VARIABLE) ||
524 #if DEFGLOBAL_CONSTRUCT
525 (theToken->type == GBL_VARIABLE) ||
526 (theToken->type == MF_GBL_VARIABLE) ||
527 #endif
528 (theToken->type == MF_VARIABLE))
529 {
530 if (constantsOnly)
531 {
532 *error = TRUE;
533 return(NULL);
534 }
535
536 return(GenConstant(theEnv,theToken->type,theToken->value));
537 }
538
539 /*==========================================================*/
540 /* If none of the other cases have been satisfied, then the */
541 /* token parsed is not appropriate for a RHS slot value. */
542 /*==========================================================*/
543
544 *error = TRUE;
545 return(NULL);
546 }
547
548 /****************************************************/
549 /* StringToFact: Converts the string representation */
550 /* of a fact to a fact data structure. */
551 /****************************************************/
StringToFact(void * theEnv,const char * str)552 globle struct fact *StringToFact(
553 void *theEnv,
554 const char *str)
555 {
556 struct token theToken;
557 struct fact *factPtr;
558 unsigned numberOfFields = 0, whichField;
559 struct expr *assertArgs, *tempPtr;
560 int error = FALSE;
561 DATA_OBJECT theResult;
562
563 /*=========================================*/
564 /* Open a string router and parse the fact */
565 /* using the router as an input source. */
566 /*=========================================*/
567
568 SetEvaluationError(theEnv,FALSE);
569
570 OpenStringSource(theEnv,"assert_str",str,0);
571
572 assertArgs = GetRHSPattern(theEnv,"assert_str",&theToken,
573 &error,FALSE,TRUE,
574 TRUE,RPAREN);
575
576 CloseStringSource(theEnv,"assert_str");
577
578 /*===========================================*/
579 /* Check for errors or the use of variables. */
580 /*===========================================*/
581
582 if ((assertArgs == NULL) && (! error))
583 {
584 SyntaxErrorMessage(theEnv,"RHS patterns");
585 ReturnExpression(theEnv,assertArgs);
586 return(NULL);
587 }
588
589 if (error)
590 {
591 ReturnExpression(theEnv,assertArgs);
592 return(NULL);
593 }
594
595 if (ExpressionContainsVariables(assertArgs,FALSE))
596 {
597 LocalVariableErrorMessage(theEnv,"the assert-string function");
598 SetEvaluationError(theEnv,TRUE);
599 ReturnExpression(theEnv,assertArgs);
600 return(NULL);
601 }
602
603 /*=======================================================*/
604 /* Count the number of fields needed for the fact and */
605 /* create a fact data structure of the appropriate size. */
606 /*=======================================================*/
607
608 for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
609 { numberOfFields++; }
610
611 factPtr = (struct fact *) CreateFactBySize(theEnv,numberOfFields);
612 factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value;
613
614 /*=============================================*/
615 /* Copy the fields to the fact data structure. */
616 /*=============================================*/
617
618 EnvIncrementClearReadyLocks(theEnv);
619 ExpressionInstall(theEnv,assertArgs); /* DR0836 */
620 whichField = 0;
621 for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
622 {
623 EvaluateExpression(theEnv,tempPtr,&theResult);
624 factPtr->theProposition.theFields[whichField].type = theResult.type;
625 factPtr->theProposition.theFields[whichField].value = theResult.value;
626 whichField++;
627 }
628 ExpressionDeinstall(theEnv,assertArgs); /* DR0836 */
629 ReturnExpression(theEnv,assertArgs);
630 EnvDecrementClearReadyLocks(theEnv);
631
632 /*==================*/
633 /* Return the fact. */
634 /*==================*/
635
636 return(factPtr);
637 }
638
639 #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE
640
641 /*********************************************************/
642 /* NoSuchTemplateError: Prints out an error message */
643 /* in a BLOAD_ONLY, RUN_TIME or bload active environment */
644 /* when an implied deftemplate cannot be created for */
645 /* an assert */
646 /*********************************************************/
NoSuchTemplateError(void * theEnv,const char * templateName)647 static void NoSuchTemplateError(
648 void *theEnv,
649 const char *templateName)
650 {
651 PrintErrorID(theEnv,"FACTRHS",1,FALSE);
652 EnvPrintRouter(theEnv,WERROR,"Template ");
653 EnvPrintRouter(theEnv,WERROR,templateName);
654 EnvPrintRouter(theEnv,WERROR," does not exist for assert.\n");
655 }
656
657 #endif /* RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE */
658
659 #endif /* DEFTEMPLATE_CONSTRUCT */
660
661
662