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