/*
 * Utility functions for hat-observe.
 * ----------------------------------
 */
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <signal.h>
#include "finitemap.h"
#include "art.h"
#include "artutils.h"
#include "observeutils.h"
#include "ntohl.h"

#define DEBUG 0

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

/* Some finite maps (i.e. lookup tables):
 * mapAtom2Info    :: FileNode -> Info
 * mapExp2Atom     :: FileNode -> Atom
 * mapContext2Atom :: FileNode -> Atom
 */
FiniteMap mapAtom2Info, mapExp2Atom, mapContext2Atom;

/* Insert into mapAtom2Info */
void
insert_mapAtom2Info (FileOffset atom, char* var, unsigned char arity)
{
  Info *info;
  info = (Info*)malloc(sizeof(Info));
  info->node  = atom;
  info->var   = var;
  info->arity = arity;
  FM_insert(mapAtom2Info,(cast)atom,(cast)info);
}
/* Insert into either mapExp2Atom or mapContext2Atom */
void
insert_map2 (FiniteMap map2, FileOffset exp, FileOffset atom
            ,unsigned char arity)
{
  Info *info = (Info*)0;
  info = FM_lookup(mapAtom2Info,(cast)atom);
  if (info) {
    Atom *fun;
    fun = (Atom*)malloc(sizeof(Atom));
    fun->atom  = atom;
    fun->arity = info->arity - arity;
    FM_insert(map2,(cast)exp,(cast)fun);
  }
}
/* free memory when no longer needed */
void
cleanup_info (FileOffset fo, Info* info) { free(info); }
void
cleanup_atom (FileOffset fo, Atom* atom) { free(atom); }


/* Some global values for an observation search.  Only one search can
 * be active at once.
 */
Bool	o_srcpos, o_context, o_recursive;
char	*o_caller, *o_callee;
char	*o_module;
unsigned	o_linecol;
FileOffset	o_src_fo, o_module_fo;
unsigned char	o_arity=0;	/* oversaturate/override arity */


/* Initialise the global state ready for a new observation to start. */
void
setObserveContext (Bool hascontext, Bool rec, int arity, char* caller)
{
/*struct sigaction sig;*/
  o_srcpos    = False;
  o_context   = hascontext;
  o_recursive = rec;
  o_caller    = strdup(caller);
  o_arity     = (unsigned char)arity;
  q_position  = 0x10;
  fseek(HatFileSeq,q_position,SEEK_SET);
  hat_interrupted = False;
/*sig.sa_handler = ctrlC; sigemptyset(&sig.sa_mask); sig.sa_flags=0; */
/*sigaction(SIGINT,&sig,(void*)0); */
  signal(SIGINT,ctrlC);
  /* Reset the maps here, freeing the tree contents also. */
  if (mapAtom2Info)    FM_destroy(mapAtom2Info);
  if (mapExp2Atom)     FM_destroy(mapExp2Atom);
  if (mapContext2Atom) FM_destroy(mapContext2Atom);
  mapAtom2Info    = FM_new((FMComparison)fileoffset_compare
                          ,(FMFreeItem)cleanup_info);
  mapExp2Atom     = FM_new((FMComparison)fileoffset_compare
                          ,(FMFreeItem)cleanup_atom);
  mapContext2Atom = FM_new((FMComparison)fileoffset_compare
                          ,(FMFreeItem)cleanup_atom);
  HIDE(fprintf(stderr,"setObserveContext: filepos=0x%x\n",ftell(HatFileSeq));)
}

/* Some more initialisation of the global state for a new observation,
 * together with the first search for a matching node.
 */
FileOffset
lookForFirstApp (char* callee)
{
  o_callee = strdup(callee);
  HIDE(fprintf(stderr,"lookForFirstApp: %s\n",o_callee);)
  return nextObservation(0);
}

FileOffset
lookForFirstSrc (int line, int col, char* module)
{
  o_srcpos  = True;
  o_module  = strdup(module);
  o_linecol = htonl((unsigned)(line*10000) + (unsigned)col);
  o_module_fo = o_src_fo = 0;
  HIDE(fprintf(stderr,"lookForFirstSrc: %s %d\n",o_module,o_linecol);)
  return nextObservation(0);
}

/* Search sequentially from the current position for the next matching
 * application.  The argument is not used - it is only there to
 * ensure that the Haskell IO action is executed.
 */
FileOffset
nextObservation (FileOffset seen)
{
  FileOffset node=0;
  if (o_srcpos) {
    do { node = srcSearch(); } while (!node);
  } else {
    do { node = varSearch(); } while (!node);
  }
  HIDE(fprintf(stderr,"nextObservation: 0x%x\n",node);)
  return node;
}

/* varSearch() moves the sequential file pointer past a single node in
 * the file, looking for a particular variable or constructor application.
 *  *  If the node is an AtomVariable matching the var we are
 *     searching for, we record it in the Atom2Info map.
 *  *  If it is an ExpValueUse whose atom value is already in the
 *     Atom2Info map, then we record it in the Exp2Atom map.
 *  *  If the node is an application whose function position
 *     matches the var we are looking for (i.e. it can be found in
 *     the Exp2Atom map), and the arity is correct, we return the
 *     node address.
 *  *  If the application is undersaturated, we simply record the
 *     address in the Exp2Atom map, as for an ExpValueUse.
 *  *  CAFS: If the node is a CAF definition whose Atom matches the var,
 *     we record its address in the Exp2Atom map.  If it is a CAF use
 *     whose definition can be found in the Exp2Atom map, we return the
 *     node address.
 *  *  Constructors are just like vars, except for zero-arity constrs,
 *     which are recorded in as ExpValueUse rather than ExpConstUse.
 *
 * If we were asked to exclude recursive calls, then we additionally keep
 * a record of all calls to this var in the Context2Atom map, and check
 * the parent to decide whether we have found a suitable matching application.
 *
 * Similarly, if the query included a context, then we keep a note of all
 * applications of that context var, and again check the parent to decide
 * whether we have found a match.
 */
FileOffset
varSearch (void)
{
  unsigned char c; int err;
  FileOffset node = q_position;
  HIDE(fprintf(stderr,"\n0x%x: ",q_position);)
  if (hat_interrupted) return 3;
  err = q_fread(&c,sizeof(unsigned char),1,HatFileSeq);
  if (err!=1) return 1;	/* Assume EOF */
  switch (lower5(c)) {  /* lower 5 bits identify the TraceType */
    case ExpApp:
        if (hasSrcPos(c)) { q_readFO(); }
        { unsigned char size, next, i;
          FileOffset parent, result, fun; Atom *atom; Info *it;
          parent = q_readFO();
          result = q_readFO();
          fun = q_readFO();
          q_fread(&size,sizeof(unsigned char),1,HatFileSeq);  /* get arity */
          for (i=0; i<size; i++) q_readFO();    /* skip args */
          /* First check if this is a possible caller context */
          if (o_context) {
            atom = (Atom*)FM_lookup(mapContext2Atom,(cast)fun);
            if (atom) {
              it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
              if (it && !strcmp(it->var,o_caller)) {
                insert_map2(mapContext2Atom,node,atom->atom,size);
                HIDE(fprintf(stderr,"App of %s (context) ",it->var);)
              }
            }
          }
          /* Then check if we have found the right callee */
          atom = (Atom*)FM_lookup(mapExp2Atom,(cast)fun);
          if (atom) {
            it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
            if (it && !strcmp(it->var,o_callee)) {
              HIDE(fprintf(stderr,"App of %s (callee)",it->var);)
              if (size >= atom->arity) {  /* is not undersaturated */
                if (!o_recursive) {  /* if excluding recursive calls */
                  insert_map2(mapContext2Atom,node,atom->atom,size);
                  atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);
                  if (atom) {
                    it =(Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
                    if (it && !strcmp(it->var,o_callee)) return 0;
                    else return node;
                  } else return node;
                } else if (o_context) {	 /* if context matters */
                  atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);
                  if (atom) {
                    it =(Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
                    HIDE(fprintf(stderr,"(context is %s)",it->var);)
                    if (it && !strcmp(it->var,o_caller)) return node;
                  }
                } else return node;  /* no context, no recursive exclusion */
              } else insert_map2(mapExp2Atom,node,atom->atom,size);
            }
          }
        } break;
    case ExpValueApp:
        if (hasSrcPos(c)) { q_readFO(); }
        { unsigned char size, next, i;
          FileOffset parent, fun; Atom *atom; Info *it;
          parent = q_readFO();  /* skip parent */
          fun = q_readFO();     /* fun ptr is an Atom ref */
          q_fread(&size,sizeof(unsigned char),1,HatFileSeq);    /* get arity */
          for (i=0; i<size; i++) q_readFO();    /* skip args */
          it = (Info*)FM_lookup(mapAtom2Info,(cast)fun);
          if (it && !strcmp(it->var,o_callee)) {
            if (size >= it->arity) {
              if (o_context) {	/* if context matters */
                atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);
                if (atom) {
                  it =(Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
                  HIDE(fprintf(stderr,"(context is %s)",it->var);)
                  if (it && !strcmp(it->var,o_caller)) return node;
                }
              } else return node;
            } else insert_map2(mapExp2Atom,node,fun,size);
          }
        } break;
    case AtomConstructor:
    case AtomVariable:
        q_readFO();             /* skip module pointer */
        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }   /* skip line/col */
        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }   /* skip line/col */
        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); } /* skip fixity */
        { unsigned char arity, tmp;
          char *id;
          q_fread(&arity,sizeof(unsigned char),1,HatFileSeq);
          id = q_readString();
          if (lower5(c)==AtomConstructor && hasFields(c))
            for (tmp=arity;tmp-->0;) q_readFO();
          HIDE(fprintf(stderr,"%s %s ",(lower5(c)==AtomVariable?"Var":"Con"),id);)
          if (!strcmp(id,o_callee) || !strcmp(id,o_caller)) {
            insert_mapAtom2Info(node,id,((o_arity>arity) ? o_arity : arity));
            HIDE(fprintf(stderr,"(recorded at 0x%x, arity=%d)",node,arity);)
            HIDE(fprintf(stderr,"(o_arity=%d)",node,o_arity);)
          }
        } break;
    case ExpValueUse:
        if (hasSrcPos(c)) { q_readFO(); }
        { FileOffset parent, atom; Info *it;
          parent = q_readFO();	/* get parent */
          atom = q_readFO();	/* get atom */
          if ((atom==Lambda)||(atom==DoLambda)) {
            if (o_context || !o_recursive) {
              Atom *atom;	/* shadows outer scope */
              atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);
              if (atom) {
                it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
                if (it) {
                  if ( (!o_recursive && !strcmp(it->var,o_callee))
                     || (o_context && !strcmp(it->var,o_caller)) ) {
                    insert_map2(mapContext2Atom,node,atom->atom,0);
                  }
                }
              }
            }
          } else {
            it = (Info*)FM_lookup(mapAtom2Info,(cast)atom);
            if (it) {
              if (!strcmp(it->var,o_callee)) {
                insert_map2(mapExp2Atom,node,atom,0);
                if (!o_recursive) insert_map2(mapContext2Atom,node,atom,0);
              }
              if (!strcmp(it->var,o_caller)) {
                insert_map2(mapContext2Atom,node,atom,0);
              }
              HIDE(fprintf(stderr,"ValueUse %s",it->var);)
              if (it->arity==0 && !strcmp(it->var,o_callee)) return node;
            }
          }
        } break;
    case ExpConstDef:
        { FileOffset atom, result; Info *it;
          q_readFO();		/* skip parent */
          result = q_readFO();	/* result might contain desired function */
          atom = q_readFO();	/* get atom */
          it = (Info*)FM_lookup(mapAtom2Info,(cast)atom);
          if (it) {
            HIDE(fprintf(stderr,"ConstDef %s",it->var);)
            if (!strcmp(it->var,o_callee))
              insert_map2(mapExp2Atom,node,atom,0);
            else if (o_context && !strcmp(it->var,o_caller))
              insert_map2(mapContext2Atom,node,atom,0);
          //if (!strcmp(it->var,o_callee)) return node;
          } else {
            HIDE(fprintf(stderr,"ConstDef (searchCAF)");)
            searchCAFResult(node,result,0,0);
          }
        } break;
    case ExpConstUse:
        HIDE(fprintf(stderr,"ConstUse ");)
        if (hasSrcPos(c)) { q_readFO(); }
        { FileOffset exp; Atom *def; Info *it;
          q_readFO();		/* skip parent */
          exp = q_readFO();	/* get ExpConstDef location */
          def = (Atom*)FM_lookup(mapExp2Atom,(cast)exp);
          if (def) {
            insert_map2(mapExp2Atom,node,def->atom,def->arity);	// allows oversat apps
            it = FM_lookup(mapAtom2Info,(cast)def->atom);
            HIDE(if (it) fprintf(stderr,"%s",it->var);)
            if (it && !strcmp(it->var,o_callee)) return node;
          } else {
            def = (Atom*)FM_lookup(mapContext2Atom,(cast)exp);
            if (def) {
              it = FM_lookup(mapAtom2Info,(cast)def->atom);
              if (it && !strcmp(it->var,o_caller))
                insert_map2(mapContext2Atom,node,def->atom,def->arity);
            }
          }
        } break;
    case ExpGuard:
    case ExpCase:
    case ExpIf:
        if (o_context || !o_recursive) {
          if (hasSrcPos(c)) { q_readFO(); }
          { FileOffset parent; Atom *atom; Info *it;
            parent = q_readFO();
            q_readFO();	/* skip result */
            q_readFO();	/* skip condition */
            atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);
            if (atom) {
              it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
              if (it) {
                if ( (!o_recursive && !strcmp(it->var,o_callee))
                   || (o_context && !strcmp(it->var,o_caller)) ) {
                  insert_map2(mapContext2Atom,node,atom->atom,0);
                }
              }
            }
          }
        } else q_skipNode(c);
        break;
    default:
        q_skipNode(c);
        break;
  }
  return 0;	/* if we didn't find an application */
}

/* srcSearch() moves the sequential file pointer past a single node in
 * the file, looking for a particular usage position.  Having found the
 * usage position, we then look for any application or value used at that
 * position.
 */
FileOffset
srcSearch (void)
{
  unsigned char c; int err;
  FileOffset node = q_position;
  HIDE(fprintf(stderr,"\n0x%x: ",q_position);)
  if (hat_interrupted) return 3;
  err = q_fread(&c,sizeof(unsigned char),1,HatFileSeq);
  if (err!=1) return 1;	/* Assume EOF */
  if (!o_src_fo) {
    switch (lower5(c)) {  /* lower 5 bits identify the TraceType */
      case Module:
          HIDE(fprintf(stderr,"Module ");)
          if (o_module_fo) q_skipNode(c);
          else {
            char *file;
            q_readString();	/* skip module name */
            file = q_readString();
            HIDE(fprintf(stderr,"File %s ",file);)
            if (!strcmp(file,o_module)) {
              HIDE(fprintf(stderr,"(Got it!)");)
              o_module_fo = node;
            }
          } break;
      case SrcPos:
          HIDE(fprintf(stderr,"SrcPos ");)
          if (!o_module_fo) q_skipNode(c);
          else {
            FileOffset mod; unsigned linecol;
            mod = q_readFO();
            q_fread(&linecol,sizeof(unsigned),1,HatFileSeq);
            { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }/* skip line/col */
            HIDE(fprintf(stderr,"Line/Col %d ",linecol);)
            if (mod==o_module_fo && linecol==o_linecol) {
              HIDE(fprintf(stderr,"(Got it!)");)
              o_src_fo = node;
            }
          } break;
      default:
          q_skipNode(c);
          break;
    }
  } else {
    switch (lower5(c)) {  /* lower 5 bits identify the TraceType */
      case ExpApp:
          HIDE(fprintf(stderr,"ExpApp ");)
          if (hasSrcPos(c)) {
            unsigned char size, i; FileOffset fo;
            fo = q_readFO();
            HIDE(fprintf(stderr,"SrcPos=0x%x ",fo);)
            q_readFO(); q_readFO(); q_readFO();
            q_fread(&size,sizeof(unsigned char),1,HatFileSeq);	/* get arity */
            for (i=0; i<size; i++) q_readFO();	/* skip args */
            if (fo==o_src_fo) {
              HIDE(fprintf(stderr,"(Got it!)");)
              return node;
            }
          } else q_skipNode(c);
          break;
      default:
          q_skipNode(c);
          break;
    }
  }
  return 0;	/* if we didn't find an application at the src location */
}


/* searchCAFResult() takes the result pointer of a CAF and searches the
 * result chain to discover whether the CAF ever reduced to a (partial)
 * application of the function we want to observe.  If so, then the
 * original CAF node should be memoised as if it were the function we
 * want.  The arity to memoise however, is the extent of undersaturatedness
 * of the partial application.
 */
void
searchCAFResult (FileOffset caf, FileOffset value, unsigned char arity
                ,FileOffset mostRecentHidden)
{
  unsigned char c;
  HIDE(fprintf(stderr
              ,"searchCAF: caf=0x%x, value=0x%x, arity=0x%x, hidden=0x%x\n"
              ,caf,value,arity,mostRecentHidden);)
  if ((value<DoLambda) || (value==caf)) return;
  if (value==mostRecentHidden) return;
  freadAt(value,&c,sizeof(unsigned char),1,HatFileRandom);
  switch (lower5(c)) {  /* lower 5 bits identify the TraceType */
    case ExpApp:
        HIDE(fprintf(stderr,"searchCAF: found ExpApp\n");)
        if (hasSrcPos(c)) { readFO(); }
        { unsigned char size;
          FileOffset result, fun;  Atom *atom;  Info *it;
          readFO();
          result = readFO();
          fun = readFO();
          fread(&size,sizeof(unsigned char),1,HatFileRandom);	/* arity */
          if (fun < caf) {	/* fun already seen in linear scan */
            if (o_context) {
              atom = (Atom*)FM_lookup(mapContext2Atom,(cast)fun);
              if (atom) {
                it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
                if (it && !strcmp(it->var,o_caller)) {
                  insert_map2(mapContext2Atom,caf,atom->atom,size);
                }
              }
            }
            atom = (Atom*)FM_lookup(mapExp2Atom,(cast)fun);
            if (atom) {
              it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);
              if (it && !strcmp(it->var,o_callee)
                     && ((size+arity)<atom->arity)) {
                HIDE(fprintf(stderr,"searchCAF: STORING caf=0x%x var=%s, size=%d\n",caf,it->var,size);)
                insert_map2(mapExp2Atom,caf,atom->atom,size);
              }
            }
          } else { /* fun not yet seen; linear scan has not reached it */
            searchCAFResult(caf,fun,size+arity,mostRecentHidden);
          }
       // if (result!=caf) searchCAFResult(caf,result,arity,mostRecentHidden);
        }
        break;
    case ExpValueUse:
        HIDE(fprintf(stderr,"searchCAF: found ExpValueUse\n");)
        if (hasSrcPos(c)) { readFO(); }
        { FileOffset var; Info *it;
          readFO();		/* parent */
          var = readFO();	/* atom */
          if (var==Lambda) return;
          if (var==DoLambda) return;
          if (var < caf) {
            HIDE(fprintf(stderr,"searchCAF: var=0x%x < caf=0x%x\n",var,caf);)
            it = (Info*)FM_lookup(mapAtom2Info,(cast)var);
            HIDE(if (it) fprintf(stderr,"searchCAF: var=%s\n",it->var);)
            if (it && !strcmp(it->var,o_callee) && (arity<it->arity)) {
              HIDE(fprintf(stderr,"searchCAF: STORING caf=0x%x var=%s, size=%d\n",caf,it->var,arity);)
              insert_map2(mapExp2Atom,caf,var,arity);
            }
          } else {
            HIDE(fprintf(stderr,"searchCAF: var=0x%x > caf=0x%x\n",var,caf);)
            searchCAFResult(caf,var,arity,mostRecentHidden);
          }
        }
        break;
    case ExpProjection:
        HIDE(fprintf(stderr,"searchCAF: found ExpProjection\n");)
        if (hasSrcPos(c)) { readFO(); }
        { FileOffset result;
          readFO();	/* parent */
          result = readFO();
          searchCAFResult(caf,result,arity,mostRecentHidden);
        }
        break;
    case ExpHidden:
        HIDE(fprintf(stderr,"searchCAF: found ExpHidden\n");)
        { FileOffset result;
          readFO();	/* parent */
          result = readFO();
          searchCAFResult(caf,result,arity,value);
        }
        break;
    case ExpForward:
        HIDE(fprintf(stderr,"searchCAF: found ExpForward\n");)
        { FileOffset result;
          result = readFO();
          searchCAFResult(caf,result,arity,mostRecentHidden);
        }
        break;
    case AtomVariable:
        readFO();	/* skip module pointer */
        { int x; fread(&x,sizeof(int),1,HatFileRandom); }   /* skip line/col */
        { int x; fread(&x,sizeof(int),1,HatFileRandom); }   /* skip line/col */
        { char x; fread(&x,sizeof(char),1,HatFileRandom); } /* skip fixity */
        { unsigned char size;
          char *id;
          fread(&size,sizeof(unsigned char),1,HatFileRandom);
          id = readString();
          HIDE(fprintf(stderr,"searchCAF: found AtomVariable %s\n",id);)
          if (!strcmp(id,o_callee) && (arity<size)) {
            insert_mapAtom2Info(value,id,(o_arity>size ? o_arity : size));
              HIDE(fprintf(stderr,"searchCAF: STORING caf=0x%x var=%s, size=%d\n",caf,id,arity);)
            insert_map2(mapExp2Atom,caf,value,arity);
          }
          if (o_context && !strcmp(id,o_caller) && (arity<size)) {
            insert_mapAtom2Info(value,id,size);
            insert_map2(mapContext2Atom,caf,value,arity);
          }
        }
        break;
    default:
        HIDE(fprintf(stderr,"searchCAF: found something else\n");)
        break;
  }
  return;
}