C++ (Cpp) gfc_traverse_user_op Examples

Example #1

File: interface.c Project: BackupTheBerlios/iphone-binutils-svn

void
gfc_check_interfaces (gfc_namespace * ns)
{
    gfc_namespace *old_ns, *ns2;
    char interface_name[100];
    gfc_intrinsic_op i;

    old_ns = gfc_current_ns;
    gfc_current_ns = ns;

    gfc_traverse_ns (ns, check_sym_interfaces);

    gfc_traverse_user_op (ns, check_uop_interfaces);

    for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
    {
        if (i == INTRINSIC_USER)
            continue;

        if (i == INTRINSIC_ASSIGN)
            strcpy (interface_name, "intrinsic assignment operator");
        else
            sprintf (interface_name, "intrinsic '%s' operator",
                     gfc_op2string (i));

        if (check_interface0 (ns->operator[i], interface_name))
            continue;

        check_operator_interface (ns->operator[i], i);

        for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
            if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
                                  interface_name))
                break;
    }

    gfc_current_ns = old_ns;
}

Example #2

File: dump-parse-tree.c Project: ChaosJohn/gcc

static void
show_namespace (gfc_namespace *ns)
{
  gfc_interface *intr;
  gfc_namespace *save;
  int op;
  gfc_equiv *eq;
  int i;

  gcc_assert (ns);
  save = gfc_current_ns;

  show_indent ();
  fputs ("Namespace:", dumpfile);

  i = 0;
  do
    {
      int l = i;
      while (i < GFC_LETTERS - 1
	     && gfc_compare_types (&ns->default_type[i+1],
				   &ns->default_type[l]))
	i++;

      if (i > l)
	fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
      else
	fprintf (dumpfile, " %c: ", l+'A');

      show_typespec(&ns->default_type[l]);
      i++;
    } while (i < GFC_LETTERS);

  if (ns->proc_name != NULL)
    {
      show_indent ();
      fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
    }

  ++show_level;
  gfc_current_ns = ns;
  gfc_traverse_symtree (ns->common_root, show_common);

  gfc_traverse_symtree (ns->sym_root, show_symtree);

  for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
    {
      /* User operator interfaces */
      intr = ns->op[op];
      if (intr == NULL)
	continue;

      show_indent ();
      fprintf (dumpfile, "Operator interfaces for %s:",
	       gfc_op2string ((gfc_intrinsic_op) op));

      for (; intr; intr = intr->next)
	fprintf (dumpfile, " %s", intr->sym->name);
    }

  if (ns->uop_root != NULL)
    {
      show_indent ();
      fputs ("User operators:\n", dumpfile);
      gfc_traverse_user_op (ns, show_uop);
    }
  
  for (eq = ns->equiv; eq; eq = eq->next)
    show_equiv (eq);

  fputc ('\n', dumpfile);
  show_indent ();
  fputs ("code:", dumpfile);
  show_code (show_level, ns->code);
  --show_level;

  for (ns = ns->contained; ns; ns = ns->sibling)
    {
      fputs ("\nCONTAINS\n", dumpfile);
      ++show_level;
      show_namespace (ns);
      --show_level;
    }

  fputc ('\n', dumpfile);
  gfc_current_ns = save;
}

Example #3

File: dump-parse-tree.c Project: mbref/gcc-412-microblaze

void
gfc_show_namespace (gfc_namespace * ns)
{
  gfc_interface *intr;
  gfc_namespace *save;
  gfc_intrinsic_op op;
  gfc_equiv *eq;
  int i;

  save = gfc_current_ns;
  show_level++;

  show_indent ();
  gfc_status ("Namespace:");

  if (ns != NULL)
    {
      i = 0;
      do
	{
	  int l = i;
	  while (i < GFC_LETTERS - 1
		 && gfc_compare_types(&ns->default_type[i+1],
				      &ns->default_type[l]))
	    i++;

	  if (i > l)
	    gfc_status(" %c-%c: ", l+'A', i+'A');
	  else
	    gfc_status(" %c: ", l+'A');

	  gfc_show_typespec(&ns->default_type[l]);
	  i++;
      } while (i < GFC_LETTERS);

      if (ns->proc_name != NULL)
	{
	  show_indent ();
	  gfc_status ("procedure name = %s", ns->proc_name->name);
	}

      gfc_current_ns = ns;
      gfc_traverse_symtree (ns->common_root, show_common);

      gfc_traverse_symtree (ns->sym_root, show_symtree);

      for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
	{
	  /* User operator interfaces */
	  intr = ns->operator[op];
	  if (intr == NULL)
	    continue;

	  show_indent ();
	  gfc_status ("Operator interfaces for %s:", gfc_op2string (op));

	  for (; intr; intr = intr->next)
	    gfc_status (" %s", intr->sym->name);
	}

      if (ns->uop_root != NULL)
	{
	  show_indent ();
	  gfc_status ("User operators:\n");
	  gfc_traverse_user_op (ns, show_uop);
	}
    }
  
  for (eq = ns->equiv; eq; eq = eq->next)
    gfc_show_equiv (eq);

  gfc_status_char ('\n');
  gfc_status_char ('\n');

  gfc_show_code (0, ns->code);

  for (ns = ns->contained; ns; ns = ns->sibling)
    {
      show_indent ();
      gfc_status ("CONTAINS\n");
      gfc_show_namespace (ns);
    }

  show_level--;
  gfc_status_char ('\n');
  gfc_current_ns = save;
}