1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 02/05/15 */
5 /* */
6 /* INSTANCE PARSER MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Instance Function Parsing Routines */
11 /* */
12 /* Principal Programmer(s): */
13 /* Brian L. Dantes */
14 /* */
15 /* Contributing Programmer(s): */
16 /* */
17 /* Revision History: */
18 /* */
19 /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */
20 /* */
21 /* Changed name of variable exp to theExp */
22 /* because of Unix compiler warnings of shadowed */
23 /* definitions. */
24 /* */
25 /* 6.24: Renamed BOOLEAN macro type to intBool. */
26 /* */
27 /* 6.30: Added const qualifiers to remove C++ */
28 /* deprecation warnings. */
29 /* */
30 /* Fixed ParseSlotOverrides memory release issue. */
31 /* */
32 /* It's now possible to create an instance of a */
33 /* class that's not in scope if the module name */
34 /* is specified. */
35 /* */
36 /* Added code to keep track of pointers to */
37 /* constructs that are contained externally to */
38 /* to constructs, DanglingConstructs. */
39 /* */
40 /*************************************************************/
41
42 /* =========================================
43 *****************************************
44 EXTERNAL DEFINITIONS
45 =========================================
46 ***************************************** */
47 #include "setup.h"
48
49 #if OBJECT_SYSTEM
50
51 #ifndef _STDIO_INCLUDED_
52 #define _STDIO_INCLUDED_
53 #include <stdio.h>
54 #endif
55
56 #include <string.h>
57
58 #include "classcom.h"
59 #include "classfun.h"
60 #include "classinf.h"
61 #include "constant.h"
62 #include "envrnmnt.h"
63 #include "evaluatn.h"
64 #include "exprnpsr.h"
65 #include "extnfunc.h"
66 #include "moduldef.h"
67 #include "prntutil.h"
68 #include "router.h"
69
70 #define _INSPSR_SOURCE_
71 #include "inspsr.h"
72
73 /* =========================================
74 *****************************************
75 CONSTANTS
76 =========================================
77 ***************************************** */
78 #define MAKE_TYPE 0
79 #define INITIALIZE_TYPE 1
80 #define MODIFY_TYPE 2
81 #define DUPLICATE_TYPE 3
82
83 #define CLASS_RLN "of"
84 #define DUPLICATE_NAME_REF "to"
85
86 /* =========================================
87 *****************************************
88 INTERNALLY VISIBLE FUNCTION HEADERS
89 =========================================
90 ***************************************** */
91
92 static intBool ReplaceClassNameWithReference(void *,EXPRESSION *);
93
94 /* =========================================
95 *****************************************
96 EXTERNALLY VISIBLE FUNCTIONS
97 =========================================
98 ***************************************** */
99
100 #if ! RUN_TIME
101
102 /*************************************************************************************
103 NAME : ParseInitializeInstance
104 DESCRIPTION : Parses initialize-instance and make-instance function
105 calls into an EXPRESSION form that
106 can later be evaluated with EvaluateExpression(theEnv,)
107 INPUTS : 1) The address of the top node of the expression
108 containing the initialize-instance function call
109 2) The logical name of the input source
110 RETURNS : The address of the modified expression, or NULL
111 if there is an error
112 SIDE EFFECTS : The expression is enhanced to include all
113 aspects of the initialize-instance call
114 (slot-overrides etc.)
115 The "top" expression is deleted on errors.
116 NOTES : This function parses a initialize-instance call into
117 an expression of the following form :
118
119 (initialize-instance <instance-name> <slot-override>*)
120 where <slot-override> ::= (<slot-name> <expression>+)
121
122 goes to -->
123
124 initialize-instance
125 |
126 V
127 <instance or name>-><slot-name>-><dummy-node>...
128 |
129 V
130 <value-expression>...
131
132 (make-instance <instance> of <class> <slot-override>*)
133 goes to -->
134
135 make-instance
136 |
137 V
138 <instance-name>-><class-name>-><slot-name>-><dummy-node>...
139 |
140 V
141 <value-expression>...
142
143 (make-instance of <class> <slot-override>*)
144 goes to -->
145
146 make-instance
147 |
148 V
149 (gensym*)-><class-name>-><slot-name>-><dummy-node>...
150 |
151 V
152 <value-expression>...
153
154 (modify-instance <instance> <slot-override>*)
155 goes to -->
156
157 modify-instance
158 |
159 V
160 <instance or name>-><slot-name>-><dummy-node>...
161 |
162 V
163 <value-expression>...
164
165 (duplicate-instance <instance> [to <new-name>] <slot-override>*)
166 goes to -->
167
168 duplicate-instance
169 |
170 V
171 <instance or name>-><new-name>-><slot-name>-><dummy-node>...
172 OR |
173 (gensym*) V
174 <value-expression>...
175
176 *************************************************************************************/
ParseInitializeInstance(void * theEnv,EXPRESSION * top,const char * readSource)177 globle EXPRESSION *ParseInitializeInstance(
178 void *theEnv,
179 EXPRESSION *top,
180 const char *readSource)
181 {
182 int error,fcalltype,readclass;
183
184 if ((top->value == (void *) FindFunction(theEnv,"make-instance")) ||
185 (top->value == (void *) FindFunction(theEnv,"active-make-instance")))
186 fcalltype = MAKE_TYPE;
187 else if ((top->value == (void *) FindFunction(theEnv,"initialize-instance")) ||
188 (top->value == (void *) FindFunction(theEnv,"active-initialize-instance")))
189 fcalltype = INITIALIZE_TYPE;
190 else if ((top->value == (void *) FindFunction(theEnv,"modify-instance")) ||
191 (top->value == (void *) FindFunction(theEnv,"active-modify-instance")) ||
192 (top->value == (void *) FindFunction(theEnv,"message-modify-instance")) ||
193 (top->value == (void *) FindFunction(theEnv,"active-message-modify-instance")))
194 fcalltype = MODIFY_TYPE;
195 else
196 fcalltype = DUPLICATE_TYPE;
197 IncrementIndentDepth(theEnv,3);
198 error = FALSE;
199 if (top->type == UNKNOWN_VALUE)
200 top->type = FCALL;
201 else
202 SavePPBuffer(theEnv," ");
203 top->argList = ArgumentParse(theEnv,readSource,&error);
204 if (error)
205 goto ParseInitializeInstanceError;
206 else if (top->argList == NULL)
207 {
208 SyntaxErrorMessage(theEnv,"instance");
209 goto ParseInitializeInstanceError;
210 }
211 SavePPBuffer(theEnv," ");
212
213 if (fcalltype == MAKE_TYPE)
214 {
215 /* ======================================
216 Handle the case of anonymous instances
217 where the name was not specified
218 ====================================== */
219 if ((top->argList->type != SYMBOL) ? FALSE :
220 (strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0))
221 {
222 top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
223 if (error == TRUE)
224 goto ParseInitializeInstanceError;
225 if (top->argList->nextArg == NULL)
226 {
227 SyntaxErrorMessage(theEnv,"instance class");
228 goto ParseInitializeInstanceError;
229 }
230 if ((top->argList->nextArg->type != SYMBOL) ? TRUE :
231 (strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0))
232 {
233 top->argList->type = FCALL;
234 top->argList->value = (void *) FindFunction(theEnv,"gensym*");
235 readclass = FALSE;
236 }
237 else
238 readclass = TRUE;
239 }
240 else
241 {
242 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
243 if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
244 (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0))
245 {
246 SyntaxErrorMessage(theEnv,"make-instance");
247 goto ParseInitializeInstanceError;
248 }
249 SavePPBuffer(theEnv," ");
250 readclass = TRUE;
251 }
252 if (readclass)
253 {
254 top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
255 if (error)
256 goto ParseInitializeInstanceError;
257 if (top->argList->nextArg == NULL)
258 {
259 SyntaxErrorMessage(theEnv,"instance class");
260 goto ParseInitializeInstanceError;
261 }
262 }
263
264 /* ==============================================
265 If the class name is a constant, go ahead and
266 look it up now and replace it with the pointer
267 ============================================== */
268 if (ReplaceClassNameWithReference(theEnv,top->argList->nextArg) == FALSE)
269 goto ParseInitializeInstanceError;
270
271 PPCRAndIndent(theEnv);
272 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
273 top->argList->nextArg->nextArg =
274 ParseSlotOverrides(theEnv,readSource,&error);
275 }
276 else
277 {
278 PPCRAndIndent(theEnv);
279 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
280 if (fcalltype == DUPLICATE_TYPE)
281 {
282 if ((DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) ? FALSE :
283 (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DUPLICATE_NAME_REF) == 0))
284 {
285 PPBackup(theEnv);
286 PPBackup(theEnv);
287 SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
288 SavePPBuffer(theEnv," ");
289 top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
290 if (error)
291 goto ParseInitializeInstanceError;
292 if (top->argList->nextArg == NULL)
293 {
294 SyntaxErrorMessage(theEnv,"instance name");
295 goto ParseInitializeInstanceError;
296 }
297 PPCRAndIndent(theEnv);
298 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
299 }
300 else
301 top->argList->nextArg = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"gensym*"));
302 top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error);
303 }
304 else
305 top->argList->nextArg = ParseSlotOverrides(theEnv,readSource,&error);
306 }
307 if (error)
308 goto ParseInitializeInstanceError;
309 if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
310 {
311 SyntaxErrorMessage(theEnv,"slot-override");
312 goto ParseInitializeInstanceError;
313 }
314 DecrementIndentDepth(theEnv,3);
315 return(top);
316
317 ParseInitializeInstanceError:
318 SetEvaluationError(theEnv,TRUE);
319 ReturnExpression(theEnv,top);
320 DecrementIndentDepth(theEnv,3);
321 return(NULL);
322 }
323
324 /********************************************************************************
325 NAME : ParseSlotOverrides
326 DESCRIPTION : Forms expressions for slot-overrides
327 INPUTS : 1) The logical name of the input
328 2) Caller's buffer for error flkag
329 RETURNS : Address override expressions, NULL
330 if none or error.
331 SIDE EFFECTS : Slot-expression built
332 Caller's error flag set
333 NOTES : <slot-override> ::= (<slot-name> <value>*)*
334
335 goes to
336
337 <slot-name> --> <dummy-node> --> <slot-name> --> <dummy-node>...
338 |
339 V
340 <value-expression> --> <value-expression> --> ...
341
342 Assumes first token has already been scanned
343 ********************************************************************************/
ParseSlotOverrides(void * theEnv,const char * readSource,int * error)344 globle EXPRESSION *ParseSlotOverrides(
345 void *theEnv,
346 const char *readSource,
347 int *error)
348 {
349 EXPRESSION *top = NULL,*bot = NULL,*theExp;
350 EXPRESSION *theExpNext;
351
352 while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
353 {
354 *error = FALSE;
355 theExp = ArgumentParse(theEnv,readSource,error);
356 if (*error == TRUE)
357 {
358 ReturnExpression(theEnv,top);
359 return(NULL);
360 }
361 else if (theExp == NULL)
362 {
363 SyntaxErrorMessage(theEnv,"slot-override");
364 *error = TRUE;
365 ReturnExpression(theEnv,top);
366 SetEvaluationError(theEnv,TRUE);
367 return(NULL);
368 }
369 theExpNext = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv));
370 if (CollectArguments(theEnv,theExpNext,readSource) == NULL)
371 {
372 *error = TRUE;
373 ReturnExpression(theEnv,top);
374 ReturnExpression(theEnv,theExp);
375 return(NULL);
376 }
377 theExp->nextArg = theExpNext;
378 if (top == NULL)
379 top = theExp;
380 else
381 bot->nextArg = theExp;
382 bot = theExp->nextArg;
383 PPCRAndIndent(theEnv);
384 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
385 }
386 PPBackup(theEnv);
387 PPBackup(theEnv);
388 SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
389 return(top);
390 }
391
392 #endif
393
394 /****************************************************************************
395 NAME : ParseSimpleInstance
396 DESCRIPTION : Parses instances from file for load-instances
397 into an EXPRESSION forms that
398 can later be evaluated with EvaluateExpression(theEnv,)
399 INPUTS : 1) The address of the top node of the expression
400 containing the make-instance function call
401 2) The logical name of the input source
402 RETURNS : The address of the modified expression, or NULL
403 if there is an error
404 SIDE EFFECTS : The expression is enhanced to include all
405 aspects of the make-instance call
406 (slot-overrides etc.)
407 The "top" expression is deleted on errors.
408 NOTES : The name, class, values etc. must be constants.
409
410 This function parses a make-instance call into
411 an expression of the following form :
412
413 (make-instance <instance> of <class> <slot-override>*)
414 where <slot-override> ::= (<slot-name> <expression>+)
415
416 goes to -->
417
418 make-instance
419 |
420 V
421 <instance-name>-><class-name>-><slot-name>-><dummy-node>...
422 |
423 V
424 <value-expression>...
425
426 ****************************************************************************/
ParseSimpleInstance(void * theEnv,EXPRESSION * top,const char * readSource)427 globle EXPRESSION *ParseSimpleInstance(
428 void *theEnv,
429 EXPRESSION *top,
430 const char *readSource)
431 {
432 EXPRESSION *theExp,*vals = NULL,*vbot,*tval;
433 unsigned short type;
434
435 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
436 if ((GetType(DefclassData(theEnv)->ObjectParseToken) != INSTANCE_NAME) &&
437 (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL))
438 goto MakeInstanceError;
439
440 if ((GetType(DefclassData(theEnv)->ObjectParseToken) == SYMBOL) &&
441 (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) == 0))
442 {
443 top->argList = GenConstant(theEnv,FCALL,
444 (void *) FindFunction(theEnv,"gensym*"));
445 }
446 else
447 {
448 top->argList = GenConstant(theEnv,INSTANCE_NAME,
449 (void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
450 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
451 if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
452 (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0))
453 goto MakeInstanceError;
454 }
455
456 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
457 if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
458 goto MakeInstanceError;
459 top->argList->nextArg =
460 GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
461 theExp = top->argList->nextArg;
462 if (ReplaceClassNameWithReference(theEnv,theExp) == FALSE)
463 goto MakeInstanceError;
464 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
465 while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
466 {
467 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
468 if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
469 goto SlotOverrideError;
470 theExp->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
471 theExp->nextArg->nextArg = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv));
472 theExp = theExp->nextArg->nextArg;
473 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
474 vbot = NULL;
475 while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
476 {
477 type = GetType(DefclassData(theEnv)->ObjectParseToken);
478 if (type == LPAREN)
479 {
480 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
481 if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
482 (strcmp(ValueToString(DefclassData(theEnv)->ObjectParseToken.value),"create$") != 0))
483 goto SlotOverrideError;
484 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
485 if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
486 goto SlotOverrideError;
487 tval = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));
488 }
489 else
490 {
491 if ((type != SYMBOL) && (type != STRING) &&
492 (type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME))
493 goto SlotOverrideError;
494 tval = GenConstant(theEnv,type,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
495 }
496 if (vals == NULL)
497 vals = tval;
498 else
499 vbot->nextArg = tval;
500 vbot = tval;
501 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
502 }
503 theExp->argList = vals;
504 GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
505 vals = NULL;
506 }
507 if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
508 goto SlotOverrideError;
509 return(top);
510
511 MakeInstanceError:
512 SyntaxErrorMessage(theEnv,"make-instance");
513 SetEvaluationError(theEnv,TRUE);
514 ReturnExpression(theEnv,top);
515 return(NULL);
516
517 SlotOverrideError:
518 SyntaxErrorMessage(theEnv,"slot-override");
519 SetEvaluationError(theEnv,TRUE);
520 ReturnExpression(theEnv,top);
521 ReturnExpression(theEnv,vals);
522 return(NULL);
523 }
524
525 /* =========================================
526 *****************************************
527 INTERNALLY VISIBLE FUNCTIONS
528 =========================================
529 ***************************************** */
530
531 /***************************************************
532 NAME : ReplaceClassNameWithReference
533 DESCRIPTION : In parsing a make instance call,
534 this function replaces a constant
535 class name with an actual pointer
536 to the class
537 INPUTS : The expression
538 RETURNS : TRUE if all OK, FALSE
539 if class cannot be found
540 SIDE EFFECTS : The expression type and value are
541 modified if class is found
542 NOTES : Searches current nd imported
543 modules for reference
544 CHANGES : It's now possible to create an instance of a
545 class that's not in scope if the module name
546 is specified.
547 ***************************************************/
ReplaceClassNameWithReference(void * theEnv,EXPRESSION * theExp)548 static intBool ReplaceClassNameWithReference(
549 void *theEnv,
550 EXPRESSION *theExp)
551 {
552 const char *theClassName;
553 void *theDefclass;
554
555 if (theExp->type == SYMBOL)
556 {
557 theClassName = ValueToString(theExp->value);
558 //theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName);
559 theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); // Module or scope is now allowed
560 if (theDefclass == NULL)
561 {
562 CantFindItemErrorMessage(theEnv,"class",theClassName);
563 return(FALSE);
564 }
565 if (EnvClassAbstractP(theEnv,theDefclass))
566 {
567 PrintErrorID(theEnv,"INSMNGR",3,FALSE);
568 EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class ");
569 EnvPrintRouter(theEnv,WERROR,theClassName);
570 EnvPrintRouter(theEnv,WERROR,".\n");
571 return(FALSE);
572 }
573 theExp->type = DEFCLASS_PTR;
574 theExp->value = theDefclass;
575
576 #if (! RUN_TIME) && (! BLOAD_ONLY)
577 if (! ConstructData(theEnv)->ParsingConstruct)
578 { ConstructData(theEnv)->DanglingConstructs++; }
579 #endif
580 }
581 return(TRUE);
582 }
583
584 #endif
585
586
587
588