static void checkAlias(ATerm alias)
{
if (ATgetType(alias) == AT_APPL) {
ATermAppl appl = (ATermAppl)alias;
AFun afun = ATgetAFun(appl);
if (ATgetArity(afun) == 0 && !ATisQuoted(afun)) {
return;
}
}
ATfprintf(stderr, "incorrect alias: %t\n", alias);
exit(1);
}
static void serializeUntypedTerm(A2PWriter writer, ATerm value){
int type = ATgetType(value);
switch(type){
case AT_INT:
writeInteger(writer, (ATermInt) value);
break;
case AT_REAL:
writeDouble(writer, (ATermReal) value);
break;
case AT_APPL:
{
ATermAppl appl = (ATermAppl) value;
AFun fun = ATgetAFun(appl);
if(ATisQuoted(fun) == ATfalse){
A2PType expected = A2PnodeType();
ATermList annotations = (ATermList) ATgetAnnotations(value);
if(annotations == NULL){
writeNode(writer, expected, appl);
}else{
if(((A2PNodeType) expected->theType)->declaredAnnotations == NULL){ fprintf(stderr, "Node term has annotations, but none are declared.\n"); exit(1); }
writeAnnotatedNode(writer, expected, appl, annotations);
}
}else{
if(ATgetArity(fun) != 0){ fprintf(stderr, "Quoted appl (assumed to be a string) has a non-zero arity.\n"); exit(1);}
writeString(writer, appl);
}
}
break;
case AT_LIST:
writeList(writer, A2PlistType(A2PvalueType()), (ATermList) value);
break;
default:
fprintf(stderr, "Encountered unwriteable type: %d.\n", type);
exit(1);
}
}
int doConvert(FILE *fpOut, int traceLevel) {
SVCstateIndex fromState, toState;
SVClabelIndex label/*,taulabel*/;
SVCparameterIndex parameter;
SVCbool tempbool=0;
char name[256], *first, *last;
if (traceLevel>0){
/* Get file header info */
fprintf(stderr, "Svc version %s %s\n", SVCgetFormatVersion(&inFile),
SVCgetIndexFlag(&inFile)?"(indexed)":"");
fprintf(stderr, " filename %s\n", SVCgetFilename(&inFile));
fprintf(stderr, " date %s\n", SVCgetDate(&inFile));
fprintf(stderr, " version %s\n", SVCgetVersion(&inFile));
fprintf(stderr, " type %s\n", SVCgetType(&inFile));
fprintf(stderr, " creator %s\n", SVCgetCreator(&inFile));
fprintf(stderr, " states %ld\n", SVCnumStates(&inFile));
fprintf(stderr, " transitions %ld\n", SVCnumTransitions(&inFile));
fprintf(stderr, " labels %ld\n", SVCnumLabels(&inFile));
fprintf(stderr, " parameters %ld\n", SVCnumParameters(&inFile));
ATfprintf(stderr, " initial state %t\n", SVCstate2ATerm(&inFile,SVCgetInitialState(&inFile)));
fprintf(stderr, " comments %s\n", SVCgetComments(&inFile));
}
/* base name of input file */
strncpy(name, SVCgetFilename(&inFile), 256);
first = strrchr(name,'/');
if (!first) first = name;
last = strrchr(first,'.');
if (last && !strcmp(last,INFILE_EXT)) *last ='\0';
/* fprintf(fpOut, "des(%ld,%ld,%ld)\n", SVCgetInitialState(&inFile),
SVCnumTransitions(&inFile),
SVCnumStates(&inFile));
while (SVCgetNextTransition(&inFile, &fromState, &label, &toState, ¶meter)) {
ATfprintf(fpOut, "(%d, %t, %d)\n", fromState, SVClabel2ATerm(&inFile,label), toState);
} */
/* adaption to output dot files (by Jan Friso Groote) */
/* taulabel=SVCnewLabel(&inFile,ATmake("\"tau\""),&tempbool);
if (tempbool)
{ *//* the label tau did not exist yet, let's try i */
/* taulabel=SVCnewLabel(&inFile,ATmake("\"i\""),&tempbool);
if (tempbool)
{ *//* the label i does not exist also, so forget about tau's */
/* taulabel=0;
}
}*/
fprintf(fpOut,"digraph \"%s\" {\n", first);
/* fprintf(fpOut,"size=\"7,10.5\";\n"); */
fprintf(fpOut,"center=TRUE;\n");
fprintf(fpOut,"mclimit=10.0;\n");
fprintf(fpOut,"nodesep=0.05;\n");
fprintf(fpOut,"node[width=0.25,height=0.25,label=\"\"];\n");
fprintf(fpOut,"%d[peripheries=2];\n",SVCgetInitialState(&inFile));
while (SVCgetNextTransition(&inFile, &fromState, &label, &toState, ¶meter)) {
ATerm t = SVClabel2ATerm(&inFile,label);
AFun s = ATgetAFun(t);
if (ATisQuoted(s) && ATgetArity(s)==0)
ATfprintf(fpOut, "%d->%d[label=%t];\n",fromState, toState, t);
else
ATfprintf(fpOut, "%d->%d[label=\"%t\"];\n",fromState, toState, t);
/*
if (label==taulabel)
ATfprintf(fpOut,"color=\"grey\",fontsize=\"18\"]\n");
else
ATfprintf(fpOut,"fontsize=\"32\", weight=\"4\"]\n");
*/
}
fprintf(fpOut,"}\n");
if (SVCclose(&inFile)<0){
if (traceLevel>0) {
fprintf(stderr, "File trailer corrupt...\n");
}
return -1;
}
fclose(fpOut);
return EXIT_OK;
} /* doConvert */
static void doSerialize(A2PWriter writer, A2PType expected, ATerm value){
DKISIndexedSet sharedValues = writer->valueSharingMap;
int valueHash = hashValue(value);
int valueId = DKISget(sharedValues, (void*) value, (void*) expected, valueHash); /* TODO: Fix sharing (check types). */
if(valueId != -1){
writeByteToBuffer(writer->buffer, PDB_SHARED_FLAG);
printInteger(writer->buffer, valueId);
return;
}
switch(expected->id){
case PDB_VALUE_TYPE_HEADER:
serializeUntypedTerm(writer, value);
break;
case PDB_BOOL_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Boolean didn't have AT_APPL type.\n"); exit(1); }
writeBool(writer, (ATermAppl) value);
break;
case PDB_INTEGER_TYPE_HEADER:
if(ATgetType(value) != AT_INT){ fprintf(stderr, "Integer didn't have AT_INT type.\n"); exit(1); }
writeInteger(writer, (ATermInt) value);
break;
case PDB_DOUBLE_TYPE_HEADER:
if(ATgetType(value) != AT_REAL){ fprintf(stderr, "Double didn't have AT_REAL type.\n"); exit(1); }
writeDouble(writer, (ATermReal) value);
break;
case PDB_STRING_TYPE_HEADER:
if(ATgetType(value) != AT_APPL || ATisQuoted(ATgetAFun((ATermAppl) value)) == ATfalse){ fprintf(stderr, "String didn't have 'quoted' AT_APPL type.\n"); ATabort(""); exit(1); }
writeString(writer, (ATermAppl) value);
break;
case PDB_SOURCE_LOCATION_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Source location didn't have AT_APPL type.\n"); exit(1); }
writeSourceLocation(writer, (ATermAppl) value);
break;
case PDB_NODE_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Node didn't have AT_APPL type.\n"); exit(1); }
{
ATermList annotations = (ATermList) ATgetAnnotations(value);
if(annotations == NULL){
writeNode(writer, expected, (ATermAppl) value);
}else{
if(((A2PNodeType) expected->theType)->declaredAnnotations == NULL){ fprintf(stderr, "Node term has annotations, but none are declared.\n"); exit(1); }
writeAnnotatedNode(writer, expected, (ATermAppl) value, annotations);
}
}
break;
case PDB_TUPLE_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Tuple didn't have AT_APPL type.\n"); exit(1); }
writeTuple(writer, expected, (ATermAppl) value);
break;
case PDB_LIST_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "List didn't have AT_LIST type.\n"); exit(1); }
writeList(writer, expected, (ATermList) value);
break;
case PDB_SET_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "Set didn't have AT_LIST type.\n"); exit(1); }
writeSet(writer, expected, (ATermList) value);
break;
case PDB_RELATION_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "Relation didn't have AT_LIST type.\n"); exit(1); }
writeRelation(writer, expected, (ATermList) value);
break;
case PDB_MAP_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "Map didn't have AT_LIST type.\n"); exit(1); }
writeMap(writer, expected, (ATermList) value);
break;
case PDB_CONSTRUCTOR_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Constructor didn't have AT_APPL type.\n"); exit(1); }
{
ATermList annotations = (ATermList) ATgetAnnotations(value);
if(annotations == NULL){
writeConstructor(writer, expected, (ATermAppl) value);
}else{
if(((A2PConstructorType) expected->theType)->declaredAnnotations == NULL){ fprintf(stderr, "Constructor term has annotations, but none are declared.\n"); exit(1); }
writeAnnotatedConstructor(writer, expected, (ATermAppl) value, annotations);
}
}
break;
case PDB_ADT_TYPE_HEADER:
writeADT(writer, expected, value);
break;
default:
fprintf(stderr, "Unserializable type: %d\n.", expected->id);
exit(1);
}
DKISstore(sharedValues, (void*) value, (void*) expected, valueHash);
}
static void term2buf(ATerm t)
{
ATerm annos = AT_getAnnotations(t);
if(annos != NULL) {
char2buf('{');
}
switch(ATgetType(t)) {
case AT_INT:
wprintf("%d", ATgetInt((ATermInt)t));
break;
case AT_REAL:
wprintf("%f", ATgetReal((ATermReal)t));
break;
case AT_APPL:
{
int cur_arg, arity;
ATermAppl appl = (ATermAppl)t;
AFun sym = ATgetSymbol(appl);
if(ATisQuoted(sym))
qstr2buf(ATgetName(sym));
else
str2buf(ATgetName(sym));
arity = ATgetArity(sym);
if(arity > 0) {
char2buf('(');
for(cur_arg=0; cur_arg<arity; cur_arg++) {
term2buf(ATgetArgument(appl, cur_arg));
if(cur_arg < (arity-1))
char2buf(',');
}
char2buf(')');
}
}
break;
case AT_LIST:
{
ATermList l = (ATermList)t;
char2buf('{');
while(!ATisEmpty(l)) {
ATerm el = ATgetFirst(l);
l = ATgetNext(l);
term2buf(el);
if(!ATisEmpty(l))
char2buf(' ');
}
char2buf('}');
}
break;
case AT_PLACEHOLDER:
{
char2buf('<');
term2buf(ATgetPlaceholder((ATermPlaceholder)t));
char2buf('>');
}
break;
case AT_BLOB:
ATerror("blobs are not supported by tcltk-adapter!\n");
default:
ATabort("illegal term type!\n");
}
if(annos != NULL) {
char2buf(' ');
term2buf(annos);
char2buf('}');
}
}