Logo Search packages:      
Sourcecode: hat version File versions

artutils.c

#include <unistd.h>
#include <stdio.h>
#include <string.h>
#include <errno.h>
#include <sys/stat.h>
#include <signal.h>
#include "art.h"
#include "artutils.h"
#include "pathutils.h"

#define DEBUG 0

#if DEBUG
#define HIDE(x)   x
#else
#define HIDE(x)
#endif

#define MAX_STRING 0xff
#define MAX_BIG_STRING 0xffff

/* We open the .hat file *twice* with different handles, for efficiency.
 *
 * For random access, use the global HatFileRandom handle.  Most operations
 * assume this mode of access.
 *
 * For sequential access, use the global HatFileSeq handle: the
 * operation variants prefixed with q_ keep a global record (q_position)
 * of the current file position, which is much cheaper than doing ftell().
 */
FileOffset errorRoot, errorMsg, remoteStartNode=0;
FileOffset q_position;
FILE  *HatFileRandom, *HatFileSeq, *OutputFile, *BridgeFile;
unsigned filesize=0, outputsize=0;
char  *progname;        /* name of browser, not of the subject */
char  *dir;
bool  interrupt=False;  /* ^C interrupt at program runtime */
bool  hat_interrupted=False;  /* ^C interrupt in browsing tool */

/* The initialise() routine ensures that all files are available,
 * and opens them ready for further action.  It also fills in the
 * errorRoot and errorMsg globals.
 */
void
initialise (int argc, char **argv)
{
  int err;
  char header[8];
  char *arg;

  if ((argc==4)&&(strcmp(argv[2],"-remote")==0)) {
    remoteStartNode = atoi(argv[3]);
  } else if (argc!=2) {
    fprintf(stderr,"  [%s]\n",argv[0]);
    fprintf(stderr,"\tUsage: %s program[.hat]\n",basename(argv[0],0));
    exit(1);
  }
  arg=argv[1];

  dir = dirname(arg);
  arg = basename(arg,".hat");
  chdir(dir);
  progname   = basename(argv[0],0);
                  /* for error messages - /not/ the prog being debugged */
  filesize   = sizeFile(arg,".hat");
  outputsize = sizeFile(arg,".hat.output");
  HatFileRandom = openFile(arg,".hat");         /* one file for random access */
  OutputFile = openFile(arg,".hat.output");
  BridgeFile = openFile(arg,".hat.bridge");
  HatFileSeq = openFile(arg,".hat");            /* another for sequential */
  q_position = 0;

  err = fread(header,sizeof(char),8,HatFileRandom);
  if (err!=8) {
    fprintf(stderr,"%s (error): file %s/%s is too short\n",progname,dir,arg);
    exit(1);
  }
  if (strncmp(header,"Hat",3)) {
    fprintf(stderr,"%s (error): file %s in directory %s\n",progname,arg,dir);
    fprintf(stderr,"   does not appear to be a Hat archive.  Quitting.\n");
    exit(1);
  }
  if (strncmp(header+3,VERSION,4)) {
    fprintf(stderr,"%s (warning): file %s in directory %s\n",progname,arg,dir);
    fprintf(stderr,"   appears to be a Hat archive in format %s\n",header+3);
    fprintf(stderr,"   but this tool deals with format version %s\n",VERSION);
    fprintf(stderr,"   I'm continuing, but there may be unexpected errors.\n");
  }
  errorRoot = readFO();
  errorMsg  = readFO();
  if (errorMsg==Entered) interrupt=True;
}

void
finalise (void)
{
  fclose(HatFileRandom);
  fclose(HatFileSeq);
  fclose(OutputFile);
  fclose(BridgeFile);
}



/* Open a file for reading, given:
 *    the base name of the file
 *    the file extension
 */
FILE*
openFile (char* base, char* ext)
{
  char filename[MAX_STRING];
  FILE* file;
  strcpy(filename,base);
  strcat(filename,ext);
  if (file = fopen(filename,"r")) {
    return file;
  } else {
    fprintf(stderr,"%s: cannot open %s/%s\n",progname,dir,filename);
    exit(1);
  }
}

/* Determine the size of a file, given:
 *    the base name of the file
 *    the file extension
 */
int
sizeFile (char* base, char* ext)
{
  char filename[MAX_STRING];
  struct stat buf;
  strcpy(filename,base);
  strcat(filename,ext);
  stat(filename,&buf);
  return buf.st_size;
}


/* freadAt() is just like fread(), except it seeks to a specific
 * file location first.  (Random Access)
 */
int
freadAt (FileOffset fo, void* ptr, int size, int nmemb, FILE* stream)
{
  int err;
  if (fo < 0x10) {
    fprintf(stderr,"%s: attempt to read inside .hat header\n",progname);
    fprintf(stderr,"%s: offset = 0x%x\n",progname,fo);
    exit(1);
  } else if (fo > filesize) {
    fprintf(stderr,"%s: attempt to read beyond end of file\n",progname);
    fprintf(stderr,"%s: offset = 0x%x, filesize = 0x%x\n",progname,fo,filesize);
    fprintf(stderr,"%s: errno = %d (%s)\n",progname,errno,strerror(errno));
    exit(1);
  }
  if (fseek(stream, fo, SEEK_SET)) {
    fprintf(stderr,"%s: seek error on file\n",progname);
    fprintf(stderr,"%s: errno = %d (%s)\n",progname,errno,strerror(errno));
    exit(1);
  }
  err = fread(ptr,size,nmemb,stream);
  return err;
}

/* q_fread() is just like fread() except it advances the global counter
 * recording the file position.  (Sequential Access)
 */
int
q_fread(void* buf, int siz, int num, FILE* file)
{
  int err;
  err = fread(buf,siz,num,file);
  q_position += err*siz;
//if (err<num) {
//  fprintf(stderr,"q_fread: warning, only read %d of %d values (size %d)\n"
//                ,err,num,siz);
//}
  return err;
}



/* readFO() reads a single FileOffset from the file and ensures it is
 * in host-endian order.  (Random Access)
 */
FileOffset
readFO (void)
{
  FileOffset fo;
  fread(&fo,sizeof(FileOffset),1,HatFileRandom);
  HIDE(fprintf(stderr,"readFO -> 0x%x\n",ntohl(fo));)
  return ntohl(fo);
}
/* (Sequential Access) */
FileOffset
q_readFO (void)
{
  FileOffset fo;
  q_fread(&fo,sizeof(FileOffset),1,HatFileSeq);
  HIDE(fprintf(stderr,"q_readFO -> 0x%x\n",ntohl(fo));)
  return ntohl(fo);
}



/* readString() reads a length-annotated string from the current position
 * in the file.  (Random Access)
 */
char*
readString (void)
{
  char *buf;
  int i, n;

  n = (int)fgetc(HatFileRandom);
  if (n==MAX_STRING) {
    n = (int)fgetc(HatFileRandom);
    n = (n<<8) + (int)fgetc(HatFileRandom);
  }
  buf = (char*)malloc((n+1)*sizeof(char));
  i = fread(buf,sizeof(char),n,HatFileRandom);
  buf[n] = '\0';
  if (i<n) {
    fprintf(stderr,"%s: warning, only read %d characters of %d in string"
                  ,progname,i,n);
  }
  HIDE(fprintf(stderr,"readString -> %s\n",buf);)
  return buf;
}
/* (Sequential Access) */
char*
q_readString (void)
{
  char *buf;
  int i, n;

  n = (int)fgetc(HatFileSeq);
  q_position += 1;
  if (n==MAX_STRING) {
    n = (int)fgetc(HatFileSeq);
    n = (n<<8) + (int)fgetc(HatFileSeq);
    q_position += 2;
  }
  buf = (char*)malloc((n+1)*sizeof(char));
  i = q_fread(buf,sizeof(char),n,HatFileSeq);
  buf[n] = '\0';
  if (i<n) {
    fprintf(stderr,"%s: warning, only read %d characters of %d in string"
                  ,progname,i,n);
  }
  HIDE(fprintf(stderr,"q_readString -> %s\n",buf);)
  return buf;
}


/* q_peek() takes a sneaky look at the next byte of the file, to
 * determine whether we want to go ahead and read it now.
 */
char
q_peek (void)
{
  char c;
  c = (char)fgetc(HatFileSeq);
  ungetc(c,HatFileSeq);
  return c;
}




/* readModuleAt() fills in the name of the module and its source file,
 * given the location of the module descriptor in the file.
 */
void
readModuleAt (FileOffset fo, char** modname, char** srcname, bool* traced)
{
  char c;

  HIDE(fprintf(stderr,"readModuleAt 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  if (lower5(c)!=Module) {
    fprintf(stderr,"%s: expected a Module descriptor at position 0x%x\n"
                  ,progname,fo);
    exit(1);
  }
  *traced  = tracedModule(c);
  *modname = readString();
  *srcname = readString();
  HIDE(fprintf(stderr,"readModuleAt 0x%x -> %s %s\n",fo,*modname,*srcname);)
}


/* readAtomAt() fills in the name of the variable or constructor,
 * as well as its module, source file, fixity, and definition position,
 * given the location of the Atom descriptor in the file.
 */
Ident*
readAtomAt (FileOffset fo)
{
  char c;
  FileOffset modpos;
  Ident* id=0;
  int defnpos;

  if (fo==Lambda) {
    id = (Ident*)malloc(sizeof(Ident));
    id->idname   = "(\\..)";
    id->modname  = id->srcname = "";
    id->fixity   = noFixity;
    id->defnline = id->defncolumn = 0;
    id->isTraced = False;
    id->atomtype = Abstract;
  } else {
    HIDE(fprintf(stderr,"readAtomAt 0x%x\n",fo);)
    freadAt(fo,&c,sizeof(char),1,HatFileRandom);
    switch (lower5(c)) {
      case AtomVariable:
      case AtomConstructor:
          id = (Ident*)malloc(sizeof(Ident));
          modpos = readFO();
          fread(&defnpos,sizeof(int),1,HatFileRandom);
          fread(&(id->fixity),sizeof(char),1,HatFileRandom);
          fread(&(id->arity),sizeof(char),1,HatFileRandom);
          id->idname       = readString();
          id->defnline     = ntohl(defnpos)/10000;
          id->defncolumn   = ntohl(defnpos)%10000;
          if (lower5(c)==AtomVariable) {
              id->atomtype = Variable;
          } else if (hasFields(c)) {
              id->atomtype = ConstrFields;
          } else {
              id->atomtype = Constructor;
          }
          readModuleAt(modpos,&(id->modname),&(id->srcname),&(id->isTraced));
          break;
      case AtomAbstract: {
          char *tmp;
          id = (Ident*)malloc(sizeof(Ident));
          id->idname   = readString();
          id->modname  = id->srcname = "";
          id->fixity   = noFixity;
          id->defnline = id->defncolumn = 0;
          id->isTraced = False;
          id->atomtype = Abstract;
          tmp = (char*)malloc(strlen(id->idname)+3);
          strcpy(tmp,"{"); strcat(tmp,id->idname); strcat(tmp,"}");
          free(id->idname); id->idname=tmp;
          } break;
      default:
          fprintf(stderr,"%s: expected an Atom descriptor at position 0x%x\n"
                        ,progname,fo);
          exit(1);
          break;
    }
  }
  HIDE(fprintf(stderr,"readAtomAt 0x%x -> %s %s %s %d %d %d\n",fo,id->idname,id->modname,id->srcname,id->defnline,id->defncolumn,id->fixity);)
  return id;
}



/* readSRAt() fills in a struct containing the filename and usage
 * position of a source reference, given the location of the
 * SrcPos descriptor in the file.
 */
SrcRef *
readSRAt (FileOffset fo)
{
  FileOffset modpos;
  char *modname, *srcname;
  int usepos;
  char c;
  bool dummy;
  SrcRef *sr;

  HIDE(fprintf(stderr,"readSRAt 0x%x\n",fo);)
  if (fo) {
    freadAt(fo,&c,sizeof(char),1,HatFileRandom);
    if (lower5(c)!=SrcPos) {
      fprintf(stderr,"%s: expected a SrcPos descriptor at position 0x%x\n"
                    ,progname,fo);
      fprintf(stderr,"%s: got a 0x%x\n",progname,c);
      exit(1);
    }
    sr = (SrcRef*)malloc(sizeof(SrcRef));
    modpos = readFO();
    fread(&usepos,sizeof(int),1,HatFileRandom);
    usepos = ntohl(usepos);
    readModuleAt(modpos, &modname, &(sr->srcname), &dummy);
    sr->line    = usepos/10000;
    sr->column  = usepos%10000;
    return sr;
  } else {
    return (SrcRef*)0;
  }
}


/* readValueAt() returns a struct containing a readable notation of the
 * value-Exp stored at the given location in the file.
 */
Ident*
readValueAt (FileOffset fo)
{
  char c, buf[MAX_STRING];  
  Ident *id = (Ident*)malloc(sizeof(Ident));
  FileOffset parent, usepos = 0;

  /* defaults */
  id->idname   = (char*)0;
  id->modname  = (char*)0;
  id->srcname  = (char*)0;
  id->fixity   = noFixity;
  id->arity    = 0;
  id->defnline   = 0;
  id->defncolumn = 0;
  id->isTraced   = False;
  id->atomtype   = Literal;

  HIDE(fprintf(stderr,"readValueAt 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  if ((lower5(c)<ExpChar) || (lower5(c)>ExpConstDef)) {
    fprintf(stderr,"%s: expected a value Exp descriptor at position 0x%x\n"
                  ,progname,fo);
    exit(1);
  }
  HIDE(fprintf(stderr,"readValueAt 0x%x -> tag 0x%x\n",fo,c);)
  if (hasSrcPos(c)) { usepos = readFO(); }
  parent = readFO();
  switch (lower5(c)) {
    case ExpChar:
            { fread(&c,sizeof(char),1,HatFileRandom);
              if ((c>31) && (c!='\''))
                sprintf(buf,"'%c'",c);
              else switch(c) {
                case '\n': sprintf(buf,"'\\n'"); break;
                case '\t': sprintf(buf,"'\\t'"); break;
                case '\255' : sprintf(buf,"'\\e'"); break;
                default  : sprintf(buf,"'\\0%X'",c); break;
              }
              id->idname = strdup(buf);
            } break;
    case ExpInt:
            { int i;
              fread(&i,sizeof(int),1,HatFileRandom);
              sprintf(buf,"%d",ntohl(i));
              id->idname = strdup(buf);
            } break;
    case ExpInteger:
            { id->idname = readString();
            } break;
    case ExpRat:
            { int i,j;
              fread(&i,sizeof(int),1,HatFileRandom);
              fread(&j,sizeof(int),1,HatFileRandom);
              sprintf(buf,"%d%%%d",ntohl(i),ntohl(j));
              id->idname = strdup(buf);
            } break;
    case ExpRational:
            { sprintf(buf,"%s%%%s",readString(), readString());
              id->idname = strdup(buf);
            } break;
    case ExpFloat:
            { float f;
              fread(&f,sizeof(float),1,HatFileRandom);
              sprintf(buf,"%.6f",f);
              id->idname = strdup(buf);
            } break;
    case ExpDouble:
            { double d;
              fread(&d,sizeof(double),1,HatFileRandom);
              sprintf(buf,"%.15f",d);
              id->idname = strdup(buf);
            } break;
    case ExpValueApp:
    case ExpValueUse:
            { FileOffset atom;
                  free(id);
                  atom = readFO();
              id = readAtomAt(atom);
            } break;
    case ExpConstUse:
            { FileOffset def;
                  free(id);
                  def = readFO();
              id = readValueAt(def);
            } break;
    case ExpConstDef:
            { FileOffset atom;
                  free(id);
                  readFO();   /* skip result (? should we follow it ?) */
                  atom = readFO();
              id = readAtomAt(atom);
            } break;
    default: break;
  }
  HIDE(fprintf(stderr,"readValueAt 0x%x -> %s %s %s %d %d %d\n",fo,id->idname,id->modname,id->srcname,id->defnline,id->defncolumn,id->fixity);)
  if (!id->idname) id->idname = strdup("Problem");
  return id;
}

/* Skip a complete node in the file, given that the tag byte has already
 * been read. (Sequential Access)
 */
void
q_skipNode (char tag)
{
  switch (lower5(tag)) {
    case Module:
        q_readString(); q_readString();
        break;
    case SrcPos:
        q_readFO();
        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }
        break;
    case ExpApp:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO(); q_readFO(); q_readFO();
        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);
          while (arity--) { q_readFO(); } }
        break;
    case ExpValueApp:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO(); q_readFO();
        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);
          while (arity--) { q_readFO(); } }
        break;
    case ExpChar:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }
        break;
    case ExpInt:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }
        break;
    case ExpInteger:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        q_readString();
        break;
    case ExpRat:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        { int x[2]; q_fread(&x[0],sizeof(int),2,HatFileSeq); }
        break;
    case ExpRational:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        q_readString(); q_readString();
        break;
    case ExpFloat:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        { float x; q_fread(&x,sizeof(float),1,HatFileSeq); }
        break;
    case ExpDouble:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        { double x; q_fread(&x,sizeof(double),1,HatFileSeq); }
        break;
    case ExpValueUse:
    case ExpConstUse:
    case ExpProjection:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO(); q_readFO();
        break;
    case ExpConstDef:
        q_readFO(); q_readFO(); q_readFO();
        break;
    case ExpGuard:
    case ExpCase:
    case ExpIf:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO(); q_readFO(); q_readFO();
        break;
    case ExpFieldUpdate:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO(); q_readFO(); q_readFO();
        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);
          arity = 2*arity;
          while (arity--) { q_readFO(); } }
        break;
    case ExpHidden:
        q_readFO(); q_readFO();
        break;
    case ExpForward:
        q_readFO();
        break;
    case ExpDoStmt:
        if (hasSrcPos(tag)) q_readFO();
        q_readFO();
        break;
    case AtomVariable:
        q_readFO();
        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }
        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }
        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }
        q_readString();
        break;
    case AtomConstructor:
        q_readFO();
        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }
        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }
        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);
          q_readString();
          if (hasFields(tag)) while (arity--) q_readFO(); }
        break;
    case AtomAbstract:
        q_readString();
        break;
    default: break;
  }
}


/* readTraceAt() fills in a string containing a readable notation of the
 * Trace stored at the given location in the file.  It returns the
 * parent trace.  This routine is only currently used by the "virtual
 * stack trace" program.
 */
FileOffset
readTraceAt (FileOffset fo, char** expr, SrcRef** sr, int* infix
            ,int followHidden, int depth)
{
  char c, buf[10000];  /* fixed size no final solution */
  FileOffset parent;

  *infix = (int)noFixity;     /* default */

  if (depth <= 0) {
    *expr = strdup(" ");
    return fo;
  }

  if (fo<=Lambda) {
    switch (fo) {
      case Root:        sprintf(buf,"<Root>"); break;
      case Unevaluated: sprintf(buf,"_"); break;
      case Entered:     sprintf(buf,"_|_"); break;
      case Interrupted: sprintf(buf,"{^C}"); break;
      case Lambda:      sprintf(buf,"(\\..)"); break;
    }
    *expr = strdup(buf);
    *infix = noFixity;
    *sr = 0;
    return fo;
  } else {
    HIDE(fprintf(stderr,"readTraceAt 0x%x\n",fo);)
    freadAt(fo,&c,sizeof(char),1,HatFileRandom);
    if ((lower5(c)<ExpApp) || (lower5(c)>ExpDoStmt)) {
      fprintf(stderr,"%s: expected Exp descriptor at position 0x%x (got 0x%x)\n"
                    ,progname,fo,c);
      exit(1);
    }
    HIDE(fprintf(stderr,"readTraceAt 0x%x -> tag 0x%x\n",fo,c);)
    switch (lower5(c)) {
      case ExpApp:
      { unsigned char i, arity;
        FileOffset foExprs[20], foSR=0;
        char* exprs[20];
        int  fixexp[20];
          if (hasSrcPos(c)) { foSR = readFO(); }
          parent = readFO();              /* get parent */
          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)
          readFO();                       /* skip result */
        foExprs[0] = readFO();            /* get fun */
        fread(&arity,sizeof(unsigned char),1,HatFileRandom);
        for (i=1; i<=arity; i++) {
          foExprs[i] = readFO();
          }
        for (i=0; i<=arity; i++) {
          (void)readTraceAt(getResult(foExprs[i],True)
                             ,&(exprs[i]),sr,&(fixexp[i]),False,depth-1);
          }
        *infix = fixexp[0];
        if (isInfix(fixexp[0]) && c >= 2) {
          sprintf(buf,"%s",infixPrint(exprs[1],fixexp[1],exprs[0],fixexp[0]
                      ,exprs[2],fixexp[2]));
          for (i=3; i<=arity; i++) {
            strcat(buf," ");
            strcat(buf,exprs[i]);
            }
        } else {  /* no fixity */
          sprintf(buf,"(%s",exprs[0]);
          for (i=1; i<=arity; i++) {
            strcat(buf," ");
            if (isInfix(fixexp[i])) {
              strcat(buf,"(");
              strcat(buf,exprs[i]);
              strcat(buf,")");
            } else
              strcat(buf,exprs[i]);
            }
          strcat(buf,")");
        }
        *expr = strdup(buf);
          *sr   = readSRAt(foSR);
          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)
        return parent;
      } break;
      case ExpValueApp:
      { unsigned char i, arity; Ident* id;
        FileOffset foExprs[20], foSR=0;
        char* exprs[20];
        int  fixexp[20];
          if (hasSrcPos(c)) { foSR = readFO(); }
          parent = readFO();              /* get parent */
          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)
        foExprs[0] = readFO();            /* get fun */
        fread(&arity,sizeof(unsigned char),1,HatFileRandom);
        for (i=1; i<=arity; i++) {
          foExprs[i] = readFO();
          }
          id = readAtomAt(foExprs[0]);
        for (i=1; i<=arity; i++) {
          (void)readTraceAt(getResult(foExprs[i],True)
                             ,&(exprs[i]),sr,&(fixexp[i]),False,depth-1);
          }
        *infix = id->fixity;
        if (isInfix(id->fixity) && c >= 2) {
          sprintf(buf,"%s",infixPrint(exprs[1],fixexp[1],id->idname,id->fixity
                      ,exprs[2],fixexp[2]));
          for (i=3; i<=arity; i++) {
            strcat(buf," ");
            strcat(buf,exprs[i]);
            }
        } else {  /* no fixity */
          sprintf(buf,"(%s",id->idname);
          for (i=1; i<=arity; i++) {
            strcat(buf," ");
            if (isInfix(fixexp[i])) {
              strcat(buf,"(");
              strcat(buf,exprs[i]);
              strcat(buf,")");
            } else
              strcat(buf,exprs[i]);
            }
          strcat(buf,")");
        }
        *expr = strdup(buf);
          *sr   = readSRAt(foSR);
          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)
        return parent;
      } break;
      case ExpChar:
      case ExpInt:
      case ExpInteger:
      case ExpRat:
      case ExpRational:
      case ExpFloat:
      case ExpDouble:
      case ExpValueUse:
      case ExpConstUse:
      case ExpConstDef:
        { FileOffset foSR=0;
          Ident *id;
          if (hasSrcPos(c)) { foSR = readFO(); }
        parent = readFO();
        id   = readValueAt(fo);
        *infix = id->fixity;
        sprintf(buf,"%s",id->idname);
        *expr = strdup(buf);
          *sr   = readSRAt(foSR);
        return parent;
      } break;
      case ExpGuard:
      case ExpCase:
      case ExpIf:
        { FileOffset foCond, foSR;
        char* cond;
        int fixcond;
          if (hasSrcPos(c)) { foSR = readFO(); }
          parent = readFO();              /* get parent */
          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)
          readFO();                       /* skip result */
        foCond = readFO();                /* get condition */
        readTraceAt(foCond,&cond,sr,&fixcond,False,depth-1);
          switch (lower5(c)) {
          case ExpGuard: sprintf(buf,"| "); break;
          case ExpCase:  sprintf(buf,"case "); break;
          case ExpIf:    sprintf(buf,"if "); break;
            default: break;
          }
        if (isInfix(fixcond)) {
          strcat(buf,"(");
          strcat(buf,cond);
          strcat(buf,")");
        } else
          strcat(buf,cond);
        *expr = strdup(buf);
          *sr   = readSRAt(foSR);
          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)
        } break;
      case ExpFieldUpdate:
        {
      } break;
      case ExpProjection:
        { if (hasSrcPos(c)) { readFO(); }
          parent = readFO();  /* throw projective parent away */
          parent = readFO();  /* choose original expression */
        return readTraceAt(parent, expr, sr, infix, followHidden, depth);
      } break;
      case ExpHidden:
        { FileOffset result;
          parent = readFO();
          result = readFO();
        if (!followHidden) {
          sprintf(buf,"{?}");
          *expr = strdup(buf);
          return parent; 
          } else {
            return readTraceAt(result, expr, sr, infix, followHidden, depth);
          }
      } break;
      case ExpForward:
      { FileOffset result;
        result = readFO();
        return readTraceAt(result, expr, sr, infix, followHidden, depth);
      } break;
      case ExpDoStmt:
        { FileOffset foStmt, foSR;
        char* stmt;
        int fixstmt;
          if (hasSrcPos(c)) { foSR = readFO(); }
          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)
          foStmt = readFO();
        parent = readTraceAt(foStmt,&stmt,sr,&fixstmt,False,depth-1);
          sprintf(buf,"do "); break;
        if (isInfix(fixstmt)) {
          strcat(buf,"(");
          strcat(buf,stmt);
          strcat(buf,")");
        } else
          strcat(buf,stmt);
        *expr = strdup(buf);
          *sr   = readSRAt(foSR);
          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)
      } break;
      default: break;
    }
    return parent;
  }
}


/* print an infix expression correctly according to the given priorities. */
char*
infixPrint (char* str1, int arg1, char* strfn, int fn, char* str2, int arg2)
{
  char buf[10000]; /* fixed size no final solution */

  if (!isInfix(arg1))
      sprintf(buf,"%s",str1);
  else if (priority(arg1) > priority(fn))
      sprintf(buf,"%s",str1);
  else if (priority(arg1) < priority(fn))
      sprintf(buf,"(%s)",str1);
  else if (isInfixN(fn))
      sprintf(buf,"(%s)",str1);
  else
      sprintf(buf,"%s",str1);

  strcat(buf,strfn);

  if (!isInfix(arg2)) {
      strcat(buf,str2);
  } else if (priority(arg2) > priority(fn)) {
      strcat(buf,str2);
  } else if (priority(arg2) < priority(fn)) {
      strcat(buf,"(");
      strcat(buf,str2);
      strcat(buf,")");
  } else if (isInfixN(fn)) {
      strcat(buf,"(");
      strcat(buf,str2);
      strcat(buf,")");
  } else {
      strcat(buf,str2);
  }

  return strdup(buf);
}



/* The next bunch of utility functions are for hat-trail.
 * ------------------------------------------------------
 *
 *
 */


/* Open the .hat file */
void
openHatFile (char* prog, char* arg)
{
  int err;
  char header[8];
  progname = basename(prog,0);

  HatFileRandom  = openFile(arg, "");
  HatFileSeq  = openFile(arg, "");
  BridgeFile = openFile(arg,".bridge");
  filesize = sizeFile(arg, "");
  q_position = 0;

  err = fread(header,sizeof(char),8,HatFileRandom);
  if (err!=8) {
    fprintf(stderr,"%s (error): file %s is too short\n",progname,arg);
    exit(1);
  }
  if (strncmp(header,"Hat",3)) {
    fprintf(stderr,"%s (error): file %s\n",progname,arg);
    fprintf(stderr,"   does not appear to be a Hat archive.  Quitting.\n");
    exit(1);
  }
  if (strncmp(header+3,VERSION,4)) {
    fprintf(stderr,"%s (warning): file %s\n",progname,arg);
    fprintf(stderr,"   appears to be a Hat archive in format %s\n",header+3);
    fprintf(stderr,"   but this tool deals with format version %s\n",VERSION);
    fprintf(stderr,"   I'm continuing, but there may be unexpected errors.\n");
  }
  errorRoot = readFO();
  errorMsg  = readFO();
  if (errorMsg==Entered) interrupt=True;
  signal(SIGINT,SIG_IGN);
}

/* Return the contents of the bridge file, one item at a time.  */
FileOffset
getBridgeValue (void)
{
  int err;
  FileOffset fo;
  err = fread(&fo,sizeof(FileOffset),1,BridgeFile);
  if (err==0) {
     fclose(BridgeFile);
     return 0;
  } else return ntohl(fo);
}

/* Get the trace reference for an error, and the string associated with it. */
FileOffset
getErrorLoc (void)
{
  FileOffset fo;
  fseek(HatFileRandom,8,SEEK_SET);
  fo = readFO();
  return fo;
}
char *
errorMessage (void)
{
  FileOffset fo;
  char c='\0';
  fseek(HatFileRandom,12,SEEK_SET);
  fo = readFO();
  if (fo==Entered) return "Interrupted (^C)";
  if (fo) {
    HIDE(fprintf(stderr,"errorMessage 0x%x\n",fo);)
    freadAt(fo,&c,sizeof(char),1,HatFileRandom);
    if (lower5(c)==AtomAbstract) return readString();
  }
  return "";
}
char*
versionNumber (void)
{
  return strdup(VERSION);
}


/* Read the tag bits and report the NodeType. */
int
getNodeType (FileOffset fo)
{
  char c;
  if (fo<=Lambda) return -1;
  HIDE(fprintf(stderr,"getNodeType 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  return (int)(lower5(c));    /* lower 5 bits are the identifying tag */
}

/* For any node type, get its parent.  If it doesn't have one, we give 0.  */
FileOffset
parentNode (FileOffset fo)
{
  char c;
  HIDE(fprintf(stderr,"parentNode 0x%x\n",fo);)
  if (fo<=Lambda) return 0;
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case Module:
    case SrcPos:
    case AtomVariable:
    case AtomConstructor:
    case AtomAbstract:
        return 0;
        break;
    case ExpApp:
    case ExpValueApp:
    case ExpChar:
    case ExpInt:
    case ExpInteger:
    case ExpRat:
    case ExpRational:
    case ExpFloat:
    case ExpDouble:
    case ExpValueUse:
    case ExpConstUse:
    case ExpConstDef:
    case ExpGuard:
    case ExpCase:
    case ExpIf:
    case ExpFieldUpdate:
    case ExpProjection:
    case ExpHidden:
        if (hasSrcPos(c)) { readFO(); }
        return readFO();
        break;
    case ExpForward:
    case ExpDoStmt:
        if (hasSrcPos(c)) { readFO(); }
        return parentNode(readFO());
        break;
  }
}

/* Only for Exp nodes of value kind, we give back a string representation
 * of the name (identifier, Integer, Double, etc), and its fixity etc.
 * The predicate isLiteral reports True for values of basic
 * types like Int, Char, Double etc, and isConstructor identifies Constrs.
 */
char *
getNm (FileOffset fo)
{
  char *id;
  Ident *name = readValueAt(fo);
  if (name) {
    id = name->idname;
    free(name);
    HIDE(fprintf(stderr,"getNm: %s\n",id);)
    return id;
  } else
    return "";
}
char *
getNmMod (FileOffset fo)
{
  char *id;
  Ident *name = readValueAt(fo);
  if (name) {
    id = name->modname;
    free(name);
    return id;
  } else
    return "";
}
int
getFixity (FileOffset fo)
{
  int f;
  Ident *name = readValueAt(fo);
  if (name) {
    f = (int)name->fixity;
    HIDE(fprintf(stderr,"getFixity: %d (%s)\n",f,name->idname);)
    free(name);
    return f;
  } else
    return (int)noFixity;
}
bool
isLiteral (FileOffset fo)
{
  bool b;
  Ident *name = readValueAt(fo);
  if (name) {
    b = (name->atomtype == Literal);
    free(name);
    return b;
  } else
    return False;
}
bool
isConstructor (FileOffset fo)
{
  bool b;
  Ident *name = readValueAt(fo);
  if (name) {
    b = (name->atomtype == Constructor) || (name->atomtype == ConstrFields);
    free(name);
    return b;
  } else
    return False;
}
bool
isConstrFields (FileOffset fo)
{
  bool b;
  char c;
  Ident *name;
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
      case AtomVariable:
      case AtomConstructor:
      case AtomAbstract:
          name = readAtomAt(fo);
          break;
      default:
          name = readValueAt(fo);
          break;
  }
  if (name) {
    b = (name->atomtype == ConstrFields);
    free(name);
    HIDE(fprintf(stderr,"isConstrFields 0x%x: %s %s\n",fo,name->idname,
                                                  (b ? "True" : "False"));)
    return b;
  } else
    return False;
}
bool
isLambda (FileOffset fo)
{
  bool b; unsigned char c;
  HIDE(fprintf(stderr,"isLambda 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(unsigned char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpValueUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        if (readFO()==Lambda) return True;
        else return False;
        break;
    default:
        return False;
        break;
  }
}


/* Get the an name of an identifier out of its struct Ident. */
char*
identName     (Ident* id) { return id->idname; }
char*
identModName  (Ident* id) { return id->modname; }
char*
identSrcFile  (Ident* id) { return id->srcname; }
int
identFixity   (Ident* id) { return (int)id->fixity; }
int
identArity    (Ident* id) { return (int)id->arity; }
int
identDefnLine (Ident* id) { return id->defnline; }
int
identDefnCol  (Ident* id) { return id->defncolumn; }
bool
identIsTraced (Ident* id) { return id->isTraced; }


/* For all nodes, get number of arguments. */
int
getExpArity (FileOffset fo)
{
  char c;
  HIDE(fprintf(stderr,"getExpArity 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpApp:
    case ExpFieldUpdate:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        readFO();                   /* skip fun/constructor */
        fread(&c,sizeof(char),1,HatFileRandom); /* get arity */
        return (int)(c);
        break;
    case ExpValueApp:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        readFO();                   /* skip constructor */
        fread(&c,sizeof(char),1,HatFileRandom); /* get arity */
        return (int)c;
        break;
    case AtomConstructor:                 /* only interested in fields */
        if (!hasFields(c)) { return 0; }
        readFO();                   /* skip module */
        { int x; fread(&x,sizeof(int),1,HatFileRandom); }
        { char x; fread(&x,sizeof(char),1,HatFileRandom); }
        { char arity; fread(&arity,sizeof(char),1,HatFileRandom);
          return (int)arity; }
        break;
    case Module:
    case SrcPos:
    case ExpChar:
    case ExpInt:
    case ExpInteger:
    case ExpRat:
    case ExpRational:
    case ExpFloat:
    case ExpDouble:
    case ExpValueUse:
    case ExpConstUse:
    case ExpConstDef:
    case ExpGuard:
    case ExpCase:
    case ExpIf:
    case ExpProjection:
    case ExpHidden:
    case ExpForward:
    case ExpDoStmt:
    case AtomVariable:
    case AtomAbstract:
        return 0;
        break;
  }
}

/* For all nodes, get the value of the n'th subexpression.  For basic values,
 * the 0'th subexpr is the node itself.  For an application, the 0'th subexpr
 * is the final result of the fun ptr, the k'th subexpr is the final result of
 * the k'th argument.  In the case where a fun/arg resolves to an atom,
 * we return the atom pointer rather than an Exp pointer - the Haskell code
 * can interpret either form.
 */
FileOffset
getExpArg (FileOffset fo, int n)
{
  char c;
  int i=0;
  FileOffset ptr;
  HIDE(fprintf(stderr,"getExpArg 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpApp:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        ptr = readFO();                   /* fun/constructor */
        if (n==0) return getResult(ptr,True);
        fread(&c,sizeof(char),1,HatFileRandom); /* get arity */
        if (n<=c) {
          for (i=1; i<n; i++) readFO();         /* skip other args */
          ptr = readFO();                 /* get n'th arg */
          return getResult(ptr,True);
        } else
          return fo;
        break;
    case ExpValueApp:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* fun/constructor */
        if (n==0) return ptr; /* no result-chain - fun is already an atom */
        fread(&c,sizeof(char),1,HatFileRandom); /* get arity */
        if (n<=c) {
          for (i=1; i<n; i++) readFO();         /* skip other args */
          ptr = readFO();                 /* get n'th arg */
          return getResult(ptr,True);
        } else
          return fo;
        break;
    case ExpValueUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* CAF */
        return ptr;     /* no result-chain - fun is already an atom */
        break;
    case ExpConstDef:
    case ExpConstUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* CAF */
        return getResult(ptr,True);
        break;
    case ExpGuard:
    case ExpCase:
    case ExpIf:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        ptr = readFO();                   /* get condition */
        return getResult(ptr,True);
        break;
    case ExpFieldUpdate:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        ptr = readFO();                   /* exp/constructor */
        if (n==0) return getResult(ptr,True);
        fread(&c,sizeof(char),1,HatFileRandom); /* get arity */
        if (n<=c) {
          for (i=0; i<c; i++) readFO();         /* skip binder labels */
          for (i=1; i<n; i++) readFO();         /* skip other bindees */
          ptr = readFO();                 /* get n'th bindee */
          return getResult(ptr,True);
        } else
          return fo;
        break;
    case ExpProjection:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* get expr */
        return ptr;
        break;
    case ExpForward:
        ptr = readFO();                   /* get expr */
        return ptr;
        break;
    case ExpChar:
    case ExpInt:
    case ExpInteger:
    case ExpRat:
    case ExpRational:
    case ExpFloat:
    case ExpDouble:
    case ExpHidden:
    case ExpDoStmt:
    case Module:
    case SrcPos:
    case AtomVariable:
    case AtomConstructor:
    case AtomAbstract:
    default:
        return fo;
        break;
  }
}

/* Only for an ExpFieldUpdate node, or an ExpConstructor that has fields,
 * get the atom pointer of the n'th label.
 */
FileOffset
getFieldLabel (FileOffset fo, int n)
{
  char c;
  int i=0;
  FileOffset ptr;
  HIDE(fprintf(stderr,"getFieldLabel 0x%x: n=%d\n",fo,n);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpFieldUpdate:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        readFO();                   /* skip exp/constructor */
        fread(&c,sizeof(char),1,HatFileRandom); /* get arity */
        if (n<=c) {
          for (i=1; i<n; i++) readFO();         /* skip other labels */
          ptr = readFO();                 /* get n'th label */
          return ptr;
        } else
          return 0;
        break;
    case ExpValueUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip usage position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* atom pointer */
        return getFieldLabel(ptr,n);
        break;
    case AtomConstructor:
        if (hasFields(c)) {
          readFO();                       /* skip module ptr */
          { int x; fread(&x,sizeof(int),1,HatFileRandom); }
          { char x; fread(&x,sizeof(char),1,HatFileRandom); }
          { char arity; fread(&arity,sizeof(char),1,HatFileRandom);
            readString();
            while (n--) readFO();
            ptr = readFO();
            HIDE(fprintf(stderr,"getFieldLabel: return 0x%x\n",ptr);)
            return ptr; }
        } else {
          fprintf(stderr,"constructor at 0x%x has no field labels\n",fo);
          return 0;
        } break;
    default:
        return 0;
        break;
  }
}

/* Get the SrcRef belonging to any node type.  If the node doesn't have
 * one, we give back a 0 reference.
 */
FileOffset
getSrcRef (FileOffset fo)
{
  char c;
  int i;
  HIDE(fprintf(stderr,"getSrcRef 0x%x\n",fo);)
  if (fo<=Lambda) return 0;
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  if (hasSrcPos(c)) {
    return readFO();                /* get SrcRef */
  } else {
    return 0;
  }
}

/* Get information out of a SrcRef node. */
char *
getSrcRefFile (FileOffset fo)
{
  SrcRef *sr;
  char *id=0;
  if (fo==0) return "";
  sr = readSRAt(fo);
  if (sr) {
    id = sr->srcname;
    free(sr);
  }
  return id;
}
int
srcRefLine (FileOffset fo)
{
  SrcRef *sr;
  int line=0;
  if (fo==0) return 0;
  sr = readSRAt(fo);
  if (sr) {
    line = sr->line;
    free(sr);
  }
  return line;
}
int
srcRefCol (FileOffset fo)
{
  SrcRef *sr;
  int col=0;
  if (fo==0) return 0;
  sr = readSRAt(fo);
  if (sr) {
    col = sr->column;
    free(sr);
  }
  return col;
}

/* Get the Atom node for the fun position of an expression. 
 * If the node doesn't look right, we give back a 0 reference.
 */
FileOffset
getDefnRef (FileOffset fo)
{
  char c;
  int i;
  FileOffset ptr;
  if (fo==0) return 0;
  HIDE(fprintf(stderr,"getDefnRef 0x%x\n",fo);)
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpApp:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        ptr = readFO();                   /* get fun */
        return getDefnRef(ptr);                 /* and follow it */
        break;
    case ExpValueApp:
    case ExpValueUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* get Atom */
        return ptr;
        break;
    case ExpConstUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        ptr = readFO();                   /* get ExpConstDef pointer */
        return getDefnRef(ptr);                 /* and follow it */
        break;
    case ExpConstDef:                     /* never a use position */
        readFO();                   /* skip parent */
        readFO();                   /* skip result */
        ptr = readFO();                   /* get Atom */
        return ptr;
        break;
    case AtomVariable:
    case AtomConstructor:
        return fo;
        break;
    default:
        return 0;
        break;
  }
}

/* Get source position information out of an Atom node. */
char *
getDefnFile (FileOffset fo)
{
  Ident *i;
  char *id;
  if (fo==0) return "";
  i  = readAtomAt(fo);
  id = i->srcname;
  free(i);
  return id;
}
int
defnLine (FileOffset fo)
{
  Ident *i;
  int line;
  if (fo==0) return 0;
  i = readAtomAt(fo);
  line = i->defnline;
  free(i);
  return line;
}
int
defnCol (FileOffset fo)
{
  Ident *i;
  int col;
  if (fo==0) return 0;
  i = readAtomAt(fo);
  col = i->defncolumn;
  free(i);
  return col;
}


/* peekTrace() takes a peek backwards at a trace (or indirection), skipping
 * over any Hidden or Projection nodes to find the nearest "real" trace.
 * It is used by the code that clumps together characters in the output
 * by their shared parentage.
 */
FileOffset
peekTrace(FileOffset fo)
{
  char c;

  while (1) {           /* iterate until we find a `real' node */
    if (fo<=Lambda) return 0; /* trace is Root/Unevaluated/Entered/etc */
    HIDE(fprintf(stderr,"peekTrace 0x%x\n",fo);)
    freadAt(fo,&c,sizeof(char),1,HatFileRandom);
    switch (c) {
      case ExpProjection:
          if (hasSrcPos(c)) { readFO(); } /* skip use position */
          fo = readFO();                  /* get parent */
          break;                    /* and look again */
      case ExpHidden:
      case ExpForward:
          fo = readFO();                  /* get parent */
          break;                    /* and look again */

      case Module:
      case SrcPos:
      case AtomVariable:
      case AtomConstructor:
      case AtomAbstract:
          fprintf(stderr,"peekTrace failed\n");
          exit(1);

      default:
          return fo;                /* found a `real' node! */
          break;
    }
  }
}


/* getResult() returns the result of an application, or 0 if there is
 * apparently no result.  (Results can also be Unevaluated, Entered,
 * or Interrupted).  To find the result, it is necessary to follow
 * the result-pointer chain right to the end (but only as far as the
 * terminating Exp, not right down to an Atom).  If the final result
 * is Unevaluated, Entered, Interrupted, or Lambda, then we return
 * the previous step of the chain.  (The pretty printer then decides
 * how to represent these to the user.)
 *
 * It turns out that a result chain can contain a cycle, which we must
 * detect.  A cycle always involves some Forwards and one Hidden.  It
 * is sufficient to record the most recent Hidden that was seen, and
 * if we come across it again, just stop and return the Hidden.
 */
static FileOffset mostRecentHidden=0;

FileOffset
getResult (FileOffset fo, bool stopAtHidden)
{
  if (fo==mostRecentHidden) return fo;
  mostRecentHidden=0;
  return getResultNoCycle(fo,stopAtHidden);
}

#define fixInterrupt(fo)      (interrupt && fo==Entered ? Interrupted : fo)
FileOffset
getResultNoCycle (FileOffset fo, bool stopAtHidden)
{
  char c;
  FileOffset result;

  HIDE(fprintf(stderr,"getResult 0x%x\n",fo);)
  if (fo<=Lambda) return fixInterrupt(fo);      /* trace is Unevaluated etc */
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpApp:
    case ExpGuard:
    case ExpCase:
    case ExpIf:
    case ExpFieldUpdate:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        HIDE(fprintf(stderr,"getResult: result is 0x%x\n",result);)
        if (result==fo) return fo;
        else if (result<=Lambda) return fixInterrupt(fo);
        else return getResultNoCycle(result,False);
        break;
//  case ExpValueApp:
//  case ExpValueUse:
//      if (hasSrcPos(c)) { readFO(); }         /* skip use position */
//      readFO();                   /* skip parent */
//      return readFO();                  /* return Atom pointer */
//      break;
    case ExpConstUse:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        if (result<=Lambda) return fixInterrupt(fo);
        else return getResultNoCycle(result,False);
                                    /* follow ExpConstDef pointer */
        break;
    case ExpConstDef:
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        if (result<=Lambda) return fixInterrupt(fo);
        return getResultNoCycle(result,False);
        break;
    case ExpForward:
        return getResultNoCycle(readFO(),stopAtHidden);
        break;                            /* continue to detect Hidden */
    case ExpDoStmt:
        return getResultNoCycle(readFO(),False);      /* get result */
        break;
    case ExpProjection:
        return fo;
    case ExpValueApp:
    case ExpValueUse:
    case ExpChar:
    case ExpInt:
    case ExpInteger:
    case ExpRat:
    case ExpRational:
    case ExpFloat:
    case ExpDouble:
//  case AtomVariable:
//  case AtomConstructor:
//  case AtomAbstract:
        HIDE(fprintf(stderr,"getResult: result is itself\n");)
        return fo;
        break;
    case ExpHidden:
        if (stopAtHidden) return fo;
        else if (fo==mostRecentHidden) return fo;
        else {
          mostRecentHidden = fo;          /* keep, to detect a loop */
          readFO();                       /* skip parent */
          result = readFO();              /* get result */
          if (result==fo) return fo;
          else if (result<=Lambda) return fixInterrupt(fo);
          else return getResultNoCycle(result,False);
        }
        break;
    case AtomVariable:
    case AtomConstructor:
    case AtomAbstract:
    default:
        return 0;
        break;
  }
}

/* peekResult() is a one-step look at the result pointer.  It does not
 * follow the whole chain.  It is mainly used to decide whether the
 * pointer returned by getResult() leads directly to an Unevaluated,
 * Entered, Interrupted, or Lambda.
 */
FileOffset
peekResult (FileOffset fo)
{
  char c;
  FileOffset result;

  HIDE(fprintf(stderr,"peekResult 0x%x\n",fo);)
  if (fo<=Lambda) return fixInterrupt(fo);      /* trace is Unevaluated etc */
  freadAt(fo,&c,sizeof(char),1,HatFileRandom);
  switch (lower5(c)) {
    case ExpApp:
    case ExpGuard:
    case ExpCase:
    case ExpIf:
    case ExpFieldUpdate:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        return fixInterrupt(result);
        break;
    case ExpConstUse:
    case ExpProjection:
        if (hasSrcPos(c)) { readFO(); }         /* skip use position */
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        return fixInterrupt(result);
        break;
    case ExpConstDef:
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        return fixInterrupt(result);
        break;
    case ExpForward:
    case ExpDoStmt:
        result = readFO();                /* get result */
        return fixInterrupt(result);
        break;
    case ExpValueApp:
    case ExpValueUse:
    case ExpChar:
    case ExpInt:
    case ExpInteger:
    case ExpRat:
    case ExpRational:
    case ExpFloat:
    case ExpDouble:
        HIDE(fprintf(stderr,"getResult: result is itself\n");)
        return fo;
        break;
    case ExpHidden:
        readFO();                   /* skip parent */
        result = readFO();                /* get result */
        return fixInterrupt(result);
        break;
    case AtomVariable:
    case AtomConstructor:
    case AtomAbstract:
    default:
        return 0;
        break;
  }
}


/* Comparison of FileOffsets is the basic key-ordering for finite maps,
 * used for gathering and looking up information during a linear sweep
 * of the .hat file (in hat-observe and hat-detect).
 */
int
fileoffset_compare (FileOffset i, FileOffset j) /* for ordering the tree */
{
  if (i<j) return -1;
  else if (i==j) return 0;
  else return 1;
}

/* Signal handler for user-interruption */
void
ctrlC (int sig)
{ hat_interrupted = True; }


Generated by  Doxygen 1.6.0   Back to index