bool ofc_sema_stmt_do_while_print(
ofc_colstr_t* cs,
const ofc_sema_stmt_t* stmt)
{
if (!cs || (stmt->type != OFC_SEMA_STMT_DO_WHILE))
return false;
if (!ofc_colstr_atomic_writef(cs, "DO WHILE")
|| !ofc_sema_expr_print(cs, stmt->do_while.end_label)
|| !ofc_sema_expr_print(cs, stmt->do_while.cond))
return false;
return true;
}
bool ofc_sema_stmt_do_while_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_WHILE_BLOCK))
return false;
if (!ofc_colstr_atomic_writef(cs, "DO WHILE")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "(")
|| !ofc_sema_expr_print(cs, stmt->do_while_block.cond)
|| !ofc_colstr_atomic_writef(cs, ")")
|| !ofc_sema_stmt_list_print(
cs, (indent + 1), label_map,
stmt->do_while_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_stmt_assign_print(
ofc_colstr_t* cs,
const ofc_sema_stmt_t* stmt)
{
return (cs && stmt
&& ofc_colstr_atomic_writef(cs, "ASSIGN")
&& ofc_colstr_atomic_writef(cs, " ")
&& ofc_sema_expr_print(cs, stmt->assign.label)
&& ofc_colstr_atomic_writef(cs, " ")
&& ofc_colstr_atomic_writef(cs, "TO")
&& ofc_colstr_atomic_writef(cs, " ")
&& ofc_sema_decl_print_name(cs, stmt->assign.dest));
}
static bool ofc_sema_stmt_read__print_optional(
ofc_colstr_t* cs, const char* name,
const ofc_sema_expr_t* expr)
{
if (!cs || !expr)
return false;
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, name)
|| !ofc_colstr_atomic_writef(cs, "= ")
|| !ofc_sema_expr_print(cs, expr))
return false;
return true;
}
bool ofc_sema_stmt_read_print(ofc_colstr_t* cs,
const ofc_sema_stmt_t* stmt)
{
if (!cs || (stmt->type != OFC_SEMA_STMT_IO_READ))
return false;
if (!ofc_colstr_atomic_writef(cs, "READ")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "("))
return false;
if (stmt->io_read.stdin)
{
if (!ofc_colstr_atomic_writef(cs, "*"))
return false;
}
else
{
if (!ofc_sema_expr_print(cs,
stmt->io_read.unit))
return false;
}
if (stmt->io_read.format_ldio)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " "))
return false;
if (!ofc_colstr_atomic_writef(cs, "*"))
return false;
}
else if (stmt->io_read.formatted)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "FMT", stmt->io_read.format))
return false;
}
if (stmt->io_read.iostat)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "IOSTAT", stmt->io_read.iostat))
return false;
}
if (stmt->io_read.rec)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "REC", stmt->io_read.rec))
return false;
}
if (stmt->io_read.err)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "ERR", stmt->io_read.err))
return false;
}
if (stmt->io_read.eor)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "EOR", stmt->io_read.eor))
return false;
}
if (stmt->io_read.end)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "END", stmt->io_read.end))
return false;
}
if (stmt->io_read.size)
{
if (!ofc_sema_stmt_read__print_optional(
cs, "SIZE", stmt->io_read.size))
return false;
}
if (!ofc_colstr_atomic_writef(cs, ")"))
return false;
if (stmt->io_read.iolist)
{
if (!ofc_colstr_atomic_writef(cs, " ")
|| !ofc_sema_lhs_list_print(cs,
stmt->io_read.iolist))
return false;
}
return true;
}
bool ofc_sema_stmt_io_inquire_print(
ofc_colstr_t* cs,
const ofc_sema_stmt_t* stmt)
{
if (!cs || !stmt
|| stmt->type != OFC_SEMA_STMT_IO_INQUIRE)
return false;
if (!ofc_colstr_atomic_writef(cs, "INQUIRE")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "("))
return false;
if (stmt->io_inquire.unit)
if (!ofc_colstr_atomic_writef(cs, "UNIT= ")
|| !ofc_sema_expr_print(cs, stmt->io_inquire.unit)) return false;
if (stmt->io_inquire.file)
if (!ofc_colstr_atomic_writef(cs, "FILE= ")
|| !ofc_sema_expr_print(cs, stmt->io_inquire.file)) return false;
if (stmt->io_inquire.access)
if (!ofc_sema_inquire_print_elem(cs, "ACCESS", stmt->io_inquire.access)) return false;
if (stmt->io_inquire.action)
if (!ofc_sema_inquire_print_elem(cs, "ACTION", stmt->io_inquire.action)) return false;
if (stmt->io_inquire.blank)
if (!ofc_sema_inquire_print_elem(cs, "BLANK", stmt->io_inquire.blank)) return false;
if (stmt->io_inquire.delim)
if (!ofc_sema_inquire_print_elem(cs, "DELIM", stmt->io_inquire.delim)) return false;
if (stmt->io_inquire.direct)
if (!ofc_sema_inquire_print_elem(cs, "DIRECT", stmt->io_inquire.direct)) return false;
if (stmt->io_inquire.exist)
if (!ofc_sema_inquire_print_elem(cs, "EXIST", stmt->io_inquire.exist)) return false;
if (stmt->io_inquire.form)
if (!ofc_sema_inquire_print_elem(cs, "FORM", stmt->io_inquire.form)) return false;
if (stmt->io_inquire.formatted)
if (!ofc_sema_inquire_print_elem(cs, "FORMATTED", stmt->io_inquire.formatted)) return false;
if (stmt->io_inquire.iostat)
if (!ofc_sema_inquire_print_elem(cs, "IOSTAT", stmt->io_inquire.iostat)) return false;
if (stmt->io_inquire.name)
if (!ofc_sema_inquire_print_elem(cs, "NAME", stmt->io_inquire.name)) return false;
if (stmt->io_inquire.named)
if (!ofc_sema_inquire_print_elem(cs, "NAMED", stmt->io_inquire.named)) return false;
if (stmt->io_inquire.nextrec)
if (!ofc_sema_inquire_print_elem(cs, "NEXTREC", stmt->io_inquire.nextrec)) return false;
if (stmt->io_inquire.number)
if (!ofc_sema_inquire_print_elem(cs, "NUMBER", stmt->io_inquire.number)) return false;
if (stmt->io_inquire.opened)
if (!ofc_sema_inquire_print_elem(cs, "OPENED", stmt->io_inquire.opened)) return false;
if (stmt->io_inquire.pad)
if (!ofc_sema_inquire_print_elem(cs, "PAD", stmt->io_inquire.pad)) return false;
if (stmt->io_inquire.position)
if (!ofc_sema_inquire_print_elem(cs, "POSITION", stmt->io_inquire.position)) return false;
if (stmt->io_inquire.read)
if (!ofc_sema_inquire_print_elem(cs, "READ", stmt->io_inquire.read)) return false;
if (stmt->io_inquire.readwrite)
if (!ofc_sema_inquire_print_elem(cs, "READWRITE", stmt->io_inquire.readwrite)) return false;
if (stmt->io_inquire.recl)
if (!ofc_sema_inquire_print_elem(cs, "RECL", stmt->io_inquire.recl)) return false;
if (stmt->io_inquire.sequential)
if (!ofc_sema_inquire_print_elem(cs, "SEQUENTIAL", stmt->io_inquire.sequential)) return false;
if (stmt->io_inquire.unformatted)
if (!ofc_sema_inquire_print_elem(cs, "UNFORMATTED", stmt->io_inquire.unformatted)) return false;
if (stmt->io_inquire.write)
if (!ofc_sema_inquire_print_elem(cs, "WRITE", stmt->io_inquire.write)) return false;
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;
}
bool ofc_sema_stmt_io_position_print(
ofc_colstr_t* cs,
const ofc_sema_stmt_t* stmt)
{
if (!cs || !stmt)
return false;
switch (stmt->type)
{
case OFC_SEMA_STMT_IO_REWIND:
if (!ofc_colstr_atomic_writef(cs, "REWIND"))
return false;
break;
case OFC_SEMA_STMT_IO_END_FILE:
if (!ofc_colstr_atomic_writef(cs, "END FILE"))
return false;
break;
case OFC_SEMA_STMT_IO_BACKSPACE:
if (!ofc_colstr_atomic_writef(cs, "BACKSPACE"))
return false;
break;
default:
return false;
}
if (!ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "("))
return false;
if (stmt->io_position.unit)
{
if (!ofc_colstr_atomic_writef(cs, "UNIT")
|| !ofc_colstr_atomic_writef(cs, "=")
|| !ofc_sema_expr_print(cs, stmt->io_position.unit))
return false;
}
if (stmt->io_position.iostat)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "IOSTAT")
|| !ofc_colstr_atomic_writef(cs, "=")
|| !ofc_sema_expr_print(cs, stmt->io_position.iostat))
return false;
}
if (stmt->io_position.err)
{
if (!ofc_colstr_atomic_writef(cs, ",")
|| !ofc_colstr_atomic_writef(cs, " ")
|| !ofc_colstr_atomic_writef(cs, "ERR")
|| !ofc_colstr_atomic_writef(cs, "=")
|| !ofc_sema_expr_print(cs, stmt->io_position.err))
return false;
}
if (!ofc_colstr_atomic_writef(cs, ")"))
return false;
return true;
}
