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; }
static ofc_sema_lhs_t* ofc_sema_lhs__implicit_do( ofc_sema_scope_t* scope, ofc_sparse_ref_t src, const ofc_parse_lhs_implicit_do_t* id) { if (!id || !id->init) return NULL; ofc_sema_lhs_t* lhs = (ofc_sema_lhs_t*)malloc( sizeof(ofc_sema_lhs_t)); if (!lhs) return NULL; lhs->type = OFC_SEMA_LHS_IMPLICIT_DO; lhs->src = src; lhs->implicit_do.lhs = NULL; lhs->implicit_do.iter = NULL; lhs->implicit_do.init = NULL; lhs->implicit_do.last = NULL; lhs->implicit_do.step = NULL; lhs->implicit_do.count_var = true; lhs->implicit_do.count = 0; lhs->data_type = NULL; lhs->refcnt = 0; ofc_sema_lhs_t* iter_lhs = ofc_sema_lhs_from_expr( scope, id->iter); if (!iter_lhs) { ofc_sema_lhs_delete(lhs); return NULL; } if (!ofc_sema_lhs_mark_used( iter_lhs, true, true)) { ofc_sema_lhs_delete(iter_lhs); ofc_sema_lhs_delete(lhs); return NULL; } if (iter_lhs->type != OFC_SEMA_LHS_DECL) { ofc_sparse_ref_error(id->iter->src, "Implicit do loop iterator must be a variable"); ofc_sema_lhs_delete(iter_lhs); ofc_sema_lhs_delete(lhs); return NULL; } if (!ofc_sema_decl_reference(iter_lhs->decl)) { ofc_sema_lhs_delete(iter_lhs); ofc_sema_lhs_delete(lhs); return NULL; } lhs->implicit_do.iter = iter_lhs->decl; ofc_sema_lhs_delete(iter_lhs); const ofc_sema_type_t* iter_type = ofc_sema_decl_type(lhs->implicit_do.iter); if (!iter_type) { ofc_sema_lhs_delete(lhs); return NULL; } if (!ofc_sema_type_is_scalar(iter_type)) { ofc_sparse_ref_error(id->iter->src, "Implicit do loop iterator must be a scalar type"); ofc_sema_lhs_delete(lhs); return NULL; } if (!ofc_sema_type_is_integer(iter_type)) { ofc_sparse_ref_warning(id->iter->src, "Using REAL in implicit do loop iterator"); } lhs->implicit_do.init = ofc_sema_expr( scope, id->init); if (!lhs->implicit_do.init) { ofc_sema_lhs_delete(lhs); return NULL; } const ofc_sema_type_t* init_type = ofc_sema_expr_type(lhs->implicit_do.init); if (!init_type) { ofc_sema_lhs_delete(lhs); return NULL; } else if (!ofc_sema_type_compatible( iter_type, init_type)) { ofc_sema_expr_t* cast = ofc_sema_expr_cast( lhs->implicit_do.init, iter_type); if (!cast) { ofc_sema_lhs_delete(lhs); return NULL; } lhs->implicit_do.init = cast; } lhs->implicit_do.last = ofc_sema_expr( scope, id->limit); if (!lhs->implicit_do.last) { ofc_sema_lhs_delete(lhs); return NULL; } const ofc_sema_type_t* last_type = ofc_sema_expr_type(lhs->implicit_do.last); if (!last_type) { ofc_sema_lhs_delete(lhs); return NULL; } else if (!ofc_sema_type_compatible( iter_type, last_type)) { ofc_sema_expr_t* cast = ofc_sema_expr_cast( lhs->implicit_do.last, iter_type); if (!cast) { ofc_sparse_ref_error(id->limit->src, "Expression type '%s' doesn't match iterator type '%s'", ofc_sema_type_str_rep(last_type), ofc_sema_type_str_rep(iter_type)); ofc_sema_lhs_delete(lhs); return NULL; } lhs->implicit_do.last = cast; } if (id->step) { lhs->implicit_do.step = ofc_sema_expr(scope, id->step); if (!lhs->implicit_do.step) { ofc_sema_lhs_delete(lhs); return NULL; } const ofc_sema_type_t* step_type = ofc_sema_expr_type(lhs->implicit_do.step); if (!step_type) { ofc_sema_lhs_delete(lhs); return NULL; } else if (!ofc_sema_type_compatible( iter_type, step_type)) { ofc_sema_expr_t* cast = ofc_sema_expr_cast( lhs->implicit_do.step, iter_type); if (!cast) { ofc_sparse_ref_error(id->step->src, "Expression type '%s' doesn't match iterator type '%s'", ofc_sema_type_str_rep(step_type), ofc_sema_type_str_rep(iter_type)); ofc_sema_lhs_delete(lhs); return NULL; } lhs->implicit_do.step = cast; } } if (id->dlist && (id->dlist->count > 0)) { lhs->implicit_do.lhs = ofc_sema_lhs_list_id(scope, id->dlist); if (!lhs->implicit_do.lhs) { ofc_sema_lhs_delete(lhs); return NULL; } } else { ofc_sema_lhs_delete(lhs); return NULL; } const ofc_sema_typeval_t* ctv[3]; ctv[0] = ofc_sema_expr_constant( lhs->implicit_do.init); ctv[1] = ofc_sema_expr_constant( lhs->implicit_do.last); ctv[2] = ofc_sema_expr_constant( lhs->implicit_do.step); long double first, last, step = 1.0; if (ofc_sema_typeval_get_real(ctv[0], &first) && ofc_sema_typeval_get_real(ctv[1], &last) && (!ctv[2] || ofc_sema_typeval_get_real(ctv[2], &step))) { long double dcount = floor((last - first) / step); if (dcount < 0.0) { ofc_sparse_ref_error(src, "Loop iterates away from limit"); ofc_sema_lhs_delete(lhs); return NULL; } dcount += 1.0; lhs->implicit_do.count = (unsigned)dcount; if ((long double)lhs->implicit_do.count != dcount) { ofc_sema_lhs_delete(lhs); return NULL; } lhs->implicit_do.count_var = false; } else { lhs->implicit_do.count_var = true; lhs->implicit_do.count = 0; } return lhs; }