read.c

/* -*- c -*- */

/*
 * Project:     libFIRM
 * File name:   ir/external/read.c
 * Purpose:     Read descriptions of external effects
 * Author:      Florian
 * Modified by: Boris Boesler
 * Created:     11.10.2004
 * CVS-ID:      $Id$
 * Copyright:   (c) 1999-2004 Universitt Karlsruhe
 * Licence:     This file is protected by GPL -  GNU GENERAL PUBLIC LICENSE.
 */

#ifdef HAVE_CONFIG_H
# include "config.h"
#endif

/* get prototype for alloca somehow */
#ifdef HAVE_ALLOCA_H
# include <alloca.h>
#endif
#ifdef HAVE_STDLIB_H
# include <stdlib.h>
#endif
#ifdef HAVE_STRING_H
# include <string.h>
#endif

#include <assert.h>

#include <libxml/xmlmemory.h>
#include <libxml/parser.h>
#include <libxml/encoding.h>

#include "read_t.h"
#include "read.h"
#include "irprog.h"
#include "irgraph.h"
#include "pseudo_irg.h"
#include "ircons.h"
#include "irmode.h"
#include "irdump.h"
#include "irvrfy.h"
#include "type.h"
#include "tv.h"
#include "xmalloc.h"

# define MY_ENCODING "ISO-8859-1"

# define CHECK(ptr,msg)     assert (ptr && msg)

# define NODE_NAME(n, m) (0 == xmlStrcmp (n->name, (const xmlChar*) #m))
# define CHECK_NAME(n, m) assert (0 == xmlStrcmp (n->name, (const xmlChar*) #m))

# define NEW(T)     (T*)xmalloc(sizeof (T))


#define VERBOSE_PRINTING 0

#if VERBOSE_PRINTING
# define VERBOSE_PRINT(s) fprintf s
#else
# define VERBOSE_PRINT(s)
#endif

#define NO_ID NULL

static type_t *types = NULL;
static entity_t *entities = NULL;
static proc_t *procs = NULL;
static module_t *modules = NULL;

/* @@@ HACK */
static module_t *current_module = NULL;

#if VERBOSE_PRINTING
/* this is only used inside a VERBOSE_PRINT() call */
static const char *effect_string[] = {
  "arg",
  "valref",
  "select",
  "load",
  "store",
  "alloc",
  "call",
  "unknown",
  "join",
  "raise",
  "ret"
};
#endif /* defined VERBOSE_PRINTING */

static const ident*
getNodeModuleIdent (xmlNodePtr node)
{
  const char *mod_str = (const char*) xmlGetProp (node, BAD_CAST "module");

  if (NULL == mod_str) {
    return (NULL);
  } else {
    const ident *res = new_id_from_str (mod_str);
    return (res);
  }
}

static const char*
getNodeProcName (xmlNodePtr node)
{
  const char *proc_str = (const char*) xmlGetProp (node, BAD_CAST "procname");
  assert (proc_str);
  return (proc_str);
}

# ifdef NEEDED
static char*
getNodeClassName (xmlNodePtr node)
{
  char *proc_str = (char*) xmlGetProp (node, BAD_CAST "class");
  assert (proc_str);
  return ( (proc_str));
}
# endif /* defined NEEDED */

static const char*
getNodeId (xmlNodePtr node)
{
  const char *id_str = (const char*) xmlGetProp (node, BAD_CAST "id");
  assert (id_str);
  return (id_str);
}

static const char *
getNodeRefId (xmlNodePtr node)
{
  const char *refid_str = (char*) xmlGetProp (node, BAD_CAST "refid");
  assert (refid_str);
  return ((refid_str));
}

static const char*
getNodeTypeId (xmlNodePtr node)
{
  const char *type_str = (char*) xmlGetProp (node, BAD_CAST "type");
  assert (type_str);
  return ((type_str));
}

static const char
*getNodeTypeStr (xmlNodePtr node)
{
  const char *type_str = (char*) xmlGetProp (node, BAD_CAST "type");
  assert (type_str);
  return (type_str);
}

static const char*
getNodeOwnerStr (xmlNodePtr node)
{
  const char *owner_str = (char*) xmlGetProp (node, BAD_CAST "owner");
  assert (owner_str);
  return (owner_str);
}

static const char
*getNodeEntityStr (xmlNodePtr node)
{
  const char *ent_str = (char*) xmlGetProp (node, BAD_CAST "entity");
  assert (ent_str);

  return (ent_str);
}


/*
  was Public Interface
*/
# ifdef NEEDED
static
type_t *getTypeByIdent (const ident *id)
{
  type_t *curr = types; // @@@ TODO module -> types

  while (NULL != curr) {
    if (id == curr -> type_ident) {
      return (curr);
    }
    curr = curr->prev;
  }

  return (NULL);
}
# endif /* defined NEEDED */

# ifdef NEEDED
static
type_t *getTypeById (const ident *id)
{
  type_t *curr = types; // which ones?

  while (NULL != curr) {
    if (id == curr -> id) {
      return (curr);
    }
    curr = curr->prev;
  }

  return (NULL);
}
# endif /* defined NEEDED */

# ifdef NEEDED
static
entity_t *getEntityByIdents (const ident *name, const ident *tp_ident)
{
  entity_t *curr = entities; // TODO module -> entities

  while (NULL != curr) {
    if ((name == curr -> ent_ident)
    && (tp_ident == curr -> tp_ident)) {
      return (curr);
    }
    curr = curr->prev;
  }

  return (NULL);
}
# endif /* defined NEEDED */

static
entity_t *getEntityById (const ident *id)
{
  entity_t *curr = entities;

  while (NULL != curr) {
    if (id == curr -> id) {
      return (curr);
    }
    curr = curr->prev;
  }

  return (NULL);
}

# ifdef NEEDED
static
proc_t *getEffectByName (const ident *proc_ident)
{
  proc_t *curr_effs = procs;

  while (NULL != curr_effs) {
    if (proc_ident == curr_effs -> proc_ident) {
      return (curr_effs);
    }
    curr_effs = curr_effs->next;
  }

  return (NULL);
}
# endif /* defined NEEDED */

static
xmlNodePtr get_any_valid_child(xmlNodePtr elem)
{
  xmlNodePtr child;

  assert(elem && "no element");
  child = elem -> xmlChildrenNode;
  while(child && (NODE_NAME (child, comment))) {
    child = child -> next;
  }
  return(child);
}

static
xmlNodePtr get_valid_child(xmlNodePtr elem)
{
  xmlNodePtr child;

  child = get_any_valid_child(elem);
  assert(child && "lost child in deep black forest");
  return(child);
}

/*
 * parse XML structure and construct an additional structure
 */
static eff_t *
parseArg (xmlDocPtr doc, xmlNodePtr argelm)
{
  const char *id;
  const char *typeid;
  int num;
  char *num_str;
  eff_t *arg;

  CHECK_NAME (argelm, arg);
  VERBOSE_PRINT ((stdout, "arg node \t0x%08x\n", (int) argelm));

  id = getNodeId (argelm);
  VERBOSE_PRINT ((stdout, "arg->id = \"%s\"\n", id));
  num_str = (char*) xmlGetProp (argelm, BAD_CAST "number");
  num = atoi (num_str);
  VERBOSE_PRINT ((stdout, "arg->no = \"%d\"\n", num));

  typeid = getNodeTypeStr (argelm);

  arg = NEW (eff_t);
  arg -> kind = eff_arg;
  arg -> id = new_id_from_str(id);
  arg -> effect.arg.num = num;
  arg -> effect.arg.type_ident = new_id_from_str(typeid);

  return (arg);
}

static eff_t*
parseValref (xmlDocPtr doc, xmlNodePtr valelm)
{
  const char *ref_id;
  eff_t *valref;

  CHECK_NAME (valelm, valref);
  VERBOSE_PRINT ((stdout, "valref node \t0x%08x\n", (int) valelm));

  ref_id = getNodeRefId (valelm);
  VERBOSE_PRINT ((stdout, "val->refid = \"%s\"\n", ref_id));

  valref = NEW (eff_t);
  valref->kind = eff_valref;
  valref-> id = new_id_from_str(ref_id);

  return (valref);
}

static eff_t*
parseSelect (xmlDocPtr doc, xmlNodePtr selelm)
{
  const ident *entity_id = new_id_from_str(getNodeEntityStr (selelm));
  entity_t *ent;
  xmlNodePtr child;
  eff_t *valref = NULL;
  eff_t *sel = NEW (eff_t);
  sel->kind = eff_select;

  CHECK_NAME (selelm, select);
  VERBOSE_PRINT ((stdout, "select node \t0x%08x\n", (int) selelm));

  ent = getEntityById (entity_id);
  assert(ent && "entity not found");
  VERBOSE_PRINT ((stdout, "select entity %s\n", get_id_str(ent -> ent_ident)));

  child = selelm->xmlChildrenNode;

  if (child) {
    valref = parseValref (doc, child);
  }

  sel-> id = valref ? valref-> id : NO_ID;
  sel-> effect.select.ent = ent;

  if (valref) {
    free (valref);
  }

  return (sel);
}

static eff_t*
parseLoad (xmlDocPtr doc, xmlNodePtr loadelm)
{
  const ident *id;
  xmlNodePtr child;
  eff_t *sel;
  eff_t *load = NEW (eff_t);
  load->kind = eff_load;

  CHECK_NAME (loadelm, load);
  VERBOSE_PRINT ((stdout, "load node \t0x%08x\n", (int) loadelm));
  id = new_id_from_str(getNodeId (loadelm));

  child = get_valid_child(loadelm);
  if(NODE_NAME (child, select)) {
    sel = parseSelect (doc, child);
    load-> effect.load.ent = sel-> effect.select.ent;
    VERBOSE_PRINT ((stdout, "load entity \t%s\n",
            get_id_str(load -> effect.load.ent -> ent_ident)));
  }
  else {
    sel = parseValref (doc, child);
    load-> effect.load.ent = NULL;
  }

  load-> id = id;
  load-> effect.load.ptrrefid = sel-> id;

  free (sel);

  return (load);
}

static eff_t*
parseStore (xmlDocPtr doc, xmlNodePtr storeelm)
{
  xmlNodePtr child;
  eff_t *sel;
  eff_t *valref;
  eff_t *store = NEW (eff_t);
  store->kind = eff_store;

  CHECK_NAME (storeelm, store);
  VERBOSE_PRINT ((stdout, "store node \t0x%08x\n", (int) storeelm));

  child = get_valid_child(storeelm);
  if(NODE_NAME (child, select)) {
    sel = parseSelect (doc, child);
    store-> effect.store.ent = sel-> effect.select.ent;
  }
  else {
    sel = parseValref (doc, child);
    store-> effect.store.ent = NULL;
  }

  child = child->next;
  valref = parseValref (doc, child);

  store-> effect.store.ptrrefid = sel-> id;
  store-> effect.store.valrefid = valref-> id;

  free (sel);
  free (valref);

  return (store);
}

static eff_t*
parseAlloc (xmlDocPtr doc, xmlNodePtr allocelm)
{
  const ident *id;
  const ident *type_id;
  eff_t *alloc = NEW (eff_t); /* ...! */
  alloc->kind = eff_alloc;

  CHECK_NAME (allocelm, alloc);
  VERBOSE_PRINT ((stdout, "alloc node \t0x%08x\n", (int) allocelm));
  id = new_id_from_str(getNodeId (allocelm));
  VERBOSE_PRINT ((stdout, "alloc->id = \"%s\"\n", get_id_str(id)));
  type_id = new_id_from_str(getNodeTypeId (allocelm));
  VERBOSE_PRINT ((stdout, "alloc->type_id = \"%s\"\n", get_id_str(type_id)));

  alloc-> id = id;
  alloc-> effect.alloc.tp_id = type_id;

  return (alloc);
}

static eff_t*
parseCall (xmlDocPtr doc, xmlNodePtr callelm)
{
  const ident *id;
  xmlNodePtr child;
  eff_t *sel;
  xmlNodePtr arg;
  int n_args;
  eff_t *call = NEW (eff_t);
  call->kind = eff_call;

  CHECK_NAME (callelm, call);
  VERBOSE_PRINT ((stdout, "call node \t0x%08x\n", (int) callelm));
  id = new_id_from_str(getNodeId (callelm));
  VERBOSE_PRINT ((stdout, "call->id = \"%s\"\n", get_id_str(id)));

  child = get_valid_child(callelm);
  if(NODE_NAME (child, select)) {
    sel = parseSelect (doc, child);
    call-> effect.call.ent = sel-> effect.select.ent;
  }
  else {
    sel = parseValref (doc, child);
    call-> effect.call.ent = NULL;
  }

  arg = child = child->next;
  n_args = 0;

  while (NULL != child) {
    n_args ++;
    child = child->next;
  }

  call-> id = id;
  call-> effect.call.valrefid = sel-> id;
  call-> effect.call.n_args = n_args;
  call-> effect.call.args = NULL;

  free (sel);

  if (0 != n_args) {
    const ident **args = (const ident**) xmalloc(n_args * sizeof(const ident*));
    int i = 0;

    while (NULL != arg) {
      eff_t *valref = parseValref (doc, arg);
      args [i ++] = valref-> id;
      free (valref);
      arg = arg->next;
    }

    call-> effect.call.args = args;
  }

  return (call);
}

static eff_t*
parseJoin (xmlDocPtr doc, xmlNodePtr joinelm)
{
  const ident *id;
  int n_ins;
  const ident **ins;
  int i;
  xmlNodePtr child;
  eff_t *join = NEW (eff_t);
  join->kind = eff_join;

  CHECK_NAME (joinelm, join);
  VERBOSE_PRINT ((stdout, "join node \t0x%08x\n", (int) joinelm));
  id = new_id_from_str(getNodeId (joinelm));
  VERBOSE_PRINT ((stdout, "join->id = \"%s\"\n", get_id_str(id)));

  child = get_valid_child(joinelm);
  n_ins = 0;

  while (NULL != child) {
    n_ins ++;
    child = child->next;
  }

  ins = (const ident **) xmalloc (n_ins * sizeof (const ident *) );
  i = 0;
  child = get_valid_child(joinelm);

  while (NULL != child) {
    eff_t *valref = parseValref (doc, child);
    ins [i ++] = valref-> id;
    free(valref);
    child = child->next;
  }

  join-> id = id;
  join-> effect.join.n_ins = n_ins;
  join-> effect.join.ins = ins;

  return (join);
}

static eff_t*
parseUnknown (xmlDocPtr doc, xmlNodePtr unknownelm)
{
  const ident *id;
  eff_t *unknown = NEW (eff_t);
  unknown->kind = eff_unknown;

  CHECK_NAME (unknownelm, unknown);
  VERBOSE_PRINT ((stdout, "unknown node \t0x%08x\n", (int) unknownelm));
  id = new_id_from_str(getNodeId (unknownelm));
  unknown-> id = id;

  return (unknown);
}

static eff_t*
parseReturn (xmlDocPtr doc, xmlNodePtr retelm)
{
  xmlNodePtr child;
  eff_t *ret = NEW (eff_t);
  ret->kind = eff_ret;

  CHECK_NAME (retelm, ret);
  VERBOSE_PRINT ((stdout, "ret node \t0x%08x\n", (int) retelm));

  child = get_any_valid_child(retelm);

  if (child) {
    eff_t *valref = parseValref (doc, child);
    ret-> effect.ret.ret_id = valref-> id;
    free (valref);
  } else {
    ret-> effect.ret.ret_id = NO_ID;
  }

  return (ret);
}

static eff_t*
parseRaise (xmlDocPtr doc, xmlNodePtr raiseelm)
{
  const char *tp_id;
  eff_t *valref;
  xmlNodePtr child;
  eff_t *raise = NEW (eff_t);
  raise->kind = eff_raise;

  CHECK_NAME (raiseelm, raise);
  VERBOSE_PRINT ((stdout, "raise node \t0x%08x\n", (int) raiseelm));
  tp_id = getNodeTypeId (raiseelm);
  VERBOSE_PRINT ((stdout, "raise->type = \"%s\"\n", tp_id));
  child = get_valid_child(raiseelm);

  assert (NULL != child);

  valref = parseValref (doc, child);
  raise-> effect.raise.valref = valref-> id;
  raise-> effect.raise.tp_id = new_id_from_str(tp_id);
  free (valref);

  return (raise);
}


/*
  Types and Entities
*/

/** parse a type node and insert it into the list */
static void
parseType (xmlDocPtr doc, xmlNodePtr typeelm)
{
  type_t *type;
  const char *tp_id = getNodeId (typeelm);
  VERBOSE_PRINT ((stdout, "type node \t0x%08x (%s)\n", (int) typeelm, tp_id));
  VERBOSE_PRINT ((stdout, "type = \"%s\"\n", getNodeTypeStr (typeelm)));

  type = (type_t*) xmalloc (sizeof (type_t));
  type -> type_ident = new_id_from_str(getNodeTypeStr (typeelm));
  type -> id         = new_id_from_str(tp_id);

  type->prev = types;
  types = type;
}

/** parse an entity node and insert it into the list */
static void
parseEntity (xmlDocPtr doc, xmlNodePtr entelm)
{
  entity_t *ent = NEW (entity_t);

  /* parse it */
  const char *ent_id = getNodeId (entelm);
  /* fprintf (stdout, "entity node \t0x%08x (%d)\n", (int) entelm, ent_id); */
  VERBOSE_PRINT ((stdout, "ent  = \"%s.%s\"\n",
          getNodeTypeStr (entelm),
          getNodeEntityStr (entelm)));


  ent -> ent_ident = new_id_from_str (getNodeEntityStr (entelm));
  ent -> tp_ident  = new_id_from_str (getNodeTypeStr   (entelm));
  ent -> owner     = new_id_from_str (getNodeOwnerStr  (entelm));
  ent -> id = new_id_from_str(ent_id);

  ent->prev = entities;
  entities = ent;
}

/** parse any effect, and turn it into an eff_t (TODO) */
static void
parseEffect (xmlDocPtr doc, xmlNodePtr effelm)
{
  xmlNodePtr cur;
  const char *procname = getNodeProcName (effelm);
  const char *ownerid = getNodeOwnerStr (effelm);
  proc_t *curr_effs = NULL;
  int i = 0;
  int n_effs = 0;

  VERBOSE_PRINT ((stdout, "effect for method \"%s\"\n", procname));

  cur = effelm -> xmlChildrenNode;
  while (NULL != cur) {
    n_effs ++;
    cur = cur->next;
  }
  VERBOSE_PRINT ((stdout, "has %d effects\n", n_effs));

  curr_effs = NEW (proc_t);
  curr_effs -> proc_ident = new_id_from_str(procname);
  curr_effs -> ownerid = new_id_from_str(ownerid);
  curr_effs->effs = (eff_t**) xmalloc (n_effs * sizeof (eff_t*));

  cur = effelm -> xmlChildrenNode;
  while (NULL != cur) {
    eff_t *eff = NULL;

    if (NODE_NAME (cur, arg)) {
      eff = (eff_t*) parseArg (doc, cur);
    } else if (NODE_NAME (cur, load)) {
      eff = (eff_t*) parseLoad (doc, cur);
    } else if (NODE_NAME (cur, store)) {
      eff = (eff_t*) parseStore (doc, cur);
    } else if (NODE_NAME (cur, alloc)) {
      eff = (eff_t*) parseAlloc (doc, cur);
    } else if (NODE_NAME (cur, call)) {
      eff = (eff_t*) parseCall (doc, cur);
    } else if (NODE_NAME (cur, join)) {
      eff = (eff_t*) parseJoin (doc, cur);
    } else if (NODE_NAME (cur, unknown)) {
      eff = (eff_t*) parseUnknown (doc, cur);
    } else if (NODE_NAME (cur, ret)) {
      eff = (eff_t*) parseReturn (doc, cur);
    } else if (NODE_NAME (cur, raise)) {
      eff = (eff_t*) parseRaise (doc, cur);
    } else if (NODE_NAME (cur, comment)) {
      /* comment */
      --n_effs;
    } else {
      fprintf (stderr, "wrong element \"%s\"\n", BAD_CAST cur->name);
      exit (EXIT_FAILURE);
    }
    if(eff) {
      VERBOSE_PRINT ((stdout, "effect %p@%d\n", (void*)eff, i));
      curr_effs -> effs[i++] = eff;
    }
    cur = cur -> next;
  }
  assert((i == n_effs) && "incorrect number of effects");
  curr_effs -> n_effs = n_effs;
  curr_effs -> next = procs;
  procs = curr_effs;
}


static
void read_extern (const char *filename)
{
  /* xmlNsPtr ns = NULL; */           /* no namespace for us */
  xmlDocPtr doc;                /* whole document */
  xmlNodePtr cur;               /* current node */
  ident *mod_id;
  module_t *module;

  /* i've got no idea what the VERSION cast is all about. voodoo
     programming at its finest. */
  LIBXML_TEST_VERSION xmlKeepBlanksDefault (0);
  VERBOSE_PRINT((stdout, "read file %s\n", filename));
  doc = xmlParseFile (filename);
  CHECK (doc, "xmlParseFile");

  cur = xmlDocGetRootElement (doc);
  CHECK (cur, "xmlDocGetRootElement");

  if (! NODE_NAME (cur, effects)) {
    fprintf (stderr,"root node \"%s\" != \"effects\"\n", BAD_CAST cur->name);
    xmlFreeDoc (doc);
    exit (EXIT_FAILURE);
  }

  mod_id = getNodeModuleIdent (cur);
  if (NULL != mod_id) {
    VERBOSE_PRINT ((stdout, "effects for \"%s\"\n",
            get_id_str(mod_id)));
  }
  else {
    VERBOSE_PRINT ((stdout, "effects \t0x%08x\n", (int) cur));
  }

  /* parse entities */
  cur = cur->xmlChildrenNode;
  while (cur != NULL) {
    if (NODE_NAME (cur, type)) {
      parseType (doc, cur);
    } else if (NODE_NAME (cur, entity)) {
      parseEntity (doc, cur);
    } else if (NODE_NAME (cur, effect)) {
      parseEffect (doc, cur);
    } else if ((NODE_NAME (cur, comment))) {
      /* comment */
    } else {
      fprintf (stderr, "wrong element \"%s\"\n", BAD_CAST cur->name);
      exit (EXIT_FAILURE);
    }
    cur = cur->next;
  }

  module = NEW(module_t);
  module -> id = mod_id;
  module -> types = types;
  module -> entities = entities;
  module -> procs = procs;

  types = NULL;
  entities = NULL;
  procs = NULL;

  module -> next = modules;
  modules = module;
}

/********************************************************************/

/*
 * free additional structure
 */
static
void freeArg (eff_t *arg)
{
  VERBOSE_PRINT ((stdout, "free arg node \t0x%08x\n", (int) arg));
  free(arg);
  return;
}

static
void freeValref (eff_t *valref)
{
  VERBOSE_PRINT ((stdout, "free valref node \t0x%08x\n", (int) valref));
  free(valref);
  return;
}

static
void freeSelect (eff_t *sel)
{
  VERBOSE_PRINT ((stdout, "free select node \t0x%08x\n", (int) sel));
  free(sel);
  return;
}

static
void freeLoad (eff_t *load)
{
  VERBOSE_PRINT ((stdout, "free load node \t0x%08x\n", (int) load));
  free (load);
  return;
}

static
void freeStore (eff_t *store)
{
  VERBOSE_PRINT ((stdout, "free store node \t0x%08x\n", (int) store));
  free (store);
  return;
}

static
void freeAlloc (eff_t *alloc)
{
  VERBOSE_PRINT ((stdout, "free alloc node \t0x%08x\n", (int) alloc));
  free(alloc);
  return;
}

static
void freeCall (eff_t *call)
{
  VERBOSE_PRINT ((stdout, "free call node \t0x%08x\n", (int) call));
  free(call -> effect.call.args);
  free(call);
  return;
}

static
void freeJoin (eff_t *join)
{
  VERBOSE_PRINT ((stdout, "free join node \t0x%08x\n", (int) join));
  free(join -> effect.join.ins);
  free(join);
  return;
}

static
void freeUnknown (eff_t *unknown)
{
  VERBOSE_PRINT ((stdout, "free unknown node \t0x%08x\n", (int) unknown));
  free(unknown);
  return;
}

static
void freeReturn (eff_t *ret)
{
  VERBOSE_PRINT ((stdout, "free ret node \t0x%08x\n", (int) ret));
  free(ret);
  return;
}

static
void freeRaise (eff_t *raise)
{
  VERBOSE_PRINT ((stdout, "free raise node \t0x%08x\n", (int) raise));
  free (raise);
  return;
}


static
void freeProcEffs(proc_t *proc)
{
  int i;
  int num;

  VERBOSE_PRINT ((stdout, "free effect for method \"%s\"\n",
          get_id_str(proc -> proc_ident)));

  num = proc -> n_effs;
  for(i = 0; i < num; i++) {
    switch(proc -> effs[i] -> kind) {
    case eff_arg:
      freeArg(proc -> effs[i]);
      break;
    case eff_valref:
      freeValref(proc -> effs[i]);
      break;
    case eff_select:
      freeSelect(proc -> effs[i]);
      break;
    case eff_load:
      freeLoad(proc -> effs[i]);
      break;
    case eff_store:
      freeStore(proc -> effs[i]);
      break;
    case eff_alloc:
      freeAlloc(proc -> effs[i]);
      break;
    case eff_call:
      freeCall(proc -> effs[i]);
      break;
    case eff_unknown:
      freeUnknown(proc -> effs[i]);
      break;
    case eff_join:
      freeJoin(proc -> effs[i]);
      break;
    case eff_raise:
      freeRaise(proc -> effs[i]);
      break;
    case eff_ret:
      freeReturn(proc -> effs[i]);
      break;
    default:
      assert(0 && "try to free an unknown effect");
      break;
    }
  }
  free(proc -> effs);
  proc -> effs = NULL;
}

static
void freeModuleProcs(module_t *module)
{
  proc_t *next_proc, *proc;

  VERBOSE_PRINT ((stdout, "free procs for module \"%s\"\n",
          get_id_str(module -> id)));

  proc = module -> procs;
  while(proc) {
    next_proc = proc -> next;
    freeProcEffs(proc);
    free(proc);
    proc = next_proc;
  }
}

static
void free_data(void)
{
  module_t *module, *next_module;

  module = modules;
  while(module) {
    freeModuleProcs(module);
    next_module = module -> next;
    free(module);
    module = next_module;
  }
}

/********************************************************************/

static
type_t *find_type_in_module(module_t *module, const ident *typeid)
{
  type_t *type;

  for(type = module -> types; type; type = type -> prev) {
    VERBOSE_PRINT((stdout, "test typeid %s\n", get_id_str(type -> id)));
    if(type -> id == typeid) {
      VERBOSE_PRINT((stdout, "found\n"));
      return(type);
    }
  }
  VERBOSE_PRINT((stdout, "did not find type id %s\n", get_id_str(typeid)));
  return(NULL);
}

/********************************************************************/

static void add_value_to_proc(proc_t *proc, eff_t *eff)
{