コード例 #1
0
ファイル: iresolve.c プロジェクト: pathscale/fortran-fe
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");   
}        
コード例 #2
0
ファイル: show.c プロジェクト: jasonlarkin/disorder
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;
    }
}
コード例 #3
0
ファイル: iresolve.c プロジェクト: pathscale/fortran-fe
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);
}