/********************************************************************* 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); }