void show_expr(is_expr* node)
{
printf("(");
switch(node->type)
{
case t_expr_var:
show_var(node->data.var);
break;
case t_expr_new_op:
show_new_op(node->data.new_op);
break;
case t_expr_type_cast:
printf("(");
show_type_decl(node->data.type_cast.type);
printf(")");
show_expr(node->data.type_cast.expr);
break;
case t_expr_constant:
show_constant(node->data.constant);
break;
case t_expr_func_call:
show_func_call(node->data.func_call);
break;
case t_expr_operation:
show_expr_op(node->data.operation);
break;
}
printf(")");
}
static void show_monomial(FILE *f, rational_t *a, int32_t x, bool first) {
assert(0 <= x && x < NVARS);
assert(q_is_nonzero(a));
show_constant(f, a, first);
fprintf(f, " %s", var[x].name);
}
static void show_constraint(FILE *f, int_constraint_t *cnstr) {
fprintf(f, " IsInt(");
show_sum(f, cnstr->sum, cnstr->sum_nterms, true);
show_sum(f, cnstr->fixed_sum, cnstr->fixed_nterms, false);
if (q_is_nonzero(&cnstr->constant)) {
show_constant(f, &cnstr->constant, false);
}
fprintf(f, ")\n");
}
void show_switch_stmt(is_switch_stmt* node, int tablevel)
{
tab(tablevel);
switch (node->type)
{
case t_switch_stmt_default:
printf("default:\n");
break;
case t_switch_stmt_case:
printf("case ");
show_constant(node->constant);
printf(":\n");
}
show_stmt_list(node->list, tablevel+1);
}
void g95_show_expr(g95_expr *p) {
g95_symbol *sym;
if (p == NULL) {
g95_status("expr()");
return;
}
/* Show expression */
switch(p->type) {
case EXPR_SUBSTRING:
g95_status("substr(");
show_string_constant(p->value.character.string,
p->value.character.length);
g95_status(", start=");
g95_show_expr(p->ref->u.ss.start);
g95_status(", end=");
g95_show_expr(p->ref->u.ss.end);
break;
case EXPR_STRUCTURE:
g95_status("scons('%s', cons=", p->symbol->name);
show_constructor(p->value.constructor.c);
break;
case EXPR_ARRAY:
g95_status("acons(cons=");
show_constructor(p->value.constructor.c);
if (p->ref != NULL) {
g95_status(", ref=");
show_refs(p->ref);
}
break;
case EXPR_NULL:
g95_status("null()");
break;
case EXPR_CONSTANT:
g95_status("const(");
show_constant(p);
break;
case EXPR_VARIABLE:
g95_status("var(");
sym = p->symbol;
if (sym->ns->proc_name != NULL && sym->ns->proc_name->name != NULL)
g95_status("'%s:%s'", sym->ns->proc_name->name, sym->name);
else
g95_status("'%s'", sym->name);
if (p->ref != NULL) {
g95_status(", ref=");
show_refs(p->ref);
}
break;
case EXPR_OP:
g95_status("op(");
switch(p->value.op.operator) {
case INTRINSIC_UPLUS: g95_status("'U+'"); break;
case INTRINSIC_UMINUS: g95_status("'U-'"); break;
case INTRINSIC_PLUS: g95_status("'+'"); break;
case INTRINSIC_MINUS: g95_status("'-'"); break;
case INTRINSIC_TIMES: g95_status("'*'"); break;
case INTRINSIC_DIVIDE: g95_status("'/'"); break;
case INTRINSIC_POWER: g95_status("'**'"); break;
case INTRINSIC_CONCAT: g95_status("'//'"); break;
case INTRINSIC_AND: g95_status("'AND'"); break;
case INTRINSIC_OR: g95_status("'OR'"); break;
case INTRINSIC_EQV: g95_status("'EQV'"); break;
case INTRINSIC_NEQV: g95_status("'NEQV'"); break;
case INTRINSIC_EQ: g95_status("'='"); break;
case INTRINSIC_NE: g95_status("'<>'"); break;
case INTRINSIC_GT: g95_status("'>'"); break;
case INTRINSIC_GE: g95_status("'>='"); break;
case INTRINSIC_LT: g95_status("'<'"); break;
case INTRINSIC_LE: g95_status("'<='"); break;
case INTRINSIC_NOT: g95_status("'NOT'"); break;
case INTRINSIC_PAREN: g95_status("()"); break;
default:
g95_internal_error("g95_show_expr(): "
"Bad intrinsic in expression!");
}
g95_status(", op1=");
g95_show_expr(p->value.op.op1);
if (p->value.op.op2) {
g95_status(", op2=");
g95_show_expr(p->value.op.op2);
}
break;
case EXPR_FUNCTION:
g95_status("func(");
if (p->value.function.isym == NULL)
g95_status("'%s:%s'", p->symbol->module, p->symbol->name);
else
g95_status("'%s'", p->value.function.iname);
g95_status(", arg=");
show_actual_arglist(p->value.function.actual);
break;
case EXPR_UNKNOWN:
g95_status("unknown('%s'", p->symbol->name);
break;
default:
g95_internal_error("g95_show_expr(): Bad type");
break;
}
g95_status_char(')');
}