// 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 }