static ofc_sema_lhs_t* ofc_sema_lhs_slice( ofc_sema_lhs_t* lhs, ofc_sema_array_slice_t* slice) { if (!slice) return NULL; const ofc_sema_array_t* parray = ofc_sema_lhs_array(lhs); if (!parray) return NULL; if (!ofc_sema_lhs_reference(lhs)) return NULL; ofc_sema_array_t* array = ofc_sema_array_slice_dims(slice, parray); if (!array) { ofc_sema_lhs_delete(lhs); return NULL; } ofc_sema_lhs_t* alhs = (ofc_sema_lhs_t*)malloc( sizeof(ofc_sema_lhs_t)); if (!alhs) { ofc_sema_array_delete(array); ofc_sema_lhs_delete(lhs); return NULL; } alhs->type = OFC_SEMA_LHS_ARRAY_SLICE; alhs->src = lhs->src; alhs->parent = lhs; alhs->data_type = lhs->data_type; alhs->refcnt = 0; alhs->slice.slice = slice; alhs->slice.dims = array; return alhs; }
bool ofc_sema_stmt_dimension( ofc_sema_scope_t* scope, const ofc_parse_stmt_t* stmt) { if (!scope || !stmt || (stmt->type != OFC_PARSE_STMT_DIMENSION) || !stmt->dimension) return false; unsigned i; for (i = 0; i < stmt->dimension->count; i++) { ofc_parse_lhs_t* lhs = stmt->dimension->lhs[i]; if (!lhs) continue; if (lhs->type != OFC_PARSE_LHS_ARRAY) { ofc_sparse_ref_error(lhs->src, "DIMENSION entry must contain array dimensions."); return false; } if (!lhs->parent || (lhs->parent->type != OFC_PARSE_LHS_VARIABLE)) { ofc_sparse_ref_error(lhs->src, "Invalid array layout in DIMENSION"); return false; } ofc_sparse_ref_t base_name; if (!ofc_parse_lhs_base_name( *lhs, &base_name)) return false; const ofc_sema_decl_t* decl = ofc_sema_scope_decl_find( scope, base_name.string, true); if (decl) { ofc_sparse_ref_error(lhs->src, "Can't modify dimensions of declaration after use"); return false; } ofc_sema_spec_t* spec = ofc_sema_scope_spec_modify( scope, base_name); if (!spec) { ofc_sparse_ref_error(lhs->src, "No declaration for '%.*s' and no valid IMPLICIT rule.", base_name.string.size, base_name.string.base); return false; } ofc_sema_array_t* array = ofc_sema_array( scope, lhs->array.index); if (!array) return false; if (spec->array) { bool conflict = !ofc_sema_array_compare( spec->array, array); ofc_sema_array_delete(array); if (conflict) { ofc_sparse_ref_error(lhs->src, "Conflicting array dimension specifications"); return false; } ofc_sparse_ref_warning(lhs->src, "Multiple array dimension specifications"); } else { spec->array = array; } } return true; }
void ofc_sema_lhs_delete( ofc_sema_lhs_t* lhs) { if (!lhs) return; if (lhs->refcnt > 0) { lhs->refcnt--; return; } switch (lhs->type) { case OFC_SEMA_LHS_DECL: ofc_sema_decl_delete(lhs->decl); break; case OFC_SEMA_LHS_ARRAY_INDEX: case OFC_SEMA_LHS_ARRAY_SLICE: case OFC_SEMA_LHS_SUBSTRING: case OFC_SEMA_LHS_STRUCTURE_MEMBER: ofc_sema_lhs_delete(lhs->parent); break; default: break; } switch (lhs->type) { case OFC_SEMA_LHS_ARRAY_INDEX: ofc_sema_array_index_delete(lhs->index); break; case OFC_SEMA_LHS_ARRAY_SLICE: ofc_sema_array_slice_delete(lhs->slice.slice); ofc_sema_array_delete(lhs->slice.dims); break; case OFC_SEMA_LHS_SUBSTRING: if (lhs->substring.last != lhs->substring.first) ofc_sema_expr_delete(lhs->substring.last); ofc_sema_expr_delete(lhs->substring.first); break; case OFC_SEMA_LHS_STRUCTURE_MEMBER: ofc_sema_decl_delete(lhs->member); break; case OFC_SEMA_LHS_IMPLICIT_DO: ofc_sema_lhs_list_delete(lhs->implicit_do.lhs); ofc_sema_decl_delete(lhs->implicit_do.iter); ofc_sema_expr_delete(lhs->implicit_do.init); ofc_sema_expr_delete(lhs->implicit_do.last); ofc_sema_expr_delete(lhs->implicit_do.step); break; default: break; } free(lhs); }
ofc_sema_lhs_t* ofc_sema_lhs_copy_replace( const ofc_sema_lhs_t* lhs, const ofc_sema_decl_t* replace, const ofc_sema_expr_t* with) { if (!lhs) return NULL; ofc_sema_lhs_t* copy = (ofc_sema_lhs_t*)malloc( sizeof(ofc_sema_lhs_t)); if (!copy) return NULL; *copy = *lhs; if (lhs->type == OFC_SEMA_LHS_DECL) { if (!ofc_sema_decl_reference(lhs->decl)) { free(copy); return NULL; } } else if (lhs->type == OFC_SEMA_LHS_IMPLICIT_DO) { copy->implicit_do.lhs = ofc_sema_lhs_list_copy_replace( lhs->implicit_do.lhs, replace, with); copy->implicit_do.iter = (ofc_sema_decl_reference(lhs->implicit_do.iter) ? lhs->implicit_do.iter : NULL); copy->implicit_do.init = ofc_sema_expr_copy_replace( lhs->implicit_do.init, replace, with); copy->implicit_do.last = ofc_sema_expr_copy_replace( lhs->implicit_do.last, replace, with); copy->implicit_do.step = ofc_sema_expr_copy_replace( lhs->implicit_do.step, replace, with); if (!copy->implicit_do.lhs || !copy->implicit_do.iter || !copy->implicit_do.init || !copy->implicit_do.last || (lhs->implicit_do.step && !copy->implicit_do.step)) { ofc_sema_lhs_delete(copy); return NULL; } } else { switch (lhs->type) { case OFC_SEMA_LHS_ARRAY_INDEX: copy->index = ofc_sema_array_index_copy_replace( lhs->index, replace, with); if (!copy->index) { free(copy); return NULL; } break; case OFC_SEMA_LHS_ARRAY_SLICE: copy->slice.slice = ofc_sema_array_slice_copy_replace( lhs->slice.slice, replace, with); copy->slice.dims = ofc_sema_array_copy_replace( lhs->slice.dims, replace, with); if (!copy->slice.slice || !copy->slice.dims) { ofc_sema_array_slice_delete(copy->slice.slice); ofc_sema_array_delete(copy->slice.dims); free(copy); return NULL; } break; case OFC_SEMA_LHS_SUBSTRING: if (lhs->substring.first) { copy->substring.first = ofc_sema_expr_copy_replace( lhs->substring.first, replace, with); if (!copy->substring.first) { free(copy); return NULL; } } if (lhs->substring.last) { copy->substring.last = ofc_sema_expr_copy_replace( lhs->substring.last, replace, with); if (!copy->substring.last) { ofc_sema_expr_delete( copy->substring.first); free(copy); return NULL; } } break; case OFC_SEMA_LHS_STRUCTURE_MEMBER: break; default: free(copy); return NULL; } copy->parent = ofc_sema_lhs_copy_replace( lhs->parent, replace, with); if (!copy->parent) { ofc_sema_lhs_delete(copy); return NULL; } } return copy; }