void print_induction_vars( InductionVarsPerNode ivs )
{
for( InductionVarsPerNode::iterator it = ivs.begin( ); it != ivs.end( ); ++it )
{
InductionVariableData* iv = it->second;
nodecl_t var = iv->get_variable( ).get_nodecl( ).get_internal_nodecl( );
nodecl_t lb = iv->get_lb( ).get_internal_nodecl( );
nodecl_t ub = iv->get_ub( ).get_internal_nodecl( );
nodecl_t incr = iv->get_increment( ).get_internal_nodecl( );
std::string type = iv->get_type_as_string( );
nodecl_t family = iv->get_family( ).get_internal_nodecl( );
std::cerr << " * " << it->first
<< " --> " << codegen_to_str( var, nodecl_retrieve_context( var ) )
<< " [ " << ( nodecl_is_null( lb ) ? "NULL" : codegen_to_str( lb, nodecl_retrieve_context( lb ) ) )
<< " : " << ( nodecl_is_null( ub ) ? "NULL" : codegen_to_str( ub, nodecl_retrieve_context( ub ) ) )
<< " : " << ( nodecl_is_null( incr ) ? "NULL" : codegen_to_str( incr, nodecl_retrieve_context( incr ) ) )
<< " ], [" << type
<< ( nodecl_is_null( family ) ? "" : (": " + std::string( codegen_to_str( family, nodecl_retrieve_context( family ) ) ) ) )
<< " ]" << std::endl;
}
}
bool Symbol::has_alignas() const
{
return !nodecl_is_null(symbol_entity_specs_get_alignas_value(_symbol));
}
bool Symbol::has_initialization() const
{
return (!nodecl_is_null(_symbol->value));
}
bool Symbol::has_default_argument_num(int i) const
{
return (i < symbol_entity_specs_get_num_parameters(_symbol)
&& symbol_entity_specs_get_default_argument_info_num(_symbol, i) != NULL
&& !nodecl_is_null(symbol_entity_specs_get_default_argument_info_num(_symbol, i)->argument));
}
bool Symbol::has_default_argument_num(int i) const
{
return (_symbol->entity_specs.default_argument_info != NULL
&& _symbol->entity_specs.default_argument_info[i] != NULL
&& !nodecl_is_null(_symbol->entity_specs.default_argument_info[i]->argument));
}
const char* fortran_print_type_str(type_t* t)
{
t = no_ref(t);
if (is_error_type(t))
{
return "<error-type>";
}
if (is_hollerith_type(t))
{
return "HOLLERITH";
}
const char* result = "";
char is_pointer = 0;
if (is_pointer_type(t))
{
is_pointer = 1;
t = pointer_type_get_pointee_type(t);
}
struct array_spec_tag {
nodecl_t lower;
nodecl_t upper;
char is_undefined;
} array_spec_list[MCXX_MAX_ARRAY_SPECIFIER] = { { nodecl_null(), nodecl_null(), 0 } };
int array_spec_idx;
for (array_spec_idx = MCXX_MAX_ARRAY_SPECIFIER - 1;
fortran_is_array_type(t);
array_spec_idx--)
{
if (array_spec_idx < 0)
{
internal_error("too many array dimensions %d\n", MCXX_MAX_ARRAY_SPECIFIER);
}
if (!array_type_is_unknown_size(t))
{
array_spec_list[array_spec_idx].lower = array_type_get_array_lower_bound(t);
array_spec_list[array_spec_idx].upper = array_type_get_array_upper_bound(t);
}
else
{
array_spec_list[array_spec_idx].is_undefined = 1;
}
t = array_type_get_element_type(t);
}
char is_array = (array_spec_idx != (MCXX_MAX_ARRAY_SPECIFIER - 1));
if (is_bool_type(t)
|| is_integer_type(t)
|| is_floating_type(t)
|| is_double_type(t)
|| is_complex_type(t))
{
const char* type_name = NULL;
char c[128] = { 0 };
if (is_bool_type(t))
{
type_name = "LOGICAL";
}
else if (is_integer_type(t))
{
type_name = "INTEGER";
}
else if (is_floating_type(t))
{
type_name = "REAL";
}
else if (is_complex_type(t))
{
type_name = "COMPLEX";
}
else
{
internal_error("unreachable code", 0);
}
size_t size = type_get_size(t);
if (is_floating_type(t))
{
// KIND of floats is their size in byes (using the bits as in IEEE754)
size = (floating_type_get_info(t)->bits) / 8;
}
else if (is_complex_type(t))
{
// KIND of a complex is the KIND of its component type
type_t* f = complex_type_get_base_type(t);
size = (floating_type_get_info(f)->bits) / 8;
}
snprintf(c, 127, "%s(%zd)", type_name, size);
c[127] = '\0';
result = uniquestr(c);
}
else if (is_class_type(t))
{
scope_entry_t* entry = named_type_get_symbol(t);
char c[128] = { 0 };
snprintf(c, 127, "TYPE(%s)",
entry->symbol_name);
c[127] = '\0';
result = uniquestr(c);
}
else if (fortran_is_character_type(t))
{
nodecl_t length = array_type_get_array_size_expr(t);
char c[128] = { 0 };
snprintf(c, 127, "CHARACTER(LEN=%s)",
nodecl_is_null(length) ? "*" : codegen_to_str(length, nodecl_retrieve_context(length)));
c[127] = '\0';
result = uniquestr(c);
}
else if (is_function_type(t))
{
result = "PROCEDURE";
}
else
{
const char* non_printable = NULL;
uniquestr_sprintf(&non_printable, "non-fortran type '%s'", print_declarator(t));
return non_printable;
}
if (is_pointer)
{
result = strappend(result, ", POINTER");
}
if (is_array)
{
array_spec_idx++;
result = strappend(result, ", DIMENSION(");
while (array_spec_idx <= (MCXX_MAX_ARRAY_SPECIFIER - 1))
{
if (!array_spec_list[array_spec_idx].is_undefined)
{
result = strappend(result, codegen_to_str(array_spec_list[array_spec_idx].lower,
nodecl_retrieve_context(array_spec_list[array_spec_idx].lower)));
result = strappend(result, ":");
result = strappend(result, codegen_to_str(array_spec_list[array_spec_idx].upper,
nodecl_retrieve_context(array_spec_list[array_spec_idx].upper)));
}
else
{
result = strappend(result, ":");
}
if ((array_spec_idx + 1) <= (MCXX_MAX_ARRAY_SPECIFIER - 1))
{
result = strappend(result, ", ");
}
array_spec_idx++;
}
result = strappend(result, ")");
}
return result;
}