type_t* fortran_rebuild_array_type(type_t* rank0_type, type_t* array_type) { rank0_type = no_ref(rank0_type); ERROR_CONDITION(!fortran_is_scalar_type(rank0_type) && !fortran_is_character_type(rank0_type), "Invalid rank0 type", 0); if (!fortran_is_array_type(array_type)) { return rank0_type; } else { type_t* t = fortran_rebuild_array_type(rank0_type, array_type_get_element_type(array_type)); if (array_type_has_region(array_type)) { return get_array_type_bounds_with_regions(t, array_type_get_array_lower_bound(array_type), array_type_get_array_upper_bound(array_type), array_type_get_array_size_expr_context(array_type), // Why did we do this so difficult? nodecl_make_range( nodecl_shallow_copy(array_type_get_region_lower_bound(array_type)), nodecl_shallow_copy(array_type_get_region_upper_bound(array_type)), nodecl_shallow_copy(array_type_get_region_stride(array_type)), fortran_get_default_integer_type(), make_locus("", 0, 0)), array_type_get_region_size_expr_context(array_type) ); } else if (array_type_with_descriptor(array_type)) { return get_array_type_bounds_with_descriptor(t, array_type_get_array_lower_bound(array_type), array_type_get_array_upper_bound(array_type), array_type_get_array_size_expr_context(array_type)); } else { return get_array_type_bounds(t, array_type_get_array_lower_bound(array_type), array_type_get_array_upper_bound(array_type), array_type_get_array_size_expr_context(array_type)); } } }
Type Type::fix_references_() { if ((IS_C_LANGUAGE && this->is_any_reference()) || (IS_CXX_LANGUAGE && this->is_rebindable_reference())) { TL::Type ref = this->references_to(); if (ref.is_array()) { // T (&a)[10] -> T * const // T (&a)[10][20] -> T (* const)[20] ref = ref.array_element(); } // T &a -> T * const a TL::Type ptr = ref.get_pointer_to(); if (!this->is_rebindable_reference()) { ptr = ptr.get_const_type(); } return ptr; } else if (IS_FORTRAN_LANGUAGE && this->is_any_reference()) { return this->references_to(); } else if (this->is_array()) { if (this->array_is_region()) { Nodecl::NodeclBase lb, reg_lb, ub, reg_ub; this->array_get_bounds(lb, ub); this->array_get_region_bounds(reg_lb, reg_ub); TL::Scope sc = array_type_get_region_size_expr_context(this->get_internal_type()); return this->array_element().fix_references_().get_array_to_with_region(lb, ub, reg_lb, reg_ub, sc); } else { Nodecl::NodeclBase size = this->array_get_size(); TL::Scope sc = array_type_get_array_size_expr_context(this->get_internal_type()); return this->array_element().fix_references_().get_array_to(size, sc); } } else if (this->is_pointer()) { TL::Type fixed = this->points_to().fix_references_().get_pointer_to(); cv_qualifier_t cv_qualif = CV_NONE; ::advance_over_typedefs_with_cv_qualif(this->get_internal_type(), &cv_qualif); fixed = ::get_cv_qualified_type(fixed.get_internal_type(), cv_qualif); return fixed; } else if (this->is_function()) { // Do not fix unprototyped functions if (this->lacks_prototype()) return (*this); cv_qualifier_t cv_qualif = CV_NONE; ::advance_over_typedefs_with_cv_qualif(this->get_internal_type(), &cv_qualif); ref_qualifier_t ref_qualifier = function_type_get_ref_qualifier(this->get_internal_type()); TL::Type fixed_result = this->returns().fix_references_(); bool has_ellipsis = 0; TL::ObjectList<TL::Type> fixed_parameters = this->parameters(has_ellipsis); for (TL::ObjectList<TL::Type>::iterator it = fixed_parameters.begin(); it != fixed_parameters.end(); it++) { *it = it->fix_references_(); } TL::ObjectList<TL::Type> nonadjusted_fixed_parameters = this->nonadjusted_parameters(); for (TL::ObjectList<TL::Type>::iterator it = nonadjusted_fixed_parameters.begin(); it != nonadjusted_fixed_parameters.end(); it++) { *it = it->fix_references_(); } TL::Type fixed_function = fixed_result.get_function_returning( fixed_parameters, nonadjusted_fixed_parameters, has_ellipsis, ref_qualifier); fixed_function = TL::Type(get_cv_qualified_type(fixed_function.get_internal_type(), cv_qualif)); return fixed_function; } // Note: we are not fixing classes else { // Anything else must be left untouched return (*this); } }