/*********************************************************************
NAME : SubclassPCommand
DESCRIPTION : Determines if a class is a subclass of another
INPUTS : None
RETURNS : TRUE if class-1 is a subclass of class-2
SIDE EFFECTS : None
NOTES : H/L Syntax : (subclassp <class-1> <class-2>)
*********************************************************************/
globle intBool SubclassPCommand(
void *theEnv)
{
DEFCLASS *c1,*c2;
if (CheckTwoClasses(theEnv,"subclassp",&c1,&c2) == FALSE)
return(FALSE);
return(EnvSubclassP(theEnv,(void *) c1,(void *) c2));
}
globle intBool CheckAllowedClassesConstraint(
void *theEnv,
int type,
void *vPtr,
CONSTRAINT_RECORD *constraints)
{
#if OBJECT_SYSTEM
struct expr *tmpPtr;
INSTANCE_TYPE *ins;
DEFCLASS *insClass, *cmpClass;
/*=========================================*/
/* If the constraint record is NULL, there */
/* is no allowed-classes restriction. */
/*=========================================*/
if (constraints == NULL) return(TRUE);
/*======================================*/
/* The constraint is satisfied if there */
/* aren't any class restrictions. */
/*======================================*/
if (constraints->classList == NULL)
{ return(TRUE); }
/*==================================*/
/* Class restrictions only apply to */
/* instances and instance names. */
/*==================================*/
if ((type != INSTANCE_ADDRESS) && (type != INSTANCE_NAME))
{ return(TRUE); }
/*=============================================*/
/* If an instance name is specified, determine */
/* whether the instance exists. */
/*=============================================*/
if (type == INSTANCE_ADDRESS)
{ ins = (INSTANCE_TYPE *) vPtr; }
else
{ ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) vPtr); }
if (ins == NULL)
{ return(FALSE); }
/*======================================================*/
/* Search through the class list to see if the instance */
/* belongs to one of the allowed classes in the list. */
/*======================================================*/
insClass = (DEFCLASS *) EnvGetInstanceClass(theEnv,ins);
for (tmpPtr = constraints->classList;
tmpPtr != NULL;
tmpPtr = tmpPtr->nextArg)
{
cmpClass = (DEFCLASS *) EnvFindDefclass(theEnv,ValueToString(tmpPtr->value));
if (cmpClass == NULL) continue;
if (cmpClass == insClass) return(TRUE);
if (EnvSubclassP(theEnv,insClass,cmpClass)) return(TRUE);
}
/*=========================================================*/
/* If a parent class wasn't found in the list, then return */
/* FALSE because the constraint has been violated. */
/*=========================================================*/
return(FALSE);
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(type)
#pragma unused(vPtr)
#pragma unused(constraints)
#endif
return(TRUE);
#endif
}
globle intBool SubclassP(
void *firstClass,
void *secondClass)
{
return EnvSubclassP(GetCurrentEnvironment(),firstClass,secondClass);
}
