bool ofc_sema_stmt_do_label_print(
ofc_colstr_t* cs,
const ofc_sema_stmt_t* stmt)
{
if (!cs || (stmt->type != OFC_SEMA_STMT_DO_LABEL))
return false;
if (!ofc_colstr_atomic_writef(cs, "DO ")
|| !ofc_sema_expr_print(cs, stmt->do_label.end_label)
|| !ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_lhs_print(cs, stmt->do_label.iter)
|| !ofc_colstr_atomic_writef(cs, " =")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, stmt->do_label.init))
return false;
if (stmt->do_label.last)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, stmt->do_label.last))
return false;
}
if (stmt->do_label.step)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, stmt->do_label.step))
return false;
}
return true;
}
static bool ofc_sema_inquire_print_elem(
ofc_colstr_t* cs,
const char* name,
const ofc_sema_lhs_t* elem)
{
if (!cs || !elem)
return false;
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, name)
|| !ofc_colstr_atomic_writef(cs, "= "))
return false;
return ofc_sema_lhs_print(cs, elem);
}
bool ofc_sema_stmt_do_block_print(
ofc_colstr_t* cs, unsigned indent,
ofc_sema_label_map_t* label_map,
const ofc_sema_stmt_t* stmt)
{
if (!cs || (stmt->type != OFC_SEMA_STMT_DO_BLOCK))
return false;
if (!ofc_colstr_atomic_writef(cs, "DO ")
|| !ofc_sema_lhs_print(cs, stmt->do_block.iter)
|| !ofc_colstr_atomic_writef(cs, "=")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, stmt->do_block.init))
return false;
if (stmt->do_block.last)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, stmt->do_block.last))
return false;
}
if (stmt->do_block.step)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, stmt->do_block.step))
return false;
}
if (!ofc_sema_stmt_list_print(
cs, (indent + 1), label_map,
stmt->do_block.block))
return false;
const ofc_sema_label_t* label
= ofc_sema_label_map_find_end_block(
label_map, stmt);
const unsigned* ulabel = NULL;
if (label) ulabel = &label->number;
if (!ofc_colstr_newline(cs, indent, ulabel)
|| !ofc_colstr_atomic_writef(cs, "END DO"))
return false;
return true;
}
bool ofc_sema_lhs_list_print(
ofc_colstr_t* cs,
const ofc_sema_lhs_list_t* lhs_list)
{
if (!cs || !lhs_list)
return false;
unsigned i;
for (i = 0; i < lhs_list->count; i++)
{
if (!ofc_sema_lhs_print(cs, lhs_list->lhs[i]))
return false;
if ((lhs_list->count > 1)
&& (i < lhs_list->count - 1))
{
if (!ofc_colstr_atomic_writef(cs, ", "))
return false;
}
}
return true;
}
bool ofc_sema_lhs_print(
ofc_colstr_t* cs,
const ofc_sema_lhs_t* lhs)
{
if (!cs || !lhs) return false;
switch(lhs->type)
{
case OFC_SEMA_LHS_ARRAY_INDEX:
case OFC_SEMA_LHS_ARRAY_SLICE:
case OFC_SEMA_LHS_STRUCTURE_MEMBER:
case OFC_SEMA_LHS_SUBSTRING:
if (!ofc_sema_lhs_print(
cs, lhs->parent))
return false;
break;
default:
break;
}
switch(lhs->type)
{
case OFC_SEMA_LHS_DECL:
if (!ofc_sema_decl_print_name(cs, lhs->decl))
return false;
break;
case OFC_SEMA_LHS_ARRAY_INDEX:
if (!ofc_sema_array_index_print(cs, lhs->index))
return false;
break;
case OFC_SEMA_LHS_ARRAY_SLICE:
if (!ofc_sema_array_slice_print(cs, lhs->slice.slice))
return false;
break;
case OFC_SEMA_LHS_SUBSTRING:
if (!ofc_colstr_atomic_writef(cs, "("))
return false;
if (lhs->substring.first
&& !ofc_sema_expr_print(cs,
lhs->substring.first))
return false;
if (!ofc_colstr_atomic_writef(cs, ":"))
return false;
if (lhs->substring.last
&& !ofc_sema_expr_print(cs,
lhs->substring.last))
return false;
if (!ofc_colstr_atomic_writef(cs, ")"))
return false;
break;
case OFC_SEMA_LHS_STRUCTURE_MEMBER:
{
char member = '%';
ofc_sema_structure_t* structure
= ofc_sema_lhs_structure(lhs->parent);
if (!ofc_sema_structure_is_derived_type(structure))
member = '.';
if (!ofc_colstr_atomic_writef(cs, "%c", member)
|| !ofc_sema_decl_print_name(cs, lhs->member))
return false;
}
break;
case OFC_SEMA_LHS_IMPLICIT_DO:
if (!ofc_colstr_atomic_writef(cs, "(")
|| !ofc_sema_lhs_list_print(cs, lhs->implicit_do.lhs)
|| !ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_decl_print_name(cs, lhs->implicit_do.iter)
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "=")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, lhs->implicit_do.init)
|| !ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, lhs->implicit_do.last))
return false;
if (lhs->implicit_do.step)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_expr_print(cs, lhs->implicit_do.step))
return false;
}
if (!ofc_colstr_atomic_writef(cs, ")"))
return false;
break;
default:
return false;
}
return true;
}