/*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.40 09/28/17 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Query Functions for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* 6.31: Retrieval for instance query slot function */ /* generates an error if the instance has been */ /* deleted. */ /* */ /* Functions delayed-do-for-all-instances and */ /* do-for-instance increment the busy count of */ /* matching instance sets so that actions can */ /* detect deleted instances. */ /* */ /* Matching instance sets containing deleted */ /* instances are pruned. */ /* */ /* 6.40: Added Env prefix to GetEvaluationError and */ /* SetEvaluationError functions. */ /* */ /* Pragma once and other inclusion changes. */ /* */ /* Added support for booleans with . */ /* */ /* Removed use of void pointers for specific */ /* data structures. */ /* */ /* UDF redesign. */ /* */ /* Added GCBlockStart and GCBlockEnd functions */ /* for garbage collection blocks. */ /* */ /* Eval support for run time and bload only. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if INSTANCE_SET_QUERIES #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "insfun.h" #include "insmngr.h" #include "insqypsr.h" #include "memalloc.h" #include "prcdrfun.h" #include "prntutil.h" #include "router.h" #include "utility.h" #include "insquery.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void PushQueryCore(Environment *); static void PopQueryCore(Environment *); static QUERY_CORE *FindQueryCore(Environment *,long long); static QUERY_CLASS *DetermineQueryClasses(Environment *,Expression *,const char *,unsigned *); static QUERY_CLASS *FormChain(Environment *,const char *,Defclass *,UDFValue *); static void DeleteQueryClasses(Environment *,QUERY_CLASS *); static bool TestForFirstInChain(Environment *,QUERY_CLASS *,unsigned); static bool TestForFirstInstanceInClass(Environment *,Defmodule *,int,Defclass *,QUERY_CLASS *,unsigned); static void TestEntireChain(Environment *,QUERY_CLASS *,unsigned); static void TestEntireClass(Environment *,Defmodule *,int,Defclass *,QUERY_CLASS *,unsigned); static void AddSolution(Environment *); static void PopQuerySoln(Environment *); /**************************************************** NAME : SetupQuery DESCRIPTION : Initializes instance query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ void SetupQuery( Environment *theEnv) { AllocateEnvironmentData(theEnv,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL); #if ! RUN_TIME InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL = CreateSymbol(theEnv,QUERY_DELIMITER_STRING); IncrementLexemeCount(InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL); AddUDF(theEnv,"(query-instance)","n",0,UNBOUNDED,NULL,GetQueryInstance,"GetQueryInstance",NULL); AddUDF(theEnv,"(query-instance-slot)","*",0,UNBOUNDED,NULL,GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL); AddUDF(theEnv,"any-instancep","b",0,UNBOUNDED,NULL,AnyInstances,"AnyInstances",NULL); AddUDF(theEnv,"find-instance","m",0,UNBOUNDED,NULL,QueryFindInstance,"QueryFindInstance",NULL); AddUDF(theEnv,"find-all-instances","m",0,UNBOUNDED,NULL,QueryFindAllInstances,"QueryFindAllInstances",NULL); AddUDF(theEnv,"do-for-instance","*",0,UNBOUNDED,NULL,QueryDoForInstance,"QueryDoForInstance",NULL); AddUDF(theEnv,"do-for-all-instances","*",0,UNBOUNDED,NULL,QueryDoForAllInstances,"QueryDoForAllInstances",NULL); AddUDF(theEnv,"delayed-do-for-all-instances","*",0,UNBOUNDED,NULL,DelayedQueryDoForAllInstances,"DelayedQueryDoForAllInstances",NULL); #endif AddFunctionParser(theEnv,"any-instancep",ParseQueryNoAction); AddFunctionParser(theEnv,"find-instance",ParseQueryNoAction); AddFunctionParser(theEnv,"find-all-instances",ParseQueryNoAction); AddFunctionParser(theEnv,"do-for-instance",ParseQueryAction); AddFunctionParser(theEnv,"do-for-all-instances",ParseQueryAction); AddFunctionParser(theEnv,"delayed-do-for-all-instances",ParseQueryAction); } /************************************************************* NAME : GetQueryInstance DESCRIPTION : Internal function for referring to instance array on instance-queries INPUTS : None RETURNS : The name of the specified instance-set member SIDE EFFECTS : None NOTES : H/L Syntax : ((query-instance) ) *************************************************************/ void GetQueryInstance( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CORE *core; core = FindQueryCore(theEnv,GetFirstArgument()->integerValue->contents); returnValue->value = GetFullInstanceName(theEnv,core->solns[GetFirstArgument()->nextArg->integerValue->contents]); } /*************************************************************************** NAME : GetQueryInstanceSlot DESCRIPTION : Internal function for referring to slots of instances in instance array on instance-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-instance-slot) ) **************************************************************************/ void GetQueryInstanceSlot( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { Instance *ins; InstanceSlot *sp; UDFValue temp; QUERY_CORE *core; const char *varSlot; returnValue->lexemeValue = FalseSymbol(theEnv); core = FindQueryCore(theEnv,GetFirstArgument()->integerValue->contents); ins = core->solns[GetFirstArgument()->nextArg->integerValue->contents]; varSlot = GetFirstArgument()->nextArg->nextArg->nextArg->lexemeValue->contents; /*=======================================*/ /* Accessing the slot value of a deleted */ /* instance generates an error. */ /*=======================================*/ if (ins->garbage) { InstanceVarSlotErrorMessage1(theEnv,ins,varSlot); SetEvaluationError(theEnv,true); return; } EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.header->type != SYMBOL_TYPE) { InvalidVarSlotErrorMessage(theEnv,varSlot); SetEvaluationError(theEnv,true); return; } sp = FindInstanceSlot(theEnv,ins,temp.lexemeValue); if (sp == NULL) { InstanceVarSlotErrorMessage2(theEnv,ins,varSlot); SetEvaluationError(theEnv,true); return; } returnValue->value = sp->value; if (sp->type == MULTIFIELD_TYPE) { returnValue->begin = 0; returnValue->range = sp->multifieldValue->length; } } /* ============================================================================= ============================================================================= Following are the instance query functions : any-instancep : Determines if any instances satisfy the query find-instance : Finds first (set of) instance(s) which satisfies the query and stores it in a multi-field find-all-instances : Finds all (sets of) instances which satisfy the the query and stores them in a multi-field do-for-instance : Executes a given action for the first (set of) instance(s) which satisfy the query do-for-all-instances : Executes an action for all instances which satisfy the query as they are found delayed-do-for-all-instances : Same as above - except that the list of instances which satisfy the query is formed before any actions are executed Instance candidate search algorithm : All permutations of first restriction class instances with other restriction class instances (Rightmost are varied first) All permutations of first restriction class's subclasses' instances with other restriction class instances. And so on... For any one class, instances are examined in the order they were defined Example : (defclass a (is-a standard-user)) (defclass b (is-a standard-user)) (defclass c (is-a standard-user)) (defclass d (is-a a b)) (make-instance a1 of a) (make-instance a2 of a) (make-instance b1 of b) (make-instance b2 of b) (make-instance c1 of c) (make-instance c2 of c) (make-instance d1 of d) (make-instance d2 of d) (any-instancep ((?a a b) (?b c)) ) The permutations (?a ?b) would be examined in the following order : (a1 c1),(a1 c2),(a2 c1),(a2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2), (b1 c1),(b1 c2),(b2 c1),(b2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2) Notice the duplication because d is a subclass of both and a and b. ============================================================================= ============================================================================= */ /****************************************************************************** NAME : AnyInstances DESCRIPTION : Determines if there any existing instances which satisfy the query INPUTS : None RETURNS : True if the query is satisfied, false otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to true - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ void AnyInstances( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CLASS *qclasses; unsigned rcnt; bool testResult; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "any-instancep",&rcnt); if (qclasses == NULL) { returnValue->lexemeValue = FalseSymbol(theEnv); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); testResult = TestForFirstInChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = false; rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); returnValue->lexemeValue = CreateBoolean(theEnv,testResult); } /****************************************************************************** NAME : QueryFindInstance DESCRIPTION : Finds the first set of instances which satisfy the query and stores their names in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : True if the query is satisfied, false otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to true - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ void QueryFindInstance( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CLASS *qclasses; unsigned rcnt,i; returnValue->begin = 0; returnValue->range = 0; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "find-instance",&rcnt); if (qclasses == NULL) { returnValue->value = CreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); if (TestForFirstInChain(theEnv,qclasses,0) == true) { returnValue->value = CreateMultifield(theEnv,rcnt); returnValue->range = rcnt; for (i = 0 ; i < rcnt ; i++) { returnValue->multifieldValue->contents[i].lexemeValue = GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->solns[i]); } } else returnValue->value = CreateMultifield(theEnv,0L); InstanceQueryData(theEnv)->AbortQuery = false; rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryFindAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ void QueryFindAllInstances( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CLASS *qclasses; unsigned rcnt; size_t i, j; returnValue->begin = 0; returnValue->range = 0; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "find-all-instances",&rcnt); if (qclasses == NULL) { returnValue->value = CreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = NULL; InstanceQueryData(theEnv)->QueryCore->soln_set = NULL; InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt; InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = false; returnValue->value = CreateMultifield(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_cnt * rcnt); while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 , j = returnValue->range ; i < rcnt ; i++ , j++) { returnValue->multifieldValue->contents[j].lexemeValue = GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i]); } returnValue->range = j; PopQuerySoln(theEnv); } rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryDoForInstance DESCRIPTION : Finds the first set of instances which satisfy the query and executes a user-action with that set INPUTS : None RETURNS : Caller's result buffer SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to true - if at all). Also the action expression is executed zero or once. Caller's result buffer holds result of user-action NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ void QueryDoForInstance( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CLASS *qclasses; unsigned i, rcnt; returnValue->lexemeValue = FalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-instance",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; if (TestForFirstInChain(theEnv,qclasses,0) == true) { for (i = 0; i < rcnt; i++) { InstanceQueryData(theEnv)->QueryCore->solns[i]->busy++; } EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,returnValue); for (i = 0; i < rcnt; i++) { InstanceQueryData(theEnv)->QueryCore->solns[i]->busy--; } } InstanceQueryData(theEnv)->AbortQuery = false; ProcedureFunctionData(theEnv)->BreakFlag = false; rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryDoForAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and executes a user-function for each set as it is found INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. Also, the action is executed for every instance set. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ void QueryDoForAllInstances( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CLASS *qclasses; unsigned rcnt; returnValue->lexemeValue = FalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-all-instances",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; InstanceQueryData(theEnv)->QueryCore->result = returnValue; RetainUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result); TestEntireChain(theEnv,qclasses,0); ReleaseUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result); InstanceQueryData(theEnv)->AbortQuery = false; ProcedureFunctionData(theEnv)->BreakFlag = false; rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : DelayedQueryDoForAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and and exceutes a user-action for each set This function differs from QueryDoForAllInstances() in that it forms the complete list of query satisfactions BEFORE executing any actions. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. The action is executed for evry query satisfaction. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ void DelayedQueryDoForAllInstances( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { QUERY_CLASS *qclasses; unsigned rcnt; unsigned i; GCBlock gcb; QUERY_SOLN *theSet; returnValue->lexemeValue = FalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "delayed-do-for-all-instances",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = NULL; InstanceQueryData(theEnv)->QueryCore->soln_set = NULL; InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt; InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = false; InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; /*==================================================================*/ /* Increment the busy count for all instances in the solution sets. */ /*==================================================================*/ GCBlockStart(theEnv,&gcb); for (theSet = InstanceQueryData(theEnv)->QueryCore->soln_set; theSet != NULL; theSet = theSet->nxt) { for (i = 0; i < rcnt; i++) { theSet->soln[i]->busy++; } } /*=====================*/ /* Perform the action. */ /*=====================*/ for (theSet = InstanceQueryData(theEnv)->QueryCore->soln_set; theSet != NULL; ) { for (i = 0 ; i < rcnt ; i++) { if (theSet->soln[i]->garbage) { goto nextSet; } InstanceQueryData(theEnv)->QueryCore->solns[i] = theSet->soln[i]; } EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,returnValue); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { break; } CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); nextSet: theSet = theSet->nxt; } /*==================================================================*/ /* Decrement the busy count for all instances in the solution sets. */ /*==================================================================*/ for (theSet = InstanceQueryData(theEnv)->QueryCore->soln_set; theSet != NULL; theSet = theSet->nxt) { for (i = 0; i < rcnt; i++) { theSet->soln[i]->busy--; } } GCBlockEndUDF(theEnv,&gcb,returnValue); CallPeriodicTasks(theEnv); /*==================================*/ /* Deallocate the query structures. */ /*==================================*/ while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) { PopQuerySoln(theEnv); } ProcedureFunctionData(theEnv)->BreakFlag = false; rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : PushQueryCore DESCRIPTION : Pushes the current QueryCore onto stack INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Allocates new stack node and changes QueryCoreStack NOTES : None *******************************************************/ static void PushQueryCore( Environment *theEnv) { QUERY_STACK *qptr; qptr = get_struct(theEnv,query_stack); qptr->core = InstanceQueryData(theEnv)->QueryCore; qptr->nxt = InstanceQueryData(theEnv)->QueryCoreStack; InstanceQueryData(theEnv)->QueryCoreStack = qptr; } /****************************************************** NAME : PopQueryCore DESCRIPTION : Pops top of QueryCore stack and restores QueryCore to this core INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack node deallocated, QueryCoreStack changed and QueryCore reset NOTES : Assumes stack is not empty ******************************************************/ static void PopQueryCore( Environment *theEnv) { QUERY_STACK *qptr; InstanceQueryData(theEnv)->QueryCore = InstanceQueryData(theEnv)->QueryCoreStack->core; qptr = InstanceQueryData(theEnv)->QueryCoreStack; InstanceQueryData(theEnv)->QueryCoreStack = InstanceQueryData(theEnv)->QueryCoreStack->nxt; rtn_struct(theEnv,query_stack,qptr); } /*************************************************** NAME : FindQueryCore DESCRIPTION : Looks up a QueryCore Stack Frame Depth 0 is current frame 1 is next deepest, etc. INPUTS : Depth RETURNS : Address of query core stack frame SIDE EFFECTS : None NOTES : None ***************************************************/ static QUERY_CORE *FindQueryCore( Environment *theEnv, long long depth) { QUERY_STACK *qptr; if (depth == 0) return InstanceQueryData(theEnv)->QueryCore; qptr = InstanceQueryData(theEnv)->QueryCoreStack; while (depth > 1) { qptr = qptr->nxt; depth--; } return qptr->core; } /********************************************************** NAME : DetermineQueryClasses DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) The parse class expression chain 2) The name of the function being executed 3) Caller's buffer for restriction count (# of separate lists) RETURNS : The query list, or NULL on errors SIDE EFFECTS : Memory allocated for list Busy count incremented for all classes NOTES : Each restriction is linked by nxt pointer, multiple classes in a restriction are linked by the chain pointer. Rcnt caller's buffer is set to reflect the total number of chains Assumes classExp is not NULL and that each restriction chain is terminated with the QUERY_DELIMITER_SYMBOL "(QDS)" **********************************************************/ static QUERY_CLASS *DetermineQueryClasses( Environment *theEnv, Expression *classExp, const char *func, unsigned *rcnt) { QUERY_CLASS *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp; bool new_list = false; UDFValue temp; Defclass *theClass; *rcnt = 0; while (classExp != NULL) { theClass = NULL; if (classExp->type == DEFCLASS_PTR) { theClass = (Defclass *) classExp->value; } else if (EvaluateExpression(theEnv,classExp,&temp)) { DeleteQueryClasses(theEnv,clist); return NULL; } if ((theClass == NULL) && (temp.value == (void *) InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL)) { new_list = true; (*rcnt)++; } else if ((tmp = FormChain(theEnv,func,theClass,&temp)) != NULL) { if (clist == NULL) clist = cnxt = cchain = tmp; else if (new_list == true) { new_list = false; cnxt->nxt = tmp; cnxt = cchain = tmp; } else cchain->chain = tmp; while (cchain->chain != NULL) cchain = cchain->chain; } else { SyntaxErrorMessage(theEnv,"instance-set query class restrictions"); DeleteQueryClasses(theEnv,clist); SetEvaluationError(theEnv,true); return NULL; } classExp = classExp->nextArg; } return(clist); } /************************************************************* NAME : FormChain DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) Name of calling function for error msgs 2) Data object - must be a symbol or a multifield value containing all symbols The symbols must be names of existing classes RETURNS : The query chain, or NULL on errors SIDE EFFECTS : Memory allocated for chain Busy count incremented for all classes NOTES : None *************************************************************/ static QUERY_CLASS *FormChain( Environment *theEnv, const char *func, Defclass *theClass, UDFValue *val) { Defclass *cls; QUERY_CLASS *head,*bot,*tmp; size_t i; const char *className; Defmodule *currentModule; currentModule = GetCurrentModule(theEnv); if (theClass != NULL) { IncrementDefclassBusyCount(theEnv,theClass); head = get_struct(theEnv,query_class); head->cls = theClass; if (DefclassInScope(theEnv,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; head->chain = NULL; head->nxt = NULL; return(head); } if (val->header->type == SYMBOL_TYPE) { /* =============================================== Allow instance-set query restrictions to have a module specifier as part of the class name, but search imported defclasses too if a module specifier is not given =============================================== */ cls = LookupDefclassByMdlOrScope(theEnv,val->lexemeValue->contents); if (cls == NULL) { ClassExistError(theEnv,func,val->lexemeValue->contents); return NULL; } IncrementDefclassBusyCount(theEnv,(Defclass *) cls); head = get_struct(theEnv,query_class); head->cls = cls; if (DefclassInScope(theEnv,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; head->chain = NULL; head->nxt = NULL; return(head); } if (val->header->type == MULTIFIELD_TYPE) { head = bot = NULL; for (i = val->begin ; i < (val->begin + val->range) ; i++) { if (val->multifieldValue->contents[i].header->type == SYMBOL_TYPE) { className = val->multifieldValue->contents[i].lexemeValue->contents; cls = LookupDefclassByMdlOrScope(theEnv,className); if (cls == NULL) { ClassExistError(theEnv,func,className); DeleteQueryClasses(theEnv,head); return NULL; } } else { DeleteQueryClasses(theEnv,head); return NULL; } IncrementDefclassBusyCount(theEnv,(Defclass *) cls); tmp = get_struct(theEnv,query_class); tmp->cls = cls; if (DefclassInScope(theEnv,tmp->cls,currentModule)) tmp->theModule = currentModule; else tmp->theModule = tmp->cls->header.whichModule->theModule; tmp->chain = NULL; tmp->nxt = NULL; if (head == NULL) head = tmp; else bot->chain = tmp; bot = tmp; } return(head); } return NULL; } /****************************************************** NAME : DeleteQueryClasses DESCRIPTION : Deletes a query class-list INPUTS : The query list address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated Busy count decremented for all classes NOTES : None ******************************************************/ static void DeleteQueryClasses( Environment *theEnv, QUERY_CLASS *qlist) { QUERY_CLASS *tmp; while (qlist != NULL) { while (qlist->chain != NULL) { tmp = qlist->chain; qlist->chain = qlist->chain->chain; DecrementDefclassBusyCount(theEnv,(Defclass *) tmp->cls); rtn_struct(theEnv,query_class,tmp); } tmp = qlist; qlist = qlist->nxt; DecrementDefclassBusyCount(theEnv,(Defclass *) tmp->cls); rtn_struct(theEnv,query_class,tmp); } } /************************************************************ NAME : TestForFirstInChain DESCRIPTION : Processes all classes in a restriction chain until success or done INPUTS : 1) The current chain 2) The index of the chain restriction (e.g. the 4th query-variable) RETURNS : True if query succeeds, false otherwise SIDE EFFECTS : Sets current restriction class Instance variable values set NOTES : None ************************************************************/ static bool TestForFirstInChain( Environment *theEnv, QUERY_CLASS *qchain, unsigned indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = true; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = false; if ((id = GetTraversalID(theEnv)) == -1) return false; if (TestForFirstInstanceInClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx)) { ReleaseTraversalID(theEnv); return true; } ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) return false; } return false; } /***************************************************************** NAME : TestForFirstInstanceInClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until success or done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : True if query succeeds, false otherwise SIDE EFFECTS : Instance variable values set NOTES : None *****************************************************************/ static bool TestForFirstInstanceInClass( Environment *theEnv, Defmodule *theModule, int id, Defclass *cls, QUERY_CLASS *qchain, unsigned indx) { unsigned long i; Instance *ins; UDFValue temp; GCBlock gcb; unsigned j; if (TestTraversalID(cls->traversalRecord,id)) return false; SetTraversalID(cls->traversalRecord,id); if (DefclassInScope(theEnv,cls,theModule) == false) return false; GCBlockStart(theEnv,&gcb); ins = cls->instanceList; while (ins != NULL) { InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins; if (qchain->nxt != NULL) { ins->busy++; if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == true) { ins->busy--; break; } ins->busy--; if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) break; } else { for (j = 0; j < indx; j++) { if (InstanceQueryData(theEnv)->QueryCore->solns[j]->garbage) { ins = NULL; goto endTest; } } ins->busy++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp); ins->busy--; if (EvaluationData(theEnv)->HaltExecution == true) break; if (temp.value != FalseSymbol(theEnv)) break; } CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); ins = ins->nxtClass; while ((ins != NULL) ? (ins->garbage == 1) : false) ins = ins->nxtClass; } endTest: GCBlockEnd(theEnv,&gcb); CallPeriodicTasks(theEnv); if (ins != NULL) return(((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) ? false : true); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { if (TestForFirstInstanceInClass(theEnv,theModule,id,cls->directSubclasses.classArray[i], qchain,indx)) return true; if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) return false; } return false; } /************************************************************ NAME : TestEntireChain DESCRIPTION : Processes all classes in a restriction chain until done INPUTS : 1) The current chain 2) The index of the chain restriction (i.e. the 4th query-variable) RETURNS : Nothing useful SIDE EFFECTS : Sets current restriction class Query instance variables set Solution sets stored in global list NOTES : None ************************************************************/ static void TestEntireChain( Environment *theEnv, QUERY_CLASS *qchain, unsigned indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = true; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = false; if ((id = GetTraversalID(theEnv)) == -1) return; TestEntireClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx); ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) return; } } /***************************************************************** NAME : TestEntireClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireClass( Environment *theEnv, Defmodule *theModule, int id, Defclass *cls, QUERY_CLASS *qchain, unsigned indx) { unsigned long i; Instance *ins; UDFValue temp; GCBlock gcb; unsigned j; if (TestTraversalID(cls->traversalRecord,id)) return; SetTraversalID(cls->traversalRecord,id); if (DefclassInScope(theEnv,cls,theModule) == false) return; GCBlockStart(theEnv,&gcb); ins = cls->instanceList; while (ins != NULL) { InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins; if (qchain->nxt != NULL) { ins->busy++; TestEntireChain(theEnv,qchain->nxt,indx+1); ins->busy--; if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) break; } else { for (j = 0; j < indx; j++) { if (InstanceQueryData(theEnv)->QueryCore->solns[j]->garbage) { goto endTest; } } ins->busy++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp); ins->busy--; if (EvaluationData(theEnv)->HaltExecution == true) break; if (temp.value != FalseSymbol(theEnv)) { if (InstanceQueryData(theEnv)->QueryCore->action != NULL) { ins->busy++; ReleaseUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result); EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,InstanceQueryData(theEnv)->QueryCore->result); RetainUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result); ins->busy--; if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { InstanceQueryData(theEnv)->AbortQuery = true; break; } if (EvaluationData(theEnv)->HaltExecution == true) break; } else AddSolution(theEnv); } } ins = ins->nxtClass; while ((ins != NULL) ? (ins->garbage == 1) : false) ins = ins->nxtClass; CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } endTest: GCBlockEnd(theEnv,&gcb); CallPeriodicTasks(theEnv); if (ins != NULL) return; for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { TestEntireClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],qchain,indx); if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true)) return; } } /*************************************************************************** NAME : AddSolution DESCRIPTION : Adds the current instance set to a global list of solutions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Global list and count updated NOTES : Solutions are stored as sequential arrays of Instance * ***************************************************************************/ static void AddSolution( Environment *theEnv) { QUERY_SOLN *new_soln; unsigned i; new_soln = (QUERY_SOLN *) gm2(theEnv,sizeof(QUERY_SOLN)); new_soln->soln = (Instance **) gm2(theEnv,(sizeof(Instance *) * (InstanceQueryData(theEnv)->QueryCore->soln_size))); for (i = 0 ; i < InstanceQueryData(theEnv)->QueryCore->soln_size ; i++) new_soln->soln[i] = InstanceQueryData(theEnv)->QueryCore->solns[i]; new_soln->nxt = NULL; if (InstanceQueryData(theEnv)->QueryCore->soln_set == NULL) InstanceQueryData(theEnv)->QueryCore->soln_set = new_soln; else InstanceQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln; InstanceQueryData(theEnv)->QueryCore->soln_bottom = new_soln; InstanceQueryData(theEnv)->QueryCore->soln_cnt++; } /*************************************************** NAME : PopQuerySoln DESCRIPTION : Deallocates the topmost solution set for an instance-set query INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Solution set deallocated NOTES : Assumes QueryCore->soln_set != 0 ***************************************************/ static void PopQuerySoln( Environment *theEnv) { InstanceQueryData(theEnv)->QueryCore->soln_bottom = InstanceQueryData(theEnv)->QueryCore->soln_set; InstanceQueryData(theEnv)->QueryCore->soln_set = InstanceQueryData(theEnv)->QueryCore->soln_set->nxt; rm(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_bottom->soln, (sizeof(Instance *) * InstanceQueryData(theEnv)->QueryCore->soln_size)); rm(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN)); } #endif