void g95_resolve_cmplx(g95_expr *k, g95_expr *r, g95_expr *e, g95_expr *k0) {
k->ts.type = BT_COMPLEX;
k->ts.kind = (k0 == NULL)
? g95_default_real_kind()
: mpz_get_si(k0->value.integer);
k->value.function.name = g95_get_string(PREFIX "cmplx");
}
static void show_constant(g95_expr *p) {
switch(p->ts.type) {
case BT_INTEGER:
g95_status_char('\'');
fputs(bi_to_string(p->value.integer), stdout);
if (p->ts.kind != g95_default_integer_kind(0))
g95_status("_%d", p->ts.kind);
g95_status_char('\'');
break;
case BT_LOGICAL:
g95_status(p->value.logical ? "'.true.'" : "'.false.'");
break;
case BT_REAL:
g95_status_char('\'');
fputs(bg_to_string(p->value.real), stdout);
if (p->ts.kind != g95_default_real_kind(1))
g95_status("_%d", p->ts.kind);
g95_status_char('\'');
break;
case BT_CHARACTER:
show_string_constant(p->value.character.string,
p->value.character.length);
break;
case BT_COMPLEX:
g95_status_char('\'');
fputs(bg_to_string(p->value.complex.r), stdout);
if (p->ts.kind != g95_default_complex_kind())
g95_status("_%d", p->ts.kind);
g95_status_char(' ');
fputs(bg_to_string(p->value.complex.i), stdout);
if (p->ts.kind != g95_default_complex_kind())
g95_status("_%d", p->ts.kind);
g95_status_char('\'');
break;
default:
g95_internal_error("show_constant(): Bad type");
break;
}
}
void g95_resolve_real(g95_expr *o, g95_expr *w, g95_expr *k0) {
o->ts.type = BT_REAL;
if (k0 != NULL)
o->ts.kind = mpz_get_si(k0->value.integer);
else
o->ts.kind = (w->ts.type == BT_COMPLEX) ?
w->ts.kind : g95_default_real_kind();
o->value.function.name =
g95_get_string(PREFIX "real_%d_%c%d", o->ts.kind,
g95_type_letter(w->ts.type), w->ts.kind);
}