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); }