IntentTag blankIntentForType(Type* t) { if (isSyncType(t) || isAtomicType(t) || t->symbol->hasFlag(FLAG_ARRAY)) { return INTENT_REF; } else if (is_bool_type(t) || is_int_type(t) || is_uint_type(t) || is_real_type(t) || is_imag_type(t) || is_complex_type(t) || is_enum_type(t) || is_string_type(t) || t == dtStringC || t == dtStringCopy || isClass(t) || isRecord(t) || isUnion(t) || t == dtTaskID || t == dtFile || t == dtTaskList || t == dtNil || t == dtOpaque || t->symbol->hasFlag(FLAG_DOMAIN) || t->symbol->hasFlag(FLAG_DISTRIBUTION) || t->symbol->hasFlag(FLAG_EXTERN)) { return constIntentForType(t); } INT_FATAL(t, "Unhandled type in blankIntentForType()"); return INTENT_BLANK; }
static IntentTag constIntentForType(Type* t) { if (isSyncType(t) || isRecordWrappedType(t) || // domain, array, or distribution isRecord(t) || // may eventually want to decide based on size is_string_type(t)) { return INTENT_CONST_REF; } else if (is_bool_type(t) || is_int_type(t) || is_uint_type(t) || is_real_type(t) || is_imag_type(t) || is_complex_type(t) || is_enum_type(t) || isClass(t) || isUnion(t) || isAtomicType(t) || t == dtOpaque || t == dtTaskID || t == dtFile || t == dtTaskList || t == dtNil || t == dtStringC || t == dtStringCopy || t->symbol->hasFlag(FLAG_EXTERN)) { return INTENT_CONST_IN; } INT_FATAL(t, "Unhandled type in constIntentForType()"); return INTENT_CONST; }
bool ArgSymbol::requiresCPtr(void) { /* This used to be true for INTENT_REF, but that is handled with the "_ref" class and we don't need to generate a pointer for it directly */ if (hasFlag(FLAG_ARG_THIS)) { if (is_complex_type(type)) return true; } return argMustUseCPtr(type); }
char fortran_is_intrinsic_type(type_t* t) { t = no_ref(t); if (is_pointer_type(t)) t = pointer_type_get_pointee_type(t); return (is_integer_type(t) || is_floating_type(t) || is_complex_type(t) || is_bool_type(t) || fortran_is_character_type(t)); }
// Is this type OK to pass by value (e.g. it's reasonably-sized)? static bool passableByVal(Type* type) { if (is_bool_type(type) || is_int_type(type) || is_uint_type(type) || is_real_type(type) || is_imag_type(type) || is_complex_type(type) || is_enum_type(type) || isClass(type) || type == dtTaskID || // For now, allow ranges as a special case, not records in general. type->symbol->hasFlag(FLAG_RANGE) || 0) return true; // TODO: allow reasonably-sized records. NB this-in-taskfns-in-ctors.chpl // TODO: allow reasonably-sized tuples - heterogeneous and homogeneous. return false; }
IntentTag blankIntentForType(Type* t) { IntentTag retval = INTENT_BLANK; if (isSyncType(t) || isAtomicType(t) || t->symbol->hasFlag(FLAG_DEFAULT_INTENT_IS_REF) || t->symbol->hasFlag(FLAG_ARRAY)) { retval = INTENT_REF; } else if (is_bool_type(t) || is_int_type(t) || is_uint_type(t) || is_real_type(t) || is_imag_type(t) || is_complex_type(t) || is_enum_type(t) || t == dtStringC || t == dtStringCopy || t == dtCVoidPtr || t == dtCFnPtr || isClass(t) || isRecord(t) || isUnion(t) || t == dtTaskID || t == dtFile || t == dtNil || t == dtOpaque || t->symbol->hasFlag(FLAG_DOMAIN) || t->symbol->hasFlag(FLAG_DISTRIBUTION) || t->symbol->hasFlag(FLAG_EXTERN)) { retval = constIntentForType(t); } else { INT_FATAL(t, "Unhandled type in blankIntentForType()"); } return retval; }
bool Type::is_complex() const { return is_complex_type(_type_info); }
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; }