// Interrogates an SgType to build up a TypeDescription
TypeDescription buildTypeDescription(SgType * const type, SgExpression * const kind)
{
ROSE_ASSERT( type != NULL );
//SgExpression * kind = type->get_type_kind();
TypeDescription::intrinsic_e fortranType = TypeDescription::eNOTINTRINSIC;
// TODO: is this complete?
if( isSgTypeChar(type) != NULL ||
isSgTypeUnsignedChar(type) != NULL ){
fortranType = TypeDescription::eCHARACTER;
} else if( isSgTypeBool(type) != NULL ){
// need to check for bool before int
// as SgBoolType.isIntegerType() == true
fortranType = TypeDescription::eLOGICAL;
} else if( type->isFloatType() ){
fortranType = TypeDescription::eREAL;
} else if( type->isIntegerType() ){
fortranType = TypeDescription::eINTEGER;
} else if( isSgTypeComplex(type) != NULL ){
fortranType = TypeDescription::eCOMPLEX;
}
return TypeDescription(type, fortranType, kind);
}
void
UnparseFortran_type::unparseType(SgType* type, SgUnparse_Info& info, bool printAttrs)
{
ROSE_ASSERT(type != NULL);
#if 0
printf("In unparseType: %s\n", type->class_name().c_str());
// cur << "\n/* Begin unparseType: " << type->class_name() << " */\n";
curprint("\n! Begin unparseType:\n");
#endif
#if 0
if (isDebug())
{
cout << "entering case for %s" << type->class_name() << endl;
}
#endif
switch (type->variantT())
{
case V_SgTypeUnknown:
{
printf ("Error: SgTypeUnknown should not be found in AST \n");
ROSE_ASSERT(false);
break;
}
case V_SgTypeDefault:
{
#if 0
// DQ (12/29/2010): This provides a more obvious way to spot where default types are used (where we used to
// instead use SgTypeInt as the default type it would output "integer".
curprint("ROSE_DEFAULT_TYPE");
#else
// DQ (12/29/2010): We used to store an SgTypeInt in the AST for the default type, now we more correctly store
// the SgDefaultType, but we don't fix them all up yet (but at least they are more explicit in the AST).
// To make the generated code more equivalent we output "integer" for the SgTypeDefault, until it is fixed
// better. Note that all of the test code in Fortran_tests/*.f,f90,f03 pass without this translation via
// the backend.
curprint("integer");
#endif
// DQ (1/25/2011): We now try to to translations of the use of SgTypeDefault when we see it in the AST. This work in incomplete, so we issue a warning at the moment.
if ( SgProject::get_verbose() > 1 )
{
printf ("Warning: SgTypeDefault should not be found in AST \n");
}
break;
}
// DQ (10/5/2010): Comment added: SgTypeVoid might be required for function handling, but for Fortran we don't unparse anything here.
case V_SgTypeVoid: break;
// DQ (10/5/2010): I don't think that SgTypeWchar is used!
// case V_SgTypeWchar: curprint(type->sage_class_name()); break;
// DQ (8/15/2010): I think we were not using the SgStringType before now.
// case V_SgTypeString: curprint("CHARACTER(LEN=*)"); break;
case V_SgTypeString: unparseStringType(type, info, printAttrs); break;
// scalar integral types
case V_SgTypeChar: unparseBaseType(type,"CHARACTER",info); break;
case V_SgTypeInt: unparseBaseType(type,"INTEGER",info); break;
case V_SgTypeSignedInt: unparseBaseType(type,"INTEGER",info); break;
case V_SgTypeUnsignedInt: unparseBaseType(type,"INTEGER",info); break;
// scalar floating point types
case V_SgTypeFloat: unparseBaseType(type,"REAL",info); break;
case V_SgTypeDouble: unparseBaseType(type,"DOUBLE PRECISION",info); break;
// scalar boolean type
case V_SgTypeBool: unparseBaseType(type,"LOGICAL",info); break;
// complex type
case V_SgTypeComplex:
{
SgTypeComplex* cplx = isSgTypeComplex(type);
if(cplx->get_base_type()==NULL || cplx->get_base_type()->variantT()!=V_SgTypeDouble)
unparseBaseType(type,"COMPLEX",info);
else
unparseBaseType(type,"DOUBLE COMPLEX",info);
}
break;
// FMZ (2/2/2009): Add image_team for co-array team declaration
case V_SgTypeCAFTeam: unparseBaseType(type,"TEAM",info); break;
// FMZ (4/14/2009): Added cray pointer
case V_SgTypeCrayPointer: unparseBaseType(type,"POINTER",info); break;
// array type
case V_SgArrayType: unparseArrayType(type, info, printAttrs); break;
// pointer and reference support
case V_SgPointerType: unparsePointerType(type, info, printAttrs); break;
case V_SgReferenceType: unparseReferenceType(type, info); break;
// DQ (8/26/2007): This is relavant to derived types
case V_SgClassType: unparseClassType(type, info); break;
// DQ (12/1/2007): We need to unparse the kind and type parameters
case V_SgModifierType: unparseModifierType(type, info); break;
// DQ (1/24/2011): Added to support procedure pointers (see test2011_28.f90).
case V_SgFunctionType: unparseFunctionType(type, info); break;
default:
{
printf("UnparserFort::unparseType: Error: No handler for %s (variant: %d)\n",type->sage_class_name(), type->variantT());
ROSE_ASSERT(false);
break;
}
}
#if 0
printf ("End unparseType: %s\n",type->class_name().c_str());
// curprint ("\n/* End unparseType: " << type->class_name() << " */\n");
curprint("\n! End unparseType: \n");
#endif
}
