static ofc_sema_lhs_list_t* ofc_sema_lhs__list(
ofc_sema_scope_t* scope,
const ofc_parse_lhs_list_t* plist,
bool allow_implicit_do)
{
if (!plist)
return NULL;
ofc_sema_lhs_list_t* list
= (ofc_sema_lhs_list_t*)malloc(
sizeof(ofc_sema_lhs_list_t));
if (!list) return NULL;
list->count = 0;
list->lhs = (ofc_sema_lhs_t**)malloc(
plist->count * sizeof(ofc_sema_lhs_t*));
if (!list->lhs)
{
free(list);
return NULL;
}
unsigned i;
for (i = 0; i < plist->count; i++)
{
if (plist->lhs[i]->type == OFC_PARSE_LHS_IMPLICIT_DO)
{
if (!allow_implicit_do)
{
ofc_sema_lhs_list_delete(list);
return NULL;
}
list->lhs[i] = ofc_sema_lhs__implicit_do(
scope, plist->lhs[i]->src,
plist->lhs[i]->implicit_do);
}
else
{
list->lhs[i] = ofc_sema_lhs(
scope, plist->lhs[i]);
}
if (!list->lhs[i])
{
ofc_sema_lhs_list_delete(list);
return NULL;
}
list->count++;
}
return list;
}
ofc_sema_lhs_t* ofc_sema_lhs_from_expr(
ofc_sema_scope_t* scope,
ofc_parse_expr_t* expr)
{
if (!scope || !expr) return NULL;
if (expr->type != OFC_PARSE_EXPR_VARIABLE)
{
ofc_sparse_ref_error(expr->src,
"Attempting to convert to lhs and expression that is not an lhs");
return NULL;
}
return ofc_sema_lhs(
scope, expr->variable);
}
static bool ofc_sema_stmt__loop_control(
ofc_sema_scope_t* scope,
const ofc_parse_assign_t* parse_init,
const ofc_parse_expr_t* parse_last,
const ofc_parse_expr_t* parse_step,
ofc_sema_lhs_t** sema_iter,
ofc_sema_expr_t** sema_init,
ofc_sema_expr_t** sema_last,
ofc_sema_expr_t** sema_step)
{
*sema_iter = ofc_sema_lhs(
scope, parse_init->name);
if (!*sema_iter) return false;
const ofc_sema_type_t* dtype
= ofc_sema_lhs_type(*sema_iter);
if (!ofc_sema_type_is_scalar(dtype))
{
ofc_sparse_ref_error(parse_init->name->src,
"DO loop iterator must be a scalar type.");
ofc_sema_lhs_delete(*sema_iter);
return false;
}
if (!ofc_sema_type_is_integer(dtype))
{
ofc_sparse_ref_warning(parse_init->name->src,
"Using REAL in DO loop iterator.");
}
*sema_init = ofc_sema_expr(
scope, parse_init->init);
if (!*sema_init)
{
ofc_sema_lhs_delete(*sema_iter);
return false;
}
if (!ofc_sema_type_compatible(dtype,
ofc_sema_expr_type(*sema_init)))
{
ofc_sema_expr_t* cast
= ofc_sema_expr_cast(*sema_init, dtype);
if (!cast)
{
const ofc_sema_type_t* expr_type
= ofc_sema_expr_type(*sema_init);
ofc_sparse_ref_error(parse_init->init->src,
"Expression type %s doesn't match lhs type %s",
ofc_sema_type_str_rep(expr_type),
ofc_sema_type_str_rep(dtype));
ofc_sema_expr_delete(*sema_init);
ofc_sema_lhs_delete(*sema_iter);
return false;
}
*sema_init = cast;
}
*sema_last = ofc_sema_expr(
scope, parse_last);
if (!*sema_last)
{
ofc_sema_expr_delete(*sema_init);
ofc_sema_lhs_delete(*sema_iter);
return false;
}
if (!ofc_sema_type_compatible(dtype,
ofc_sema_expr_type(*sema_last)))
{
ofc_sema_expr_t* cast
= ofc_sema_expr_cast(*sema_last, dtype);
if (!cast)
{
const ofc_sema_type_t* expr_type =
ofc_sema_expr_type(*sema_last);
ofc_sparse_ref_error(parse_last->src,
"Expression type %s doesn't match lhs type %s",
ofc_sema_type_str_rep(expr_type),
ofc_sema_type_str_rep(dtype));
ofc_sema_expr_delete(*sema_init);
ofc_sema_expr_delete(*sema_last);
ofc_sema_lhs_delete(*sema_iter);
return false;
}
*sema_last = cast;
}
*sema_step = NULL;
if (parse_step)
{
*sema_step = ofc_sema_expr(
scope, parse_step);
if (!*sema_step)
{
ofc_sema_expr_delete(*sema_init);
ofc_sema_expr_delete(*sema_last);
ofc_sema_lhs_delete(*sema_iter);
return false;
}
if (!ofc_sema_type_compatible(dtype,
ofc_sema_expr_type(*sema_step)))
{
ofc_sema_expr_t* cast
= ofc_sema_expr_cast(*sema_step, dtype);
if (!cast)
{
const ofc_sema_type_t* expr_type =
ofc_sema_expr_type(*sema_step);
ofc_sparse_ref_error(parse_step->src,
"Expression type %s doesn't match lhs type %s",
ofc_sema_type_str_rep(expr_type),
ofc_sema_type_str_rep(dtype));
ofc_sema_expr_delete(*sema_step);
ofc_sema_expr_delete(*sema_init);
ofc_sema_expr_delete(*sema_last);
ofc_sema_lhs_delete(*sema_iter);
return false;
}
*sema_step = cast;
}
}
return true;
}
