1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 01/25/15 */
5 /* */
6 /* */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Deffunction Parsing Routines */
11 /* */
12 /* Principal Programmer(s): */
13 /* Brian L. Dantes */
14 /* */
15 /* Contributing Programmer(s): */
16 /* */
17 /* Revision History: */
18 /* */
19 /* 6.24: Renamed BOOLEAN macro type to intBool. */
20 /* */
21 /* If the last construct in a loaded file is a */
22 /* deffunction or defmethod with no closing right */
23 /* parenthesis, an error should be issued, but is */
24 /* not. DR0872 */
25 /* */
26 /* Added pragmas to prevent unused variable */
27 /* warnings. */
28 /* */
29 /* 6.30: Removed conditional code for unsupported */
30 /* compilers/operating systems (IBM_MCW, */
31 /* MAC_MCW, and IBM_TBC). */
32 /* */
33 /* ENVIRONMENT_API_ONLY no longer supported. */
34 /* */
35 /* GetConstructNameAndComment API change. */
36 /* */
37 /* Added const qualifiers to remove C++ */
38 /* deprecation warnings. */
39 /* */
40 /* Converted API macros to function calls. */
41 /* */
42 /* Changed find construct functionality so that */
43 /* imported modules are search when locating a */
44 /* named construct. */
45 /* */
46 /*************************************************************/
47
48 /* =========================================
49 *****************************************
50 EXTERNAL DEFINITIONS
51 =========================================
52 ***************************************** */
53 #include "setup.h"
54
55 #if DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME)
56
57 #if BLOAD || BLOAD_AND_BSAVE
58 #include "bload.h"
59 #endif
60
61 #if DEFRULE_CONSTRUCT
62 #include "network.h"
63 #endif
64
65 #if DEFGENERIC_CONSTRUCT
66 #include "genrccom.h"
67 #endif
68
69 #include "constant.h"
70 #include "cstrcpsr.h"
71 #include "constrct.h"
72 #include "dffnxfun.h"
73 #include "envrnmnt.h"
74 #include "expressn.h"
75 #include "exprnpsr.h"
76 #include "extnfunc.h"
77 #include "memalloc.h"
78 #include "prccode.h"
79 #include "router.h"
80 #include "scanner.h"
81 #include "symbol.h"
82
83 #define _DFFNXPSR_SOURCE_
84 #include "dffnxpsr.h"
85
86 /* =========================================
87 *****************************************
88 INTERNALLY VISIBLE FUNCTION HEADERS
89 =========================================
90 ***************************************** */
91
92 static intBool ValidDeffunctionName(void *,const char *);
93 static DEFFUNCTION *AddDeffunction(void *,SYMBOL_HN *,EXPRESSION *,int,int,int,int);
94
95 /* =========================================
96 *****************************************
97 EXTERNALLY VISIBLE FUNCTIONS
98 =========================================
99 ***************************************** */
100
101 /***************************************************************************
102 NAME : ParseDeffunction
103 DESCRIPTION : Parses the deffunction construct
104 INPUTS : The input logical name
105 RETURNS : FALSE if successful parse, TRUE otherwise
106 SIDE EFFECTS : Creates valid deffunction definition
107 NOTES : H/L Syntax :
108 (deffunction <name> [<comment>]
109 (<single-field-varible>* [<multifield-variable>])
110 <action>*)
111 ***************************************************************************/
ParseDeffunction(void * theEnv,const char * readSource)112 globle intBool ParseDeffunction(
113 void *theEnv,
114 const char *readSource)
115 {
116 SYMBOL_HN *deffunctionName;
117 EXPRESSION *actions;
118 EXPRESSION *parameterList;
119 SYMBOL_HN *wildcard;
120 int min,max,lvars,DeffunctionError = FALSE;
121 short overwrite = FALSE, owMin = 0, owMax = 0;
122 DEFFUNCTION *dptr;
123
124 SetPPBufferStatus(theEnv,ON);
125
126 FlushPPBuffer(theEnv);
127 SetIndentDepth(theEnv,3);
128 SavePPBuffer(theEnv,"(deffunction ");
129
130 #if BLOAD || BLOAD_AND_BSAVE
131 if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
132 {
133 CannotLoadWithBloadMessage(theEnv,"deffunctions");
134 return(TRUE);
135 }
136 #endif
137
138 /* =====================================================
139 Parse the name and comment fields of the deffunction.
140 ===================================================== */
141 deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction",
142 EnvFindDeffunctionInModule,NULL,
143 "!",TRUE,TRUE,TRUE,FALSE);
144 if (deffunctionName == NULL)
145 return(TRUE);
146
147 if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE)
148 return(TRUE);
149
150 /*==========================*/
151 /* Parse the argument list. */
152 /*==========================*/
153 parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard,
154 &min,&max,&DeffunctionError,NULL);
155 if (DeffunctionError)
156 return(TRUE);
157
158 /*===================================================================*/
159 /* Go ahead and add the deffunction so it can be recursively called. */
160 /*===================================================================*/
161
162 if (ConstructData(theEnv)->CheckSyntaxMode)
163 {
164 dptr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(deffunctionName));
165 if (dptr == NULL)
166 { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
167 else
168 {
169 overwrite = TRUE;
170 owMin = (short) dptr->minNumberOfParameters;
171 owMax = (short) dptr->maxNumberOfParameters;
172 dptr->minNumberOfParameters = min;
173 dptr->maxNumberOfParameters = max;
174 }
175 }
176 else
177 { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
178
179 if (dptr == NULL)
180 {
181 ReturnExpression(theEnv,parameterList);
182 return(TRUE);
183 }
184
185 /*==================================================*/
186 /* Parse the actions contained within the function. */
187 /*==================================================*/
188
189 PPCRAndIndent(theEnv);
190
191 ExpressionData(theEnv)->ReturnContext = TRUE;
192 actions = ParseProcActions(theEnv,"deffunction",readSource,
193 &DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard,
194 NULL,NULL,&lvars,NULL);
195
196 /*=============================================================*/
197 /* Check for the closing right parenthesis of the deffunction. */
198 /*=============================================================*/
199
200 if ((DeffunctionData(theEnv)->DFInputToken.type != RPAREN) && /* DR0872 */
201 (actions != NULL))
202 {
203 SyntaxErrorMessage(theEnv,"deffunction");
204
205 ReturnExpression(theEnv,parameterList);
206 ReturnPackedExpression(theEnv,actions);
207
208 if (overwrite)
209 {
210 dptr->minNumberOfParameters = owMin;
211 dptr->maxNumberOfParameters = owMax;
212 }
213
214 if ((dptr->busy == 0) && (! overwrite))
215 {
216 RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
217 RemoveDeffunction(theEnv,dptr);
218 }
219
220 return(TRUE);
221 }
222
223 if (actions == NULL)
224 {
225 ReturnExpression(theEnv,parameterList);
226 if (overwrite)
227 {
228 dptr->minNumberOfParameters = owMin;
229 dptr->maxNumberOfParameters = owMax;
230 }
231
232 if ((dptr->busy == 0) && (! overwrite))
233 {
234 RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
235 RemoveDeffunction(theEnv,dptr);
236 }
237 return(TRUE);
238 }
239
240 /*==============================================*/
241 /* If we're only checking syntax, don't add the */
242 /* successfully parsed deffunction to the KB. */
243 /*==============================================*/
244
245 if (ConstructData(theEnv)->CheckSyntaxMode)
246 {
247 ReturnExpression(theEnv,parameterList);
248 ReturnPackedExpression(theEnv,actions);
249 if (overwrite)
250 {
251 dptr->minNumberOfParameters = owMin;
252 dptr->maxNumberOfParameters = owMax;
253 }
254 else
255 {
256 RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
257 RemoveDeffunction(theEnv,dptr);
258 }
259 return(FALSE);
260 }
261
262 /*=============================*/
263 /* Reformat the closing token. */
264 /*=============================*/
265
266 PPBackup(theEnv);
267 PPBackup(theEnv);
268 SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm);
269 SavePPBuffer(theEnv,"\n");
270
271 /*======================*/
272 /* Add the deffunction. */
273 /*======================*/
274
275 AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE);
276
277 ReturnExpression(theEnv,parameterList);
278
279 return(DeffunctionError);
280 }
281
282 /* =========================================
283 *****************************************
284 INTERNALLY VISIBLE FUNCTIONS
285 =========================================
286 ***************************************** */
287
288 /************************************************************
289 NAME : ValidDeffunctionName
290 DESCRIPTION : Determines if a new deffunction of the given
291 name can be defined in the current module
292 INPUTS : The new deffunction name
293 RETURNS : TRUE if OK, FALSE otherwise
294 SIDE EFFECTS : Error message printed if not OK
295 NOTES : GetConstructNameAndComment() (called before
296 this function) ensures that the deffunction
297 name does not conflict with one from
298 another module
299 ************************************************************/
ValidDeffunctionName(void * theEnv,const char * theDeffunctionName)300 static intBool ValidDeffunctionName(
301 void *theEnv,
302 const char *theDeffunctionName)
303 {
304 struct constructHeader *theDeffunction;
305 #if DEFGENERIC_CONSTRUCT
306 struct defmodule *theModule;
307 struct constructHeader *theDefgeneric;
308 #endif
309
310 /* ============================================
311 A deffunction cannot be named the same as a
312 construct type, e.g, defclass, defrule, etc.
313 ============================================ */
314 if (FindConstruct(theEnv,theDeffunctionName) != NULL)
315 {
316 PrintErrorID(theEnv,"DFFNXPSR",1,FALSE);
317 EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n");
318 return(FALSE);
319 }
320
321 /* ============================================
322 A deffunction cannot be named the same as a
323 pre-defined system function, e.g, watch,
324 list-defrules, etc.
325 ============================================ */
326 if (FindFunction(theEnv,theDeffunctionName) != NULL)
327 {
328 PrintErrorID(theEnv,"DFFNXPSR",2,FALSE);
329 EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n");
330 return(FALSE);
331 }
332
333 #if DEFGENERIC_CONSTRUCT
334 /* ============================================
335 A deffunction cannot be named the same as a
336 generic function (either in this module or
337 imported from another)
338 ============================================ */
339 theDefgeneric =
340 (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName);
341 if (theDefgeneric != NULL)
342 {
343 theModule = GetConstructModuleItem(theDefgeneric)->theModule;
344 if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
345 {
346 PrintErrorID(theEnv,"DFFNXPSR",5,FALSE);
347 EnvPrintRouter(theEnv,WERROR,"Defgeneric ");
348 EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric));
349 EnvPrintRouter(theEnv,WERROR," imported from module ");
350 EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));
351 EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n");
352 return(FALSE);
353 }
354 else
355 {
356 PrintErrorID(theEnv,"DFFNXPSR",3,FALSE);
357 EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n");
358 }
359 return(FALSE);
360 }
361 #endif
362
363 theDeffunction = (struct constructHeader *) EnvFindDeffunctionInModule(theEnv,theDeffunctionName);
364 if (theDeffunction != NULL)
365 {
366 /* ===========================================
367 And a deffunction in the current module can
368 only be redefined if it is not executing.
369 =========================================== */
370 if (((DEFFUNCTION *) theDeffunction)->executing)
371 {
372 PrintErrorID(theEnv,"DFNXPSR",4,FALSE);
373 EnvPrintRouter(theEnv,WERROR,"Deffunction ");
374 EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));
375 EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n");
376 return(FALSE);
377 }
378 }
379 return(TRUE);
380 }
381
382
383 /****************************************************
384 NAME : AddDeffunction
385 DESCRIPTION : Adds a deffunction to the list of
386 deffunctions
387 INPUTS : 1) The symbolic name
388 2) The action expressions
389 3) The minimum number of arguments
390 4) The maximum number of arguments
391 (can be -1)
392 5) The number of local variables
393 6) A flag indicating if this is
394 a header call so that the
395 deffunction can be recursively
396 called
397 RETURNS : The new deffunction (NULL on errors)
398 SIDE EFFECTS : Deffunction structures allocated
399 NOTES : Assumes deffunction is not executing
400 ****************************************************/
AddDeffunction(void * theEnv,SYMBOL_HN * name,EXPRESSION * actions,int min,int max,int lvars,int headerp)401 static DEFFUNCTION *AddDeffunction(
402 void *theEnv,
403 SYMBOL_HN *name,
404 EXPRESSION *actions,
405 int min,
406 int max,
407 int lvars,
408 int headerp)
409 {
410 DEFFUNCTION *dfuncPtr;
411 unsigned oldbusy;
412 #if DEBUGGING_FUNCTIONS
413 unsigned DFHadWatch = FALSE;
414 #else
415 #if MAC_XCD
416 #pragma unused(headerp)
417 #endif
418 #endif
419
420 /*===============================================================*/
421 /* If the deffunction doesn't exist, create a new structure to */
422 /* contain it and add it to the List of deffunctions. Otherwise, */
423 /* use the existing structure and remove the pretty print form */
424 /* and interpretive code. */
425 /*===============================================================*/
426 dfuncPtr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(name));
427 if (dfuncPtr == NULL)
428 {
429 dfuncPtr = get_struct(theEnv,deffunctionStruct);
430 InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
431 IncrementSymbolCount(name);
432 dfuncPtr->code = NULL;
433 dfuncPtr->minNumberOfParameters = min;
434 dfuncPtr->maxNumberOfParameters = max;
435 dfuncPtr->numberOfLocalVars = lvars;
436 dfuncPtr->busy = 0;
437 dfuncPtr->executing = 0;
438 }
439 else
440 {
441 #if DEBUGGING_FUNCTIONS
442 DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
443 #endif
444 dfuncPtr->minNumberOfParameters = min;
445 dfuncPtr->maxNumberOfParameters = max;
446 dfuncPtr->numberOfLocalVars = lvars;
447 oldbusy = dfuncPtr->busy;
448 ExpressionDeinstall(theEnv,dfuncPtr->code);
449 dfuncPtr->busy = oldbusy;
450 ReturnPackedExpression(theEnv,dfuncPtr->code);
451 dfuncPtr->code = NULL;
452 EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,NULL);
453
454 /* =======================================
455 Remove the deffunction from the list so
456 that it can be added at the end
457 ======================================= */
458 RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
459 }
460
461 AddConstructToModule((struct constructHeader *) dfuncPtr);
462
463 /* ==================================
464 Install the new interpretive code.
465 ================================== */
466
467 if (actions != NULL)
468 {
469 /* ===============================
470 If a deffunction is recursive,
471 do not increment its busy count
472 based on self-references
473 =============================== */
474 oldbusy = dfuncPtr->busy;
475 ExpressionInstall(theEnv,actions);
476 dfuncPtr->busy = oldbusy;
477 dfuncPtr->code = actions;
478 }
479
480 /* ===============================================================
481 Install the pretty print form if memory is not being conserved.
482 =============================================================== */
483
484 #if DEBUGGING_FUNCTIONS
485 EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr);
486 if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE))
487 EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,CopyPPBuffer(theEnv));
488 #endif
489 return(dfuncPtr);
490 }
491
492 #endif /* DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */
493
494