1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/16/14 */
5 /* */
6 /* PROCEDURAL FUNCTIONS PARSER MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: */
11 /* */
12 /* Principal Programmer(s): */
13 /* Gary D. Riley */
14 /* Brian L. Dantes */
15 /* */
16 /* Contributing Programmer(s): */
17 /* */
18 /* Revision History: */
19 /* */
20 /* 6.23: Changed name of variable exp to theExp */
21 /* because of Unix compiler warnings of shadowed */
22 /* definitions. */
23 /* */
24 /* 6.24: Renamed BOOLEAN macro type to intBool. */
25 /* */
26 /* 6.30: Local variables set with the bind function */
27 /* persist until a reset/clear command is issued. */
28 /* */
29 /* Support for long long integers. */
30 /* */
31 /* Added const qualifiers to remove C++ */
32 /* deprecation warnings. */
33 /* */
34 /* Fixed linkage issue when BLOAD_ONLY compiler */
35 /* flag is set to 1. */
36 /* */
37 /*************************************************************/
38
39 #define _PRCDRPSR_SOURCE_
40
41 #include <stdio.h>
42 #define _STDIO_INCLUDED_
43
44 #include "setup.h"
45
46 #include "argacces.h"
47 #include "constrnt.h"
48 #include "cstrnchk.h"
49 #include "cstrnops.h"
50 #include "cstrnutl.h"
51 #include "envrnmnt.h"
52 #include "exprnpsr.h"
53 #include "memalloc.h"
54 #include "modulutl.h"
55 #include "multifld.h"
56 #include "router.h"
57 #include "scanner.h"
58 #include "utility.h"
59
60 #include "prcdrpsr.h"
61
62 #if DEFGLOBAL_CONSTRUCT
63 #include "globldef.h"
64 #include "globlpsr.h"
65 #endif
66
67 #if ! RUN_TIME
68 #define PRCDRPSR_DATA 12
69
70 struct procedureParserData
71 {
72 struct BindInfo *ListOfParsedBindNames;
73 };
74
75 #define ProcedureParserData(theEnv) ((struct procedureParserData *) GetEnvironmentData(theEnv,PRCDRPSR_DATA))
76 #endif
77
78 /***************************************/
79 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
80 /***************************************/
81
82 #if (! RUN_TIME)
83 static void DeallocateProceduralFunctionData(void *);
84 #if (! BLOAD_ONLY)
85 static struct expr *WhileParse(void *,struct expr *,const char *);
86 static struct expr *LoopForCountParse(void *,struct expr *,const char *);
87 static void ReplaceLoopCountVars(void *,SYMBOL_HN *,EXPRESSION *,int);
88 static struct expr *IfParse(void *,struct expr *,const char *);
89 static struct expr *PrognParse(void *,struct expr *,const char *);
90 static struct expr *BindParse(void *,struct expr *,const char *);
91 static int AddBindName(void *,struct symbolHashNode *,CONSTRAINT_RECORD *);
92 static struct expr *ReturnParse(void *,struct expr *,const char *);
93 static struct expr *BreakParse(void *,struct expr *,const char *);
94 static struct expr *SwitchParse(void *,struct expr *,const char *);
95 #endif
96 #endif
97
98 #if ! RUN_TIME
99 /*******************************************/
100 /* ProceduralFunctionParsers */
101 /*******************************************/
ProceduralFunctionParsers(void * theEnv)102 globle void ProceduralFunctionParsers(
103 void *theEnv)
104 {
105 AllocateEnvironmentData(theEnv,PRCDRPSR_DATA,sizeof(struct procedureParserData),DeallocateProceduralFunctionData);
106
107 #if (! BLOAD_ONLY)
108 AddFunctionParser(theEnv,"bind",BindParse);
109 AddFunctionParser(theEnv,"progn",PrognParse);
110 AddFunctionParser(theEnv,"if",IfParse);
111 AddFunctionParser(theEnv,"while",WhileParse);
112 AddFunctionParser(theEnv,"loop-for-count",LoopForCountParse);
113 AddFunctionParser(theEnv,"return",ReturnParse);
114 AddFunctionParser(theEnv,"break",BreakParse);
115 AddFunctionParser(theEnv,"switch",SwitchParse);
116 #endif
117 }
118
119 /*************************************************************/
120 /* DeallocateProceduralFunctionData: Deallocates environment */
121 /* data for procedural functions. */
122 /*************************************************************/
DeallocateProceduralFunctionData(void * theEnv)123 static void DeallocateProceduralFunctionData(
124 void *theEnv)
125 {
126 struct BindInfo *temp_bind;
127
128 while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL)
129 {
130 temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next;
131 rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames);
132 ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind;
133 }
134 }
135
136 /********************************************************/
137 /* GetParsedBindNames: */
138 /********************************************************/
GetParsedBindNames(void * theEnv)139 globle struct BindInfo *GetParsedBindNames(
140 void *theEnv)
141 {
142 return(ProcedureParserData(theEnv)->ListOfParsedBindNames);
143 }
144
145 /********************************************************/
146 /* SetParsedBindNames: */
147 /********************************************************/
SetParsedBindNames(void * theEnv,struct BindInfo * newValue)148 globle void SetParsedBindNames(
149 void *theEnv,
150 struct BindInfo *newValue)
151 {
152 ProcedureParserData(theEnv)->ListOfParsedBindNames = newValue;
153 }
154
155 /********************************************************/
156 /* ClearParsedBindNames: */
157 /********************************************************/
ClearParsedBindNames(void * theEnv)158 globle void ClearParsedBindNames(
159 void *theEnv)
160 {
161 struct BindInfo *temp_bind;
162
163 while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL)
164 {
165 temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next;
166 RemoveConstraint(theEnv,ProcedureParserData(theEnv)->ListOfParsedBindNames->constraints);
167 rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames);
168 ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind;
169 }
170 }
171
172 /********************************************************/
173 /* ParsedBindNamesEmpty: */
174 /********************************************************/
ParsedBindNamesEmpty(void * theEnv)175 globle intBool ParsedBindNamesEmpty(
176 void *theEnv)
177 {
178 if (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) return(FALSE);
179
180 return(TRUE);
181 }
182
183 #if (! BLOAD_ONLY)
184
185 /*********************************************************/
186 /* WhileParse: purpose is to parse the while statement. */
187 /* The parse of the statement is the return value. */
188 /* Syntax: (while <expression> do <action>+) */
189 /*********************************************************/
WhileParse(void * theEnv,struct expr * parse,const char * infile)190 static struct expr *WhileParse(
191 void *theEnv,
192 struct expr *parse,
193 const char *infile)
194 {
195 struct token theToken;
196 int read_first_paren;
197
198 /*===============================*/
199 /* Process the while expression. */
200 /*===============================*/
201
202 SavePPBuffer(theEnv," ");
203
204 parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);
205 if (parse->argList == NULL)
206 {
207 ReturnExpression(theEnv,parse);
208 return(NULL);
209 }
210
211 /*====================================*/
212 /* Process the do keyword if present. */
213 /*====================================*/
214
215 GetToken(theEnv,infile,&theToken);
216 if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
217 {
218 read_first_paren = TRUE;
219 PPBackup(theEnv);
220 SavePPBuffer(theEnv," ");
221 SavePPBuffer(theEnv,theToken.printForm);
222 IncrementIndentDepth(theEnv,3);
223 PPCRAndIndent(theEnv);
224 }
225 else if (theToken.type == LPAREN)
226 {
227 read_first_paren = FALSE;
228 PPBackup(theEnv);
229 IncrementIndentDepth(theEnv,3);
230 PPCRAndIndent(theEnv);
231 SavePPBuffer(theEnv,theToken.printForm);
232 }
233 else
234 {
235 SyntaxErrorMessage(theEnv,"while function");
236 ReturnExpression(theEnv,parse);
237 return(NULL);
238 }
239
240 /*============================*/
241 /* Process the while actions. */
242 /*============================*/
243 if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
244 ExpressionData(theEnv)->ReturnContext = TRUE;
245 ExpressionData(theEnv)->BreakContext = TRUE;
246 parse->argList->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);
247
248 if (parse->argList->nextArg == NULL)
249 {
250 ReturnExpression(theEnv,parse);
251 return(NULL);
252 }
253 PPBackup(theEnv);
254 PPBackup(theEnv);
255 SavePPBuffer(theEnv,theToken.printForm);
256
257 /*=======================================================*/
258 /* Check for the closing right parenthesis of the while. */
259 /*=======================================================*/
260
261 if (theToken.type != RPAREN)
262 {
263 SyntaxErrorMessage(theEnv,"while function");
264 ReturnExpression(theEnv,parse);
265 return(NULL);
266 }
267
268 DecrementIndentDepth(theEnv,3);
269
270 return(parse);
271 }
272
273 /******************************************************************************************/
274 /* LoopForCountParse: purpose is to parse the loop-for-count statement. */
275 /* The parse of the statement is the return value. */
276 /* Syntax: (loop-for-count <range> [do] <action>+) */
277 /* <range> ::= (<sf-var> [<start-integer-expression>] <end-integer-expression>) */
278 /******************************************************************************************/
LoopForCountParse(void * theEnv,struct expr * parse,const char * infile)279 static struct expr *LoopForCountParse(
280 void *theEnv,
281 struct expr *parse,
282 const char *infile)
283 {
284 struct token theToken;
285 SYMBOL_HN *loopVar = NULL;
286 EXPRESSION *tmpexp;
287 int read_first_paren;
288 struct BindInfo *oldBindList,*newBindList,*prev;
289
290 /*======================================*/
291 /* Process the loop counter expression. */
292 /*======================================*/
293
294 SavePPBuffer(theEnv," ");
295 GetToken(theEnv,infile,&theToken);
296
297 /* ==========================================
298 Simple form: loop-for-count <end> [do] ...
299 ========================================== */
300 if (theToken.type != LPAREN)
301 {
302 parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));
303 parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);
304 if (parse->argList->nextArg == NULL)
305 {
306 ReturnExpression(theEnv,parse);
307 return(NULL);
308 }
309 }
310 else
311 {
312 GetToken(theEnv,infile,&theToken);
313 if (theToken.type != SF_VARIABLE)
314 {
315 if (theToken.type != SYMBOL)
316 goto LoopForCountParseError;
317 parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));
318 parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value));
319 if (parse->argList->nextArg == NULL)
320 {
321 ReturnExpression(theEnv,parse);
322 return(NULL);
323 }
324 }
325
326 /* =============================================================
327 Complex form: loop-for-count (<var> [<start>] <end>) [do] ...
328 ============================================================= */
329 else
330 {
331 loopVar = (SYMBOL_HN *) theToken.value;
332 SavePPBuffer(theEnv," ");
333 parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);
334 if (parse->argList == NULL)
335 {
336 ReturnExpression(theEnv,parse);
337 return(NULL);
338 }
339 if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i'))
340 goto LoopForCountParseError;
341 SavePPBuffer(theEnv," ");
342 GetToken(theEnv,infile,&theToken);
343 if (theToken.type == RPAREN)
344 {
345 PPBackup(theEnv);
346 PPBackup(theEnv);
347 SavePPBuffer(theEnv,theToken.printForm);
348 tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));
349 tmpexp->nextArg = parse->argList;
350 parse->argList = tmpexp;
351 }
352 else
353 {
354 parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);
355 if (parse->argList->nextArg == NULL)
356 {
357 ReturnExpression(theEnv,parse);
358 return(NULL);
359 }
360 GetToken(theEnv,infile,&theToken);
361 if (theToken.type != RPAREN)
362 goto LoopForCountParseError;
363 }
364 SavePPBuffer(theEnv," ");
365 }
366 }
367
368 if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i'))
369 goto LoopForCountParseError;
370
371 /*====================================*/
372 /* Process the do keyword if present. */
373 /*====================================*/
374
375 GetToken(theEnv,infile,&theToken);
376 if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
377 {
378 read_first_paren = TRUE;
379 PPBackup(theEnv);
380 SavePPBuffer(theEnv," ");
381 SavePPBuffer(theEnv,theToken.printForm);
382 IncrementIndentDepth(theEnv,3);
383 PPCRAndIndent(theEnv);
384 }
385 else if (theToken.type == LPAREN)
386 {
387 read_first_paren = FALSE;
388 PPBackup(theEnv);
389 IncrementIndentDepth(theEnv,3);
390 PPCRAndIndent(theEnv);
391 SavePPBuffer(theEnv,theToken.printForm);
392 }
393 else
394 goto LoopForCountParseError;
395
396 /*=====================================*/
397 /* Process the loop-for-count actions. */
398 /*=====================================*/
399 if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
400 ExpressionData(theEnv)->ReturnContext = TRUE;
401 ExpressionData(theEnv)->BreakContext = TRUE;
402 oldBindList = GetParsedBindNames(theEnv);
403 SetParsedBindNames(theEnv,NULL);
404 parse->argList->nextArg->nextArg =
405 GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);
406
407 if (parse->argList->nextArg->nextArg == NULL)
408 {
409 SetParsedBindNames(theEnv,oldBindList);
410 ReturnExpression(theEnv,parse);
411 return(NULL);
412 }
413 newBindList = GetParsedBindNames(theEnv);
414 prev = NULL;
415 while (newBindList != NULL)
416 {
417 if ((loopVar == NULL) ? FALSE :
418 (strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0))
419 {
420 ClearParsedBindNames(theEnv);
421 SetParsedBindNames(theEnv,oldBindList);
422 PrintErrorID(theEnv,"PRCDRPSR",1,TRUE);
423 EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n");
424 ReturnExpression(theEnv,parse);
425 return(NULL);
426 }
427 prev = newBindList;
428 newBindList = newBindList->next;
429 }
430 if (prev == NULL)
431 SetParsedBindNames(theEnv,oldBindList);
432 else
433 prev->next = oldBindList;
434 if (loopVar != NULL)
435 ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0);
436 PPBackup(theEnv);
437 PPBackup(theEnv);
438 SavePPBuffer(theEnv,theToken.printForm);
439
440 /*================================================================*/
441 /* Check for the closing right parenthesis of the loop-for-count. */
442 /*================================================================*/
443
444 if (theToken.type != RPAREN)
445 {
446 SyntaxErrorMessage(theEnv,"loop-for-count function");
447 ReturnExpression(theEnv,parse);
448 return(NULL);
449 }
450
451 DecrementIndentDepth(theEnv,3);
452
453 return(parse);
454
455 LoopForCountParseError:
456 SyntaxErrorMessage(theEnv,"loop-for-count function");
457 ReturnExpression(theEnv,parse);
458 return(NULL);
459 }
460
461 /***************************************************/
462 /* ReplaceLoopCountVars */
463 /***************************************************/
ReplaceLoopCountVars(void * theEnv,SYMBOL_HN * loopVar,EXPRESSION * theExp,int depth)464 static void ReplaceLoopCountVars(
465 void *theEnv,
466 SYMBOL_HN *loopVar,
467 EXPRESSION *theExp,
468 int depth)
469 {
470 while (theExp != NULL)
471 {
472 if ((theExp->type != SF_VARIABLE) ? FALSE :
473 (strcmp(ValueToString(theExp->value),ValueToString(loopVar)) == 0))
474 {
475 theExp->type = FCALL;
476 theExp->value = (void *) FindFunction(theEnv,"(get-loop-count)");
477 theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long long) depth));
478 }
479 else if (theExp->argList != NULL)
480 {
481 if ((theExp->type != FCALL) ? FALSE :
482 (theExp->value == (void *) FindFunction(theEnv,"loop-for-count")))
483 ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth+1);
484 else
485 ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth);
486 }
487 theExp = theExp->nextArg;
488 }
489 }
490
491 /*********************************************************/
492 /* IfParse: purpose is to parse the if statement. The */
493 /* parse of the statement is the return value. */
494 /* Syntax: (if <expression> then <action>+ */
495 /* [ else <action>+ ] ) */
496 /*********************************************************/
IfParse(void * theEnv,struct expr * top,const char * infile)497 static struct expr *IfParse(
498 void *theEnv,
499 struct expr *top,
500 const char *infile)
501 {
502 struct token theToken;
503
504 /*============================*/
505 /* Process the if expression. */
506 /*============================*/
507
508 SavePPBuffer(theEnv," ");
509
510 top->argList = ParseAtomOrExpression(theEnv,infile,NULL);
511
512 if (top->argList == NULL)
513 {
514 ReturnExpression(theEnv,top);
515 return(NULL);
516 }
517
518 /*========================================*/
519 /* Keyword 'then' must follow expression. */
520 /*========================================*/
521
522 IncrementIndentDepth(theEnv,3);
523 PPCRAndIndent(theEnv);
524
525 GetToken(theEnv,infile,&theToken);
526 if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0))
527 {
528 SyntaxErrorMessage(theEnv,"if function");
529 ReturnExpression(theEnv,top);
530 return(NULL);
531 }
532
533 /*==============================*/
534 /* Process the if then actions. */
535 /*==============================*/
536
537 PPCRAndIndent(theEnv);
538 if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
539 ExpressionData(theEnv)->ReturnContext = TRUE;
540 if (ExpressionData(theEnv)->svContexts->brk == TRUE)
541 ExpressionData(theEnv)->BreakContext = TRUE;
542 top->argList->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,"else",FALSE);
543
544 if (top->argList->nextArg == NULL)
545 {
546 ReturnExpression(theEnv,top);
547 return(NULL);
548 }
549
550 top->argList->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg);
551
552 /*===========================================*/
553 /* A ')' signals an if then without an else. */
554 /*===========================================*/
555
556 if (theToken.type == RPAREN)
557 {
558 DecrementIndentDepth(theEnv,3);
559 PPBackup(theEnv);
560 PPBackup(theEnv);
561 SavePPBuffer(theEnv,theToken.printForm);
562 return(top);
563 }
564
565 /*=============================================*/
566 /* Keyword 'else' must follow if then actions. */
567 /*=============================================*/
568
569 if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"else") != 0))
570 {
571 SyntaxErrorMessage(theEnv,"if function");
572 ReturnExpression(theEnv,top);
573 return(NULL);
574 }
575
576 /*==============================*/
577 /* Process the if else actions. */
578 /*==============================*/
579
580 PPCRAndIndent(theEnv);
581 top->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);
582
583 if (top->argList->nextArg->nextArg == NULL)
584 {
585 ReturnExpression(theEnv,top);
586 return(NULL);
587 }
588
589 top->argList->nextArg->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg->nextArg);
590
591 /*======================================================*/
592 /* Check for the closing right parenthesis of the if. */
593 /*======================================================*/
594
595 if (theToken.type != RPAREN)
596 {
597 SyntaxErrorMessage(theEnv,"if function");
598 ReturnExpression(theEnv,top);
599 return(NULL);
600 }
601
602 /*===========================================*/
603 /* A ')' signals an if then without an else. */
604 /*===========================================*/
605
606 PPBackup(theEnv);
607 PPBackup(theEnv);
608 SavePPBuffer(theEnv,")");
609 DecrementIndentDepth(theEnv,3);
610 return(top);
611 }
612
613 /********************************************************/
614 /* PrognParse: purpose is to parse the progn statement. */
615 /* The parse of the statement is the return value. */
616 /* Syntax: (progn <expression>*) */
617 /********************************************************/
PrognParse(void * theEnv,struct expr * top,const char * infile)618 static struct expr *PrognParse(
619 void *theEnv,
620 struct expr *top,
621 const char *infile)
622 {
623 struct token tkn;
624 struct expr *tmp;
625
626 ReturnExpression(theEnv,top);
627 ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk;
628 ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
629 IncrementIndentDepth(theEnv,3);
630 PPCRAndIndent(theEnv);
631 tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE);
632 DecrementIndentDepth(theEnv,3);
633 PPBackup(theEnv);
634 PPBackup(theEnv);
635 SavePPBuffer(theEnv,tkn.printForm);
636 return(tmp);
637 }
638
639 /***********************************************************/
640 /* BindParse: purpose is to parse the bind statement. The */
641 /* parse of the statement is the return value. */
642 /* Syntax: (bind ?var <expression>) */
643 /***********************************************************/
BindParse(void * theEnv,struct expr * top,const char * infile)644 static struct expr *BindParse(
645 void *theEnv,
646 struct expr *top,
647 const char *infile)
648 {
649 struct token theToken;
650 SYMBOL_HN *variableName;
651 struct expr *texp;
652 CONSTRAINT_RECORD *theConstraint = NULL;
653 #if DEFGLOBAL_CONSTRUCT
654 struct defglobal *theGlobal;
655 int count;
656 #endif
657
658 SavePPBuffer(theEnv," ");
659
660 /*=============================================*/
661 /* Next token must be the name of the variable */
662 /* to be bound. */
663 /*=============================================*/
664
665 GetToken(theEnv,infile,&theToken);
666 if ((theToken.type != SF_VARIABLE) && (theToken.type != GBL_VARIABLE))
667 {
668 if ((theToken.type != MF_VARIABLE) || ExpressionData(theEnv)->SequenceOpMode)
669 {
670 SyntaxErrorMessage(theEnv,"bind function");
671 ReturnExpression(theEnv,top);
672 return(NULL);
673 }
674 }
675
676 /*==============================*/
677 /* Process the bind expression. */
678 /*==============================*/
679
680 top->argList = GenConstant(theEnv,SYMBOL,theToken.value);
681 variableName = (SYMBOL_HN *) theToken.value;
682
683 #if DEFGLOBAL_CONSTRUCT
684 if ((theToken.type == GBL_VARIABLE) ?
685 ((theGlobal = (struct defglobal *)
686 FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(variableName),
687 &count,TRUE,FALSE)) != NULL) :
688 FALSE)
689 {
690 top->argList->type = DEFGLOBAL_PTR;
691 top->argList->value = (void *) theGlobal;
692 }
693 else if (theToken.type == GBL_VARIABLE)
694 {
695 GlobalReferenceErrorMessage(theEnv,ValueToString(variableName));
696 ReturnExpression(theEnv,top);
697 return(NULL);
698 }
699 #endif
700
701 texp = get_struct(theEnv,expr);
702 texp->argList = texp->nextArg = NULL;
703 if (CollectArguments(theEnv,texp,infile) == NULL)
704 {
705 ReturnExpression(theEnv,top);
706 return(NULL);
707 }
708
709 top->argList->nextArg = texp->argList;
710 rtn_struct(theEnv,expr,texp);
711
712 #if DEFGLOBAL_CONSTRUCT
713 if (top->argList->type == DEFGLOBAL_PTR) return(top);
714 #endif
715
716 if (top->argList->nextArg != NULL)
717 { theConstraint = ExpressionToConstraintRecord(theEnv,top->argList->nextArg); }
718
719 AddBindName(theEnv,variableName,theConstraint);
720
721 return(top);
722 }
723
724 /********************************************/
725 /* ReturnParse: Parses the return function. */
726 /********************************************/
ReturnParse(void * theEnv,struct expr * top,const char * infile)727 static struct expr *ReturnParse(
728 void *theEnv,
729 struct expr *top,
730 const char *infile)
731 {
732 int error_flag = FALSE;
733 struct token theToken;
734
735 if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
736 ExpressionData(theEnv)->ReturnContext = TRUE;
737 if (ExpressionData(theEnv)->ReturnContext == FALSE)
738 {
739 PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
740 EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n");
741 ReturnExpression(theEnv,top);
742 return(NULL);
743 }
744 ExpressionData(theEnv)->ReturnContext = FALSE;
745
746 SavePPBuffer(theEnv," ");
747
748 top->argList = ArgumentParse(theEnv,infile,&error_flag);
749 if (error_flag)
750 {
751 ReturnExpression(theEnv,top);
752 return(NULL);
753 }
754 else if (top->argList == NULL)
755 {
756 PPBackup(theEnv);
757 PPBackup(theEnv);
758 SavePPBuffer(theEnv,")");
759 }
760 else
761 {
762 SavePPBuffer(theEnv," ");
763 GetToken(theEnv,infile,&theToken);
764 if (theToken.type != RPAREN)
765 {
766 SyntaxErrorMessage(theEnv,"return function");
767 ReturnExpression(theEnv,top);
768 return(NULL);
769 }
770 PPBackup(theEnv);
771 PPBackup(theEnv);
772 SavePPBuffer(theEnv,")");
773 }
774 return(top);
775 }
776
777 /**********************************************/
778 /* BreakParse: */
779 /**********************************************/
BreakParse(void * theEnv,struct expr * top,const char * infile)780 static struct expr *BreakParse(
781 void *theEnv,
782 struct expr *top,
783 const char *infile)
784 {
785 struct token theToken;
786
787 if (ExpressionData(theEnv)->svContexts->brk == FALSE)
788 {
789 PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
790 EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n");
791 ReturnExpression(theEnv,top);
792 return(NULL);
793 }
794
795 SavePPBuffer(theEnv," ");
796 GetToken(theEnv,infile,&theToken);
797 if (theToken.type != RPAREN)
798 {
799 SyntaxErrorMessage(theEnv,"break function");
800 ReturnExpression(theEnv,top);
801 return(NULL);
802 }
803 PPBackup(theEnv);
804 PPBackup(theEnv);
805 SavePPBuffer(theEnv,")");
806 return(top);
807 }
808
809 /**********************************************/
810 /* SwitchParse: */
811 /**********************************************/
SwitchParse(void * theEnv,struct expr * top,const char * infile)812 static struct expr *SwitchParse(
813 void *theEnv,
814 struct expr *top,
815 const char *infile)
816 {
817 struct token theToken;
818 EXPRESSION *theExp,*chk;
819 int default_count = 0;
820
821 /*============================*/
822 /* Process the switch value */
823 /*============================*/
824 IncrementIndentDepth(theEnv,3);
825 SavePPBuffer(theEnv," ");
826 top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL);
827 if (theExp == NULL)
828 goto SwitchParseError;
829
830 /*========================*/
831 /* Parse case statements. */
832 /*========================*/
833 GetToken(theEnv,infile,&theToken);
834 while (theToken.type != RPAREN)
835 {
836 PPBackup(theEnv);
837 PPCRAndIndent(theEnv);
838 SavePPBuffer(theEnv,theToken.printForm);
839 if (theToken.type != LPAREN)
840 goto SwitchParseErrorAndMessage;
841 GetToken(theEnv,infile,&theToken);
842 SavePPBuffer(theEnv," ");
843 if ((theToken.type == SYMBOL) &&
844 (strcmp(ValueToString(theToken.value),"case") == 0))
845 {
846 if (default_count != 0)
847 goto SwitchParseErrorAndMessage;
848 theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL);
849 SavePPBuffer(theEnv," ");
850 if (theExp->nextArg == NULL)
851 goto SwitchParseError;
852 for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg)
853 {
854 if ((chk->type == theExp->nextArg->type) &&
855 (chk->value == theExp->nextArg->value) &&
856 IdenticalExpression(chk->argList,theExp->nextArg->argList))
857 {
858 PrintErrorID(theEnv,"PRCDRPSR",3,TRUE);
859 EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n");
860 goto SwitchParseError;
861 }
862 }
863 GetToken(theEnv,infile,&theToken);
864 if ((theToken.type != SYMBOL) ? TRUE :
865 (strcmp(ValueToString(theToken.value),"then") != 0))
866 goto SwitchParseErrorAndMessage;
867 }
868 else if ((theToken.type == SYMBOL) &&
869 (strcmp(ValueToString(theToken.value),"default") == 0))
870 {
871 if (default_count)
872 goto SwitchParseErrorAndMessage;
873 theExp->nextArg = GenConstant(theEnv,RVOID,NULL);
874 default_count = 1;
875 }
876 else
877 goto SwitchParseErrorAndMessage;
878 theExp = theExp->nextArg;
879 if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
880 ExpressionData(theEnv)->ReturnContext = TRUE;
881 if (ExpressionData(theEnv)->svContexts->brk == TRUE)
882 ExpressionData(theEnv)->BreakContext = TRUE;
883 IncrementIndentDepth(theEnv,3);
884 PPCRAndIndent(theEnv);
885 theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);
886 DecrementIndentDepth(theEnv,3);
887 ExpressionData(theEnv)->ReturnContext = FALSE;
888 ExpressionData(theEnv)->BreakContext = FALSE;
889 if (theExp->nextArg == NULL)
890 goto SwitchParseError;
891 theExp = theExp->nextArg;
892 PPBackup(theEnv);
893 PPBackup(theEnv);
894 SavePPBuffer(theEnv,theToken.printForm);
895 GetToken(theEnv,infile,&theToken);
896 }
897 DecrementIndentDepth(theEnv,3);
898 return(top);
899
900 SwitchParseErrorAndMessage:
901 SyntaxErrorMessage(theEnv,"switch function");
902 SwitchParseError:
903 ReturnExpression(theEnv,top);
904 DecrementIndentDepth(theEnv,3);
905 return(NULL);
906 }
907
908 /********************************************************/
909 /* SearchParsedBindNames: */
910 /********************************************************/
SearchParsedBindNames(void * theEnv,SYMBOL_HN * name_sought)911 globle int SearchParsedBindNames(
912 void *theEnv,
913 SYMBOL_HN *name_sought)
914 {
915 struct BindInfo *var_ptr;
916 int theIndex = 1;
917
918 var_ptr = ProcedureParserData(theEnv)->ListOfParsedBindNames;
919 while (var_ptr != NULL)
920 {
921 if (var_ptr->name == name_sought)
922 { return(theIndex); }
923 var_ptr = var_ptr->next;
924 theIndex++;
925 }
926
927 return(0);
928 }
929
930 /********************************************************/
931 /* FindBindConstraints: */
932 /********************************************************/
FindBindConstraints(void * theEnv,SYMBOL_HN * nameSought)933 globle struct constraintRecord *FindBindConstraints(
934 void *theEnv,
935 SYMBOL_HN *nameSought)
936 {
937 struct BindInfo *theVariable;
938
939 theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames;
940 while (theVariable != NULL)
941 {
942 if (theVariable->name == nameSought)
943 { return(theVariable->constraints); }
944 theVariable = theVariable->next;
945 }
946
947 return(NULL);
948 }
949
950 /********************************************************/
951 /* CountParsedBindNames: Counts the number of variables */
952 /* names that have been bound using the bind function */
953 /* in the current context (e.g. the RHS of a rule). */
954 /********************************************************/
CountParsedBindNames(void * theEnv)955 globle int CountParsedBindNames(
956 void *theEnv)
957 {
958 struct BindInfo *theVariable;
959 int theIndex = 0;
960
961 theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames;
962 while (theVariable != NULL)
963 {
964 theVariable = theVariable->next;
965 theIndex++;
966 }
967
968 return(theIndex);
969 }
970
971 /****************************************************************/
972 /* AddBindName: Adds a variable name used as the first argument */
973 /* of the bind function to the list of variable names parsed */
974 /* within the current semantic context (e.g. RHS of a rule). */
975 /****************************************************************/
AddBindName(void * theEnv,SYMBOL_HN * variableName,CONSTRAINT_RECORD * theConstraint)976 static int AddBindName(
977 void *theEnv,
978 SYMBOL_HN *variableName,
979 CONSTRAINT_RECORD *theConstraint)
980 {
981 CONSTRAINT_RECORD *tmpConstraint;
982 struct BindInfo *currentBind, *lastBind;
983 int theIndex = 1;
984
985 /*=========================================================*/
986 /* Look for the variable name in the list of bind variable */
987 /* names already parsed. If it is found, then return the */
988 /* index to the variable and union the new constraint */
989 /* information with the old constraint information. */
990 /*=========================================================*/
991
992 lastBind = NULL;
993 currentBind = ProcedureParserData(theEnv)->ListOfParsedBindNames;
994 while (currentBind != NULL)
995 {
996 if (currentBind->name == variableName)
997 {
998 if (theConstraint != NULL)
999 {
1000 tmpConstraint = currentBind->constraints;
1001 currentBind->constraints = UnionConstraints(theEnv,theConstraint,currentBind->constraints);
1002 RemoveConstraint(theEnv,tmpConstraint);
1003 RemoveConstraint(theEnv,theConstraint);
1004 }
1005
1006 return(theIndex);
1007 }
1008 lastBind = currentBind;
1009 currentBind = currentBind->next;
1010 theIndex++;
1011 }
1012
1013 /*===============================================================*/
1014 /* If the variable name wasn't found, then add it to the list of */
1015 /* variable names and store the constraint information with it. */
1016 /*===============================================================*/
1017
1018 currentBind = get_struct(theEnv,BindInfo);
1019 currentBind->name = variableName;
1020 currentBind->constraints = theConstraint;
1021 currentBind->next = NULL;
1022
1023 if (lastBind == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = currentBind;
1024 else lastBind->next = currentBind;
1025
1026 return(theIndex);
1027 }
1028
1029 /********************************************************/
1030 /* RemoveParsedBindName: */
1031 /********************************************************/
RemoveParsedBindName(void * theEnv,struct symbolHashNode * bname)1032 globle void RemoveParsedBindName(
1033 void *theEnv,
1034 struct symbolHashNode *bname)
1035 {
1036 struct BindInfo *prv,*tmp;
1037
1038 prv = NULL;
1039 tmp = ProcedureParserData(theEnv)->ListOfParsedBindNames;
1040 while ((tmp != NULL) ? (tmp->name != bname) : FALSE)
1041 {
1042 prv = tmp;
1043 tmp = tmp->next;
1044 }
1045 if (tmp != NULL)
1046 {
1047 if (prv == NULL)
1048 ProcedureParserData(theEnv)->ListOfParsedBindNames = tmp->next;
1049 else
1050 prv->next = tmp->next;
1051
1052 RemoveConstraint(theEnv,tmp->constraints);
1053 rtn_struct(theEnv,BindInfo,tmp);
1054 }
1055 }
1056
1057 #endif
1058
1059 #endif
1060
1061