/*********************************************************
NAME : DisplaySlotConstraintInfo
DESCRIPTION : Displays a table summary of type-checking
facets for the slots of a class
including:
type
allowed-symbols
allowed-integers
allowed-floats
allowed-values
allowed-instance-names
range
min-number-of-elements
max-number-of-elements
The function also displays the source
class(es) for the facets
INPUTS : 1) A format string for use in sprintf
2) A buffer to store the display in
3) Maximum buffer size
4) A pointer to the class
RETURNS : Nothing useful
SIDE EFFECTS : Buffer written to and displayed
NOTES : None
*********************************************************/
static void DisplaySlotConstraintInfo(
Environment *theEnv,
const char *logicalName,
const char *slotNamePrintFormat,
char *buf,
unsigned maxlen,
Defclass *cls)
{
long i;
CONSTRAINT_RECORD *cr;
const char *strdest = "***describe-class***";
gensprintf(buf,slotNamePrintFormat,"SLOTS");
genstrcat(buf,"SYM STR INN INA EXA FTA INT FLT\n");
WriteString(theEnv,logicalName,buf);
for (i = 0 ; i < cls->instanceSlotCount ; i++)
{
cr = cls->instanceTemplate[i]->constraint;
gensprintf(buf,slotNamePrintFormat,cls->instanceTemplate[i]->slotName->name->contents);
if (cr != NULL)
{
genstrcat(buf,ConstraintCode(cr,cr->symbolsAllowed,cr->symbolRestriction));
genstrcat(buf,ConstraintCode(cr,cr->stringsAllowed,cr->stringRestriction));
genstrcat(buf,ConstraintCode(cr,cr->instanceNamesAllowed,
(cr->instanceNameRestriction || cr->classRestriction)));
genstrcat(buf,ConstraintCode(cr,cr->instanceAddressesAllowed,cr->classRestriction));
genstrcat(buf,ConstraintCode(cr,cr->externalAddressesAllowed,0));
genstrcat(buf,ConstraintCode(cr,cr->factAddressesAllowed,0));
genstrcat(buf,ConstraintCode(cr,cr->integersAllowed,cr->integerRestriction));
genstrcat(buf,ConstraintCode(cr,cr->floatsAllowed,cr->floatRestriction));
OpenStringDestination(theEnv,strdest,buf + strlen(buf),(maxlen - strlen(buf) - 1));
if (cr->integersAllowed || cr->floatsAllowed || cr->anyAllowed)
{
WriteString(theEnv,strdest,"RNG:[");
PrintExpression(theEnv,strdest,cr->minValue);
WriteString(theEnv,strdest,"..");
PrintExpression(theEnv,strdest,cr->maxValue);
WriteString(theEnv,strdest,"] ");
}
if (cls->instanceTemplate[i]->multiple)
{
WriteString(theEnv,strdest,"CRD:[");
PrintExpression(theEnv,strdest,cr->minFields);
WriteString(theEnv,strdest,"..");
PrintExpression(theEnv,strdest,cr->maxFields);
WriteString(theEnv,strdest,"]");
}
}
else
{
OpenStringDestination(theEnv,strdest,buf,maxlen);
WriteString(theEnv,strdest," + + + + + + + + RNG:[-oo..+oo]");
if (cls->instanceTemplate[i]->multiple)
WriteString(theEnv,strdest," CRD:[0..+oo]");
}
WriteString(theEnv,strdest,"\n");
CloseStringDestination(theEnv,strdest);
WriteString(theEnv,logicalName,buf);
}
}
globle const char *FloatToString(
void *theEnv,
double number)
{
char floatString[40];
int i;
char x;
void *thePtr;
gensprintf(floatString,"%.15g",number);
for (i = 0; (x = floatString[i]) != '\0'; i++)
{
if ((x == '.') || (x == 'e'))
{
thePtr = EnvAddSymbol(theEnv,floatString);
return(ValueToString(thePtr));
}
}
genstrcat(floatString,".0");
thePtr = EnvAddSymbol(theEnv,floatString);
return(ValueToString(thePtr));
}
const char *FloatToString(
Environment *theEnv,
double number)
{
char floatString[40];
int i;
char x;
CLIPSLexeme *thePtr;
gensprintf(floatString,"%.15g",number);
for (i = 0; (x = floatString[i]) != '\0'; i++)
{
if ((x == '.') || (x == 'e'))
{
thePtr = CreateString(theEnv,floatString);
return thePtr->contents;
}
}
genstrcat(floatString,".0");
thePtr = CreateString(theEnv,floatString);
return thePtr->contents;
}
/*************************************************************
NAME : DisplaySlotBasicInfo
DESCRIPTION : Displays a table summary of basic
facets for the slots of a class
including:
single/multiple
default/no-default/default-dynamic
inherit/no-inherit
read-write/initialize-only/read-only
local/shared
composite/exclusive
reactive/non-reactive
public/private
create-accessor read/write
override-message
The function also displays the source
class(es) for the facets
INPUTS : 1) The logical name of the output
2) A format string for use in sprintf
(for printing slot names)
3) A format string for use in sprintf
(for printing slot override message names)
4) A buffer to store the display in
5) A pointer to the class
RETURNS : Nothing useful
SIDE EFFECTS : Buffer written to and displayed
NOTES : None
*************************************************************/
static void DisplaySlotBasicInfo(
void *theEnv,
char *logicalName,
char *slotNamePrintFormat,
char *overrideMessagePrintFormat,
char *buf,
DEFCLASS *cls)
{
long i;
SLOT_DESC *sp;
char *createString;
gensprintf(buf,slotNamePrintFormat,"SLOTS");
#if DEFRULE_CONSTRUCT
genstrcat(buf,"FLD DEF PRP ACC STO MCH SRC VIS CRT ");
#else
genstrcat(buf,"FLD DEF PRP ACC STO SRC VIS CRT ");
#endif
EnvPrintRouter(theEnv,logicalName,buf);
gensprintf(buf,overrideMessagePrintFormat,"OVRD-MSG");
EnvPrintRouter(theEnv,logicalName,buf);
EnvPrintRouter(theEnv,logicalName,"SOURCE(S)\n");
for (i = 0 ; i < cls->instanceSlotCount ; i++)
{
sp = cls->instanceTemplate[i];
gensprintf(buf,slotNamePrintFormat,ValueToString(sp->slotName->name));
genstrcat(buf,sp->multiple ? "MLT " : "SGL ");
if (sp->noDefault)
genstrcat(buf,"NIL ");
else
genstrcat(buf,sp->dynamicDefault ? "DYN " : "STC ");
genstrcat(buf,sp->noInherit ? "NIL " : "INH ");
if (sp->initializeOnly)
genstrcat(buf,"INT ");
else if (sp->noWrite)
genstrcat(buf," R ");
else
genstrcat(buf,"RW ");
genstrcat(buf,sp->shared ? "SHR " : "LCL ");
#if DEFRULE_CONSTRUCT
genstrcat(buf,sp->reactive ? "RCT " : "NIL ");
#endif
genstrcat(buf,sp->composite ? "CMP " : "EXC ");
genstrcat(buf,sp->publicVisibility ? "PUB " : "PRV ");
createString = GetCreateAccessorString(sp);
if (createString[1] == '\0')
genstrcat(buf," ");
genstrcat(buf,createString);
if ((createString[1] == '\0') ? TRUE : (createString[2] == '\0'))
genstrcat(buf," ");
genstrcat(buf," ");
EnvPrintRouter(theEnv,logicalName,buf);
gensprintf(buf,overrideMessagePrintFormat,
sp->noWrite ? "NIL" : ValueToString(sp->overrideMessage));
EnvPrintRouter(theEnv,logicalName,buf);
PrintSlotSources(theEnv,logicalName,sp->slotName->name,&sp->cls->allSuperclasses,0,TRUE);
EnvPrintRouter(theEnv,logicalName,"\n");
}
}
globle const char *DataObjectToString(
void *theEnv,
DATA_OBJECT *theDO)
{
void *thePtr;
const char *theString;
char *newString;
const char *prefix, *postfix;
size_t length;
struct externalAddressHashNode *theAddress;
char buffer[30];
switch (GetpType(theDO))
{
case MULTIFIELD:
prefix = "(";
theString = ValueToString(ImplodeMultifield(theEnv,theDO));
postfix = ")";
break;
case STRING:
prefix = "\"";
theString = DOPToString(theDO);
postfix = "\"";
break;
case INSTANCE_NAME:
prefix = "[";
theString = DOPToString(theDO);
postfix = "]";
break;
case SYMBOL:
return(DOPToString(theDO));
case FLOAT:
return(FloatToString(theEnv,DOPToDouble(theDO)));
case INTEGER:
return(LongIntegerToString(theEnv,DOPToLong(theDO)));
case RVOID:
return("");
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
thePtr = DOPToPointer(theDO);
if (thePtr == (void *) &InstanceData(theEnv)->DummyInstance)
{ return("<Dummy Instance>"); }
if (((struct instance *) thePtr)->garbage)
{
prefix = "<Stale Instance-";
theString = ValueToString(((struct instance *) thePtr)->name);
postfix = ">";
}
else
{
prefix = "<Instance-";
theString = ValueToString(GetFullInstanceName(theEnv,(INSTANCE_TYPE *) thePtr));
postfix = ">";
}
break;
#endif
case EXTERNAL_ADDRESS:
theAddress = (struct externalAddressHashNode *) DOPToPointer(theDO);
/* TBD Need specific routine for creating name string. */
gensprintf(buffer,"<Pointer-%d-%p>",(int) theAddress->type,DOPToExternalAddress(theDO));
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS:
if (DOPToPointer(theDO) == (void *) &FactData(theEnv)->DummyFact)
{ return("<Dummy Fact>"); }
thePtr = DOPToPointer(theDO);
gensprintf(buffer,"<Fact-%lld>",((struct fact *) thePtr)->factIndex);
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#endif
default:
return("UNK");
}
length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1;
newString = (char *) genalloc(theEnv,length);
newString[0] = '\0';
genstrcat(newString,prefix);
genstrcat(newString,theString);
genstrcat(newString,postfix);
thePtr = EnvAddSymbol(theEnv,newString);
genfree(theEnv,newString,length);
return(ValueToString(thePtr));
}
int
main (int argc, char *argv[])
{ int arg, i, ct, *inv, old_ndiff, maxneweqns, numeqns, ngens, maxwdiffs;
fsa diff2, genmult;
char gpname[100], cosgpname[100], inf1[100], inf2[100], inf3[100],
outf[100], outfwg[100], outfec[100], fsaname[100];
fsa *wd_fsa; /* This is for doing word-reductions in the case that we
* correct the diff2 machine
*/
fsa wa; /* The word-acceptor in the wtlex case */
int weight[MAXGEN+1]; /* The weights of the generators in the wtlex case */
gen testword[MAXREDUCELEN]; /* for word reduction */
char **names; /* generator names in case we need to output words */
reduction_equation *eqnptr;
reduction_struct rs_wd;
storage_type ip_store = DENSE;
int dr = 0;
boolean seengpname, seencosname;
boolean cosets=FALSE;
boolean wtlex=FALSE;
rewriting_system rws;
boolean outputwords = FALSE;
int separator=0;
setbuf(stdout,(char*)0);
setbuf(stderr,(char*)0);
rws.maxeqns = MAXRWSEQNS;
maxneweqns = MAXNEWEQNS;
maxwdiffs = MAXWDIFFS;
inf1[0] = '\0';
inf2[0] = '\0';
outf[0] = '\0';
arg = 1;
seengpname=seencosname=FALSE;
while (argc > arg) {
if (strcmp(argv[arg],"-ip")==0) {
arg++;
if (arg >= argc)
badusage_gpcheckmult();
if (strcmp(argv[arg],"d")==0)
ip_store = DENSE;
else if (argv[arg][0] == 's') {
ip_store = SPARSE;
if (stringlen(argv[arg]) > 1)
dr = atoi(argv[arg]+1);
}
else
badusage_gpcheckmult();
}
else if (strcmp(argv[arg],"-silent")==0)
kbm_print_level = 0;
else if (strcmp(argv[arg],"-v")==0)
kbm_print_level = 2;
else if (strcmp(argv[arg],"-vv")==0)
kbm_print_level = 3;
else if (strcmp(argv[arg],"-l")==0)
kbm_large = TRUE;
else if (strcmp(argv[arg],"-h")==0)
kbm_huge = TRUE;
else if (strcmp(argv[arg],"-ow")==0)
outputwords = TRUE;
else if (strncmp(argv[arg],"-cos",4)==0)
cosets = TRUE;
else if (strcmp(argv[arg],"-m")==0) {
arg++;
if (arg >= argc)
badusage_gpcheckmult();
maxneweqns = atoi(argv[arg]);
}
else if (strcmp(argv[arg],"-mwd")==0) {
arg++;
if (arg >= argc)
badusage_gpcheckmult();
maxwdiffs = atoi(argv[arg]);
}
else if (strcmp(argv[arg],"-wtlex")==0)
wtlex = TRUE;
else if (argv[arg][0] == '-')
badusage_gpcheckmult();
else if (!seengpname) {
seengpname=TRUE;
strcpy(gpname,argv[arg]);
}
else if (!seencosname) {
seencosname=TRUE;
sprintf(cosgpname,"%s.%s",gpname,argv[arg]);
}
else
badusage_gpcheckmult();
arg++;
}
if (!seengpname)
badusage_gpcheckmult();
if (cosets && wtlex) {
fprintf(stderr,
"Sorry: -cos and -wtlex options cannot be used together.\n");
badusage_gpcheckmult();
}
if (cosets && !seencosname)
sprintf(cosgpname,"%s.cos",gpname);
if (cosets) strcpy(inf1,cosgpname);
else strcpy(inf1,gpname);
strcpy(inf2,inf1);
strcat(inf1,".gm");
if (cosets) sprintf(outfec,"%s.cm.ec",cosgpname);
else sprintf(outfec,"%s.cm.ec",gpname);
if ((rfile = fopen(inf1,"r")) == 0) {
fprintf(stderr,"Cannot open file %s.\n",inf1);
exit(1);
}
fsa_read(rfile,&genmult,ip_store,dr,0,TRUE,fsaname);
fclose(rfile);
tmalloc(eqnptr,reduction_equation,maxneweqns)
if (cosets)
separator=rs_wd.separator=genmult.alphabet->base->size+1;
if ((numeqns =
fsa_checkmult(&genmult,eqnptr,maxneweqns,cosets,separator)) > 0) {
/* A multiplier was not valid, so groupname.(mi)diff2 will need updating. */
if (outputwords) {
/* We do not update gpname.diff2, but output the offending words. */
if (cosets) strcpy(outfwg,cosgpname);
else strcpy(outfwg,gpname);
strcat(outfwg,".wg");
wfile=fopen(outfwg,"w");
base_prefix(fsaname);
fprintf(wfile,"%s.wg := [\n",fsaname);
names=genmult.alphabet->base->names;
for (i=0;i<numeqns;i++) {
strcpy(kbm_buffer," [");
if (cosets)
add_word_to_buffer(wfile,eqnptr[i].lhs+1,names);
else
add_word_to_buffer(wfile,eqnptr[i].lhs,names);
strcat(kbm_buffer,",");
add_word_to_buffer(wfile,eqnptr[i].rhs,names);
if (i<numeqns-1) strcat(kbm_buffer,"],");
else strcat(kbm_buffer,"]");
fprintf(wfile,"%s\n",kbm_buffer);
}
fprintf(wfile,"];\n");
fclose(wfile);
fsa_clear(&genmult);
for (i=0;i<numeqns;i++) {
tfree(eqnptr[i].lhs);
tfree(eqnptr[i].rhs);
}
tfree(eqnptr);
wfile=fopen(outfec,"w");
fprintf(wfile,"_ExitCode := 2;\n");
fclose(wfile);
exit(2);
}
fsa_clear(&genmult);
if (cosets) strcat(inf2,".midiff2");
else strcat(inf2,".diff2");
strcpy(outf,inf2);
if (kbm_print_level>1)
printf(" #Altering wd-machine to make it accept new equations.\n");
if ((rfile = fopen(inf2,"r")) == 0) {
fprintf(stderr,"Cannot open file %s.\n",inf2);
exit(1);
}
/* We read groupname.(mi)diff2 into diff2, and then copy it into
* wd_fsa. The copy is used for reducing words - Not surprisingly,
* we get problems if we try to alter it while using it at
* the same time!
*/
fsa_read(rfile,&diff2,DENSE,0,maxwdiffs,TRUE,fsaname);
fclose(rfile);
tmalloc(wd_fsa,fsa,1);
fsa_copy(wd_fsa,&diff2);
if (wtlex) { /* we have to read in the weights from the group file */
if ((rfile = fopen(gpname,"r")) == 0) {
fprintf(stderr,"Cannot open file %s.\n",gpname);
exit(1);
}
read_kbinput_simple(rfile,TRUE,&rws);
fclose(rfile);
/* we only need the weights, which we can simply copy */
for (i=1;i<=rws.num_gens;i++)
weight[i] = rws.weight[i];
weight[rws.num_gens+1]=0; /* padding symbol */
rws_clear(&rws);
strcpy(inf3,gpname);
strcat(inf3,".wa");
if ((rfile = fopen(inf3,"r")) == 0) {
fprintf(stderr,"Cannot open file %s.\n",inf3);
exit(1);
}
fsa_read(rfile,&wa,DENSE,0,0,TRUE,fsaname);
fclose(rfile);
}
rs_wd.wd_fsa = wd_fsa;
reduce_word =
cosets ? diff_reduce_cos : wtlex ? diff_reduce_wl : diff_reduce;
if (fsa_table_dptr_init(wd_fsa)==-1) return -1;
if (fsa_table_dptr_init(&diff2)== -1) return -1;
if (cosets){
tmalloc(diff2.is_initial,boolean,maxwdiffs+1);
for (i=1;i<=maxwdiffs;i++) diff2.is_initial[i]=FALSE;
for (i=1;i<=diff2.num_initial;i++)
diff2.is_initial[diff2.initial[i]]=TRUE;
}
else if (wtlex){
rs_wd.wa = &wa;
rs_wd.weight = weight;
rs_wd.maxreducelen = MAXREDUCELEN;
}
/* We need to know the inverses of generators - let's just work them out! */
ngens = diff2.alphabet->base->size;
if (calculate_inverses(&inv,ngens,&rs_wd)==-1) return -1;
old_ndiff = diff2.states->size;
/* Now add the new equations
* The right hand side of the equation to be added will be the reduction of
* the lhs times the generator which is currently in the rhs.
*/
for (i=0;i<numeqns;i++) {
genstrcat(eqnptr[i].lhs,eqnptr[i].rhs);
tfree(eqnptr[i].rhs);
genstrcpy(testword,eqnptr[i].lhs);
reduce_word(testword,&rs_wd);
tmalloc(eqnptr[i].rhs,gen,genstrlen(testword)+1);
genstrcpy(eqnptr[i].rhs,testword);
if (cosets) {
if (add_wd_fsa_cos(&diff2,eqnptr+i,inv,TRUE,&rs_wd)== -1) exit(1);
}
else
if (add_wd_fsa(&diff2,eqnptr+i,inv,TRUE,&rs_wd)== -1) exit(1);
}
if (cosets) {
tfree(diff2.initial);
tmalloc(diff2.initial,int,diff2.num_initial+1);
ct=0;
for (i=1;i<=diff2.states->size;i++) if (diff2.is_initial[i])
diff2.initial[++ct]=i;
tfree(diff2.is_initial);
make_full_wd_fsa_cos(&diff2,inv,old_ndiff+1,&rs_wd);
}
else
make_full_wd_fsa(&diff2,inv,old_ndiff+1,&rs_wd);
if (kbm_print_level>1)
printf(" #Word-difference machine now has %d states.\n",
diff2.states->size);
wfile = fopen(inf2,"w");
fsa_print(wfile,&diff2,fsaname);
fclose(wfile);
tfree(inv);
fsa_clear(wd_fsa); fsa_clear(&diff2);
tfree(wd_fsa);
if (wtlex)
fsa_clear(&wa);
for (i=0;i<numeqns;i++) {
tfree(eqnptr[i].lhs);
tfree(eqnptr[i].rhs);
}
tfree(eqnptr);
wfile=fopen(outfec,"w");
fprintf(wfile,"_ExitCode := 2;\n");
fclose(wfile);
exit(2);
}
const char *DataObjectToString(
Environment *theEnv,
UDFValue *theDO)
{
CLIPSLexeme *thePtr;
const char *theString;
char *newString;
const char *prefix, *postfix;
size_t length;
CLIPSExternalAddress *theAddress;
StringBuilder *theSB;
char buffer[30];
switch (theDO->header->type)
{
case MULTIFIELD_TYPE:
prefix = "(";
theString = ImplodeMultifield(theEnv,theDO)->contents;
postfix = ")";
break;
case STRING_TYPE:
prefix = "\"";
theString = theDO->lexemeValue->contents;
postfix = "\"";
break;
case INSTANCE_NAME_TYPE:
prefix = "[";
theString = theDO->lexemeValue->contents;
postfix = "]";
break;
case SYMBOL_TYPE:
return theDO->lexemeValue->contents;
case FLOAT_TYPE:
return(FloatToString(theEnv,theDO->floatValue->contents));
case INTEGER_TYPE:
return(LongIntegerToString(theEnv,theDO->integerValue->contents));
case VOID_TYPE:
return("");
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS_TYPE:
if (theDO->instanceValue == &InstanceData(theEnv)->DummyInstance)
{ return("<Dummy Instance>"); }
if (theDO->instanceValue->garbage)
{
prefix = "<Stale Instance-";
theString = theDO->instanceValue->name->contents;
postfix = ">";
}
else
{
prefix = "<Instance-";
theString = GetFullInstanceName(theEnv,theDO->instanceValue)->contents;
postfix = ">";
}
break;
#endif
case EXTERNAL_ADDRESS_TYPE:
theAddress = theDO->externalAddressValue;
theSB = CreateStringBuilder(theEnv,30);
OpenStringBuilderDestination(theEnv,"DOTS",theSB);
if ((EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type] != NULL) &&
(EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction != NULL))
{ (*EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction)(theEnv,"DOTS",theAddress); }
else
{
WriteString(theEnv,"DOTS","<Pointer-");
gensprintf(buffer,"%d-",theAddress->type);
WriteString(theEnv,"DOTS",buffer);
gensprintf(buffer,"%p",theAddress->contents);
WriteString(theEnv,"DOTS",buffer);
WriteString(theEnv,"DOTS",">");
}
thePtr = CreateString(theEnv,theSB->contents);
SBDispose(theSB);
CloseStringBuilderDestination(theEnv,"DOTS");
return thePtr->contents;
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS_TYPE:
if (theDO->factValue == &FactData(theEnv)->DummyFact)
{ return("<Dummy Fact>"); }
gensprintf(buffer,"<Fact-%lld>",theDO->factValue->factIndex);
thePtr = CreateString(theEnv,buffer);
return thePtr->contents;
#endif
default:
return("UNK");
}
length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1;
newString = (char *) genalloc(theEnv,length);
newString[0] = '\0';
genstrcat(newString,prefix);
genstrcat(newString,theString);
genstrcat(newString,postfix);
thePtr = CreateString(theEnv,newString);
genfree(theEnv,newString,length);
return thePtr->contents;
}
