/*     
      TYPE MISC . Magma 1.0 . 1996 . Sylvain HUET

         outils pour le typage
*/
// Modification history:
//$ FA(03/05/2001): Promote to C++ file
//$ FA(03/05/2001): Use new lexer interface (lexer.h)
//$ FA(20/06/2001): Debugger integration. Add support for extra var fields.
//$ FA(16/07/2001): Use h2i() as a replacement for Mgethx()
//$ FA(17/07/2001): Replace MAXSIZETOKEN by MAXSIZETOKEN+1 in buffer definitions
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by RELEASE_DEVELOPER
//

#include <stdio.h>
#include <string.h>

#include "debug.h"
#include "loadpak.h"
#include "compiler/lexer.h"
#include "scolMacros.h"
extern "C" {
#include "scolMMemory.h"
#include "vm/mbytec.h"
#include "mbytec2.h"
#include "listlab.h"
#include "compiler/typmisc.h"
}

int TPfresh;
int TPmax=-1;

int TPgetfresh(int n)
{
  if (n>TPmax) TPmax=n;
  return (TPfresh+n)&0xffff;
}

void TPupdatefresh()
{
  TPfresh=(TPfresh+TPmax+1)&0xffff;
}

/* empile un noeud sans interet mais pouvant appartenir a une classe */
int TPnil(mmachine m)
{
  int k;
  char buf[128];

  TPmax=-1;
  sprintf(buf,"u%x",TPgetfresh(0));
  if (MMpush(m,NIL)) return MERRMEM;
  if (Mpushstring(m,buf)) return MERRMEM;
  if (MMpush(m,SIZETYP*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  TPupdatefresh();
  return 0;
}

int TPismaj(char c)
{
  if ((c>='A')&&(c<='Z')) return 1;
  return 0;
}

/* recherche du noeud associe a un label dans une liste
   (retourne NIL si introuvable) */
int TPsearchtype(mmachine m, int first, char *name)
{
  int i,s;

  i=first;
  while(i!=NIL)
    {
      i>>=1;
      s=(m->tape[i+SizeHeader+OFFLBNAME]>>1);
      if (!strcmp((char*)&m->tape[s+SizeHeader],name))
        return (m->tape[i+SizeHeader+OFFLBNUM]);
      i=m->tape[i+SizeHeader+OFFLBNEXT];
    }
  return NIL;
}

/* comptage des elements de la liste */
int TPcountlabel(mmachine m, int first)
{
  int s,n;

  s=m->top[first];
  n=0;
  while(s!=NIL)
    {
      n++;
      s=m->tape[(s>>1)+SizeHeader+OFFLBNEXT];
    }
  return n;
}

/* suppression des n premiers elements de la liste */
int TPdelnlabel(mmachine m, int first, int n)
{
  int i,s;

  for(i=0;i<n;i++)
    {
      s=m->top[first];
      if (s!=NIL)
        {
          s>>=1;
          m->top[first]=m->tape[s+SizeHeader+OFFLBNEXT];
        }
    }
  return 0;
}

/* ajout d'un label dans une liste, sans test d'unicite 
   retourne le noeud */
int TPaddlabel(mmachine m, int first, char *name)
{
  int l,s,k;

  if (MMpush(m,NIL)) return MERRMEM;
  if (Mpushstring(m,name)) return MERRMEM;
  if (MMpush(m,SIZETYP*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  if (k=MBdup(m)) return k;
  if (l=Mpushstring(m,name)) return l;

  s=MMmalloc(m,SIZELISTB,TYPETAB); if (s==NIL) return MERRMEM;

  m->tape[s+SizeHeader+OFFLBNAME]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFLBNUM] =m->top[m->pp+1];
  m->tape[s+SizeHeader+OFFLBNEXT]=m->top[first];
  m->top[first]=s+s+1;
  m->pp+=2;

  return MMpull(m);
}

/* creation des recursions dans un graphe
  0:noeud principal
->0:noeud principal
*/
int TPcreaterec(mmachine m,int prof)
{
  char *c;
  int i,k,n,s;

  s=m->top[m->pp]>>1;
  if (s==NIL) return 0;
  c=(char*)&m->tape[(m->tape[s+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  if (c[0]=='r')
    {
      h2i(&c[1], &i);                  //$ FA(16/07/2001)
      if (i>prof) return MERRTYP;
      m->top[m->pp]=m->top[m->pp+i];
      return 0;
    }
  else if (!strcmp(c,"#tup"))
    {
      n=(m->tape[s]>>1)-SIZETYP;
      for(i=0;i<n;i++)
        {
          if (MMpush(m,m->tape[s+SizeHeader+SIZETYP+i])) return MERRMEM;
          if (k=TPcreaterec(m,prof+1)) return k;
          s=m->top[m->pp+1]>>1;
          m->tape[s+SizeHeader+SIZETYP+i]=MMpull(m);
        }
      return 0;
    }
  else if (!strcmp(c,"#fun"))
    {
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP])) return MERRMEM;
      if (k=TPcreaterec(m,prof+1)) return k;
      s=m->top[m->pp+1]>>1;
      m->tape[s+SizeHeader+SIZETYP]=MMpull(m);
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP+1])) return MERRMEM;
      if (k=TPcreaterec(m,prof+1)) return k;
      s=m->top[m->pp+1]>>1;
      m->tape[s+SizeHeader+SIZETYP+1]=MMpull(m);
      return 0;
    }
  else if (!strcmp(c,"#tab"))
    {
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP])) return MERRMEM;
      if (k=TPcreaterec(m,prof+1)) return k;
      s=m->top[m->pp+1]>>1;
      m->tape[s+SizeHeader+SIZETYP]=MMpull(m);
      return 0;
    }
  return 0;
}


int TPtypg2(mmachine m,manlyz z,int ind,int level,int mono)
{
  int k,n,q,i,nlab;
  char buf[MAXSIZETOKEN+1];

  if (Mreadtok(z)) return MERRTYP;
  if (MMpush(m,NIL)) return MERRMEM;  /* classe */
  n=0;
  if (TPismaj(z->tok[0]))
    {
      sprintf(buf,"#%s",z->tok);
      if (Mpushstring(m,buf)) return MERRMEM;
    }
  else if ((z->tok[0]=='u')&&(mono==0))
    {
      if (!h2i(&z->tok[1], &i))           //$ FA(16/07/2001)
        return MERRTYP; 
      sprintf(buf,"u%x",TPgetfresh(i));
      
      i=TPsearchtype(m,m->top[ind],buf);
      if (i==NIL)
        {
          if (level==0) return MERRTYP;
          i=TPaddlabel(m,ind,buf);
        }
      m->top[m->pp]=i;
      return 0;
    }
  else if (z->tok[0]=='r')
    {
      int i;
      if (!h2i(&z->tok[1], &i))           //$ FA(16/07/2001)
        return MERRTYP; 
      if (Mpushstring(m,z->tok)) return MERRMEM;
    }
  else if (!strcmp(z->tok,"tab"))
    {
      if (Mpushstring(m,"#tab")) return MERRMEM;
      if (k=TPtypg2(m,z,ind,level,mono)) return k;
      n=1;
    }
  else if (!strcmp(z->tok,"fun"))
    {
      if (Mreadtok(z)) return MERRTYP;
      z->giveback=1;
      if (Mpushstring(m,"#fun")) return MERRMEM;
      if (level)
        {
          if (k=TPtypg2(m,z,ind,level,mono)) return k;
          if (k=TPtypg2(m,z,ind,level,mono)) return k;
        }
      else
        {
          nlab=TPcountlabel(m,ind);
          if (k=TPtypg2(m,z,ind,1,mono)) return k;
          nlab=TPcountlabel(m,ind)-nlab;
          if (k=TPtypg2(m,z,ind,level,mono)) return k;
          TPdelnlabel(m,ind,nlab);
        }
      n=2;
    }
  else if (!strcmp(z->tok,"["))
    {
      if (Mpushstring(m,"#tup")) return MERRMEM;
      q=1;
      while(q)
        {
          if (Mreadtok(z)) return MERRTYP;
          if (!strcmp(z->tok,"]")) q=0;
          else
            {
              z->giveback=1;
              if (k=TPtypg2(m,z,ind,level,mono)) return k;
              n++;
            }
        }
    }
  else
    return MERRTYP;
  if (MMpush(m,(n+SIZETYP)*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  return 0;
}

/* cree un graphe de type a partir d'une chaine type
  0:chaine
->0:noeud principal */
int TPtypgraph(mmachine m)
{
  struct Manlyz z;
  int ind,s,k;

  TPmax=-1;
  s=MMpull(m)>>1;
  if (k=Mopenstring(&z,(char*)&m->tape[s+SizeHeader])) return k;

  if (MMpush(m,NIL)) return MERRMEM;
  ind=m->pp;
  if (k=TPtypg2(m,&z,ind,0,0)) return k;
  if (k=TPcreaterec(m,0)) return k;
  m->top[m->pp+1]=m->top[m->pp];
  m->pp++;

  TPupdatefresh();
  return 0;
}

/* creation des types faibles
  0:noeud principal (sans recursions)
->0:noeud principal
*/
int TPcreateweaktype(mmachine m,int ind)
{
  char *c;
  int i,k,n,s;
  char buf[128];

  s=m->top[m->pp]>>1;
  if (s==NIL) return 0;
  c=(char*)&m->tape[(m->tape[s+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  if ((c[0]=='#')&&(TPismaj(c[1])))
    {
	  i=Msearchvartyp(m,m->top[ind+PKGVAR],c+1);
	  if (i==NIL) i=Msearchtypinpak(m,m->top[ind+PKGLP],c+1);
	  if ((i==NIL)||((m->tape[i+SizeHeader+OFFVTYP]>>1)!=TYPTYPE))
	    {
		  MMechostr(MSKTRACE,"weak type : %s\n",c+1);
		  strcpy(buf,c+1);
	      if (Mpushstring(m,buf)) return MERRMEM;
  	      s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;
		  m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp];
		  m->tape[s+SizeHeader+OFFVVAL] =0;
		  m->tape[s+SizeHeader+OFFVTYP] =TYPTYPE*2;
		  m->tape[s+SizeHeader+OFFVSTYP]=NIL;
		  m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ FA(08/11/2000)
      m->tape[s+SizeHeader+OFFVPKG]  = NIL;
#if defined(RELEASE_DEVELOPER)
//$ FA(29/11/2000): Assign unique id to global var object
      m->tape[s+SizeHeader+OFFVID]   = SEI2W(varID++);
//$ FA(20/06/2001): Size and cost initially null
      m->tape[s+SizeHeader+OFFVSIZE] = NIL;
#endif
//
		  m->top[ind+PKGVAR]=s+s+1;
		  m->pp++;
		}
	  return 0;
    }
  else if (!strcmp(c,"#tup"))
    {
      n=(m->tape[s]>>1)-SIZETYP;
      for(i=0;i<n;i++)
        {
          s=m->top[m->pp]>>1;	// SH001018
          if (MMpush(m,m->tape[s+SizeHeader+SIZETYP+i])) return MERRMEM;
          if (k=TPcreateweaktype(m,ind)) return k;
		  MMpull(m);
        }
      return 0;
    }
  else if (!strcmp(c,"#fun"))
    {
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP])) return MERRMEM;
      if (k=TPcreateweaktype(m,ind)) return k;
      MMpull(m);
      s=m->top[m->pp]>>1;	// SH001018
	  if (MMpush(m,m->tape[s+SizeHeader+SIZETYP+1])) return MERRMEM;
      if (k=TPcreateweaktype(m,ind)) return k;
      MMpull(m);
	  return 0;
    }
  else if (!strcmp(c,"#tab"))
    {
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP])) return MERRMEM;
      if (k=TPcreateweaktype(m,ind)) return k;
      MMpull(m);
	  return 0;
    }
  return 0;
}

/* cree un graphe de type a partir d'une structure d'analyse 
->0:noeud principal */
int TPtypgraphanlz(mmachine m,manlyz z,int ind0)
{
  int ind,k;

  TPmax=-1;

  if (MMpush(m,NIL)) return MERRMEM;
  ind=m->pp;
  if (k=TPtypg2(m,z,ind,0,0)) return k;
  TPcreateweaktype(m,ind0);
  if (k=TPcreaterec(m,0)) return k;
  m->top[m->pp+1]=m->top[m->pp];
  m->pp++;

  TPupdatefresh();
  return 0;
}

/* cree un graphe de type non polymorphe a partir d'une structure d'analyse 
->0:noeud principal */
int TPtypgraphanlzmono(mmachine m,manlyz z,int ind0)
{
  int ind,k;

  TPmax=-1;

  if (MMpush(m,NIL)) return MERRMEM;
  ind=m->pp;
  if (k=TPtypg2(m,z,ind,0,1)) return k;
  TPcreateweaktype(m,ind0);
  if (k=TPcreaterec(m,0)) return k;
  m->top[m->pp+1]=m->top[m->pp];
  m->pp++;

  TPupdatefresh();
  return 0;
}

/* trouver l'equivalence d'un noeud */
int TPtrouver(mmachine m, int noeud)
{
  int last,n;

  last=NIL;
  n=noeud;
  while(n!=NIL)
    {
      last=n;
      n=m->tape[(n>>1)+SizeHeader+OFFTCL];
    }
  return last;
}


int TPrestore(mmachine m,int t,int s,int vt,int vs,int k)
{
  m->tape[t+SizeHeader+OFFTCL]=vt;
  m->tape[s+SizeHeader+OFFTCL]=vs;
  return k;
}

/* unification de deux noeuds */
int TPunif2(mmachine m, manlyz z,int x,int y)
{
  int s,t,ns,nt,i,k,vt,vs;
  char *a,*b;

  s=TPtrouver(m,x)>>1;
  t=TPtrouver(m,y)>>1;
  if ((s==t)||(s==NIL)||(t==NIL)) return 0;

  a=(char*)&m->tape[(m->tape[s+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  b=(char*)&m->tape[(m->tape[t+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  if ((a[0]=='#')&&(b[0]=='#')&&(strcmp(a,b)))
    {
      //$BB put error message into z manlyz structure buffer
      sprintf(z->mess,">>> ERROR - Type mismatch (clue):\nFound:    Type %s\nExpected: Type %s\n<<<\n",a,b);
      //MMechostr(MSKRUNTIME,">>> ERROR - Type mismatch (clue):\nFound:    Type %s\nExpected: Type %s\n<<<\n",a,b);
      return MERRTYP;
    }

  vt=m->tape[t+SizeHeader+OFFTCL];
  vs=m->tape[s+SizeHeader+OFFTCL];
  if (a[0]=='#')      /* union des noeuds */
    m->tape[t+SizeHeader+OFFTCL]=s+s+1;
  else
    m->tape[s+SizeHeader+OFFTCL]=t+t+1;

  if ((!strcmp(a,"#tup"))&&(!strcmp(b,"#tup")))
    {
      ns=(m->tape[s]>>1)-SIZETYP;
      nt=(m->tape[t]>>1)-SIZETYP;
      if (ns!=nt)
        {
          //$BB put error message into z manlyz structure buffer
          sprintf(z->mess,">>> Error - Type mismatch (clue):\nFound:    Tuple %d\nExpected: Tuple %d\n<<<\n",ns,nt);
          //MMechostr(MSKRUNTIME,">>> Error - Type mismatch (clue):\nFound:    Tuple %d\nExpected: Tuple %d\n<<<\n",ns,nt);
          return TPrestore(m,t,s,vt,vs,MERRTYP);
        }
      for(i=0;i<ns;i++)
        if (k=TPunif2(m,z,m->tape[s+SizeHeader+SIZETYP+i]
                     ,m->tape[t+SizeHeader+SIZETYP+i])) return TPrestore(m,t,s,vt,vs,k);
    }
  else if ((!strcmp(a,"#fun"))&&(!strcmp(b,"#fun")))
    {
      if (k=TPunif2(m,z,m->tape[s+SizeHeader+SIZETYP]
                   ,m->tape[t+SizeHeader+SIZETYP])) return TPrestore(m,t,s,vt,vs,k);
      if (k=TPunif2(m,z,m->tape[s+SizeHeader+SIZETYP+1]
                   ,m->tape[t+SizeHeader+SIZETYP+1])) return TPrestore(m,t,s,vt,vs,k);
    }
  else if ((!strcmp(a,"#tab"))&&(!strcmp(b,"#tab")))
    {
      if (k=TPunif2(m,z,m->tape[s+SizeHeader+SIZETYP]
                   ,m->tape[t+SizeHeader+SIZETYP])) return TPrestore(m,t,s,vt,vs,k);
    }
  return 0;
}

int TPunif(mmachine m, manlyz z,int x,int y)
{
	int k,l;

	if ((l=TPunif2(m,z,x,y))==0) return 0;
	MMpushNoGC(m,x);
	if (MMpush(m,y)) return MERRMEM;
	if (k=TPsolvenode(m)) return k;
	if (MMpush(m,MMget(m,1))) return MERRMEM;
    if (k=TPsolvenode(m)) return k;
  //$BB put error message into z manlyz structure buffer
  sprintf(z->mess,">>> ERROR - Type mismatch (detail):\nFound:    %s\nExpected: %s\n<<<\n",
	//MMechostr(MSKRUNTIME,">>> ERROR - Type mismatch (detail):\nFound:    %s\nExpected: %s\n<<<\n",
		MMstart(m,MMget(m,0)>>1),MMstart(m,MMget(m,1)>>1));
	return l;
}

/* resolution du type d'un noeud
  0:noeud
->0:chaine type
*/
int TPnum;
char TPres[1024];
int TPind;

int TPsolve2(mmachine m,int ind,int prof)
{
  int s,n,k,i;
  char *a;
  char buf[MAXSIZETOKEN+1];

  s=m->top[m->pp]=TPtrouver(m,m->top[m->pp]);
  if (s==NIL)
    {
      sprintf(&TPres[TPind],"u%x",TPnum++);
      TPind+=strlen(&TPres[TPind]);
      MMpull(m);
      return 0;
    }
  for(i=1;i<=prof;i++)
    if (s==m->top[m->pp+i])
      {
        sprintf(&TPres[TPind],"r%x",i);
        TPind+=strlen(&TPres[TPind]);
        MMpull(m);
        return 0;
      }
  s>>=1;
  a=(char*)&m->tape[(m->tape[s+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  if ((a[0]=='#')&&(TPismaj(a[1])))
    {
      sprintf(&TPres[TPind],&a[1]);
      TPind+=strlen(&TPres[TPind]);
      MMpull(m);
      return 0;
    }
  else if (!strcmp(a,"#tup"))
    {
      sprintf(&TPres[TPind],"[");
      TPind+=strlen(&TPres[TPind]);
      n=(m->tape[s]>>1)-SIZETYP; 
      for(i=0;i<n;i++)
        {
          if (MMpush(m,m->tape[s+SizeHeader+SIZETYP+i])) return MERRTYP;
          if (k=TPsolve2(m,ind,prof+1)) return k;
          s=m->top[m->pp]>>1;
          if (i!=n-1)
            {
              sprintf(&TPres[TPind]," ");
              TPind+=strlen(&TPres[TPind]);
            }
        }
      sprintf(&TPres[TPind],"]");
      TPind+=strlen(&TPres[TPind]);
      MMpull(m);
      return 0;
    }
  else if (!strcmp(a,"#fun"))
    {
      sprintf(&TPres[TPind],"fun ");
      TPind+=strlen(&TPres[TPind]);
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP])) return MERRTYP;
      if (k=TPsolve2(m,ind,prof+1)) return k;
      sprintf(&TPres[TPind]," ");
      TPind+=strlen(&TPres[TPind]);
      s=m->top[m->pp]>>1;
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP+1])) return MERRTYP;
      if (k=TPsolve2(m,ind,prof+1)) return k;
      MMpull(m);
      return 0;
    }
  else if (!strcmp(a,"#tab"))
    {
      sprintf(&TPres[TPind],"tab ");
      TPind+=strlen(&TPres[TPind]);
      if (MMpush(m,m->tape[s+SizeHeader+SIZETYP])) return MERRTYP;
      if (k=TPsolve2(m,ind,prof+1)) return k;
      MMpull(m);
      return 0;
    }
  i=Msearchlabel(m,m->top[ind],a);
  if (i==-1)
    {
      strcpy(buf,a);
      if (k=Maddlabel(m,ind,buf,TPnum)) return k;
      i=TPnum++;
    }
  sprintf(&TPres[TPind],"u%x",i);
  TPind+=strlen(&TPres[TPind]);
  MMpull(m);
  return 0;
}

int TPsolvenode(mmachine m)
{
  int ind,k;

  ind=m->pp;
  if (MMpush(m,NIL)) return MERRMEM;
  m->top[m->pp]=m->top[m->pp+1];
  m->top[m->pp+1]=NIL;
  TPnum=0;
  TPind=0;
  TPres[0]=0;

  if (k=TPsolve2(m,ind,0)) return k;
  TPres[TPind]=0;
  MMpull(m);
  return Mpushstring(m,TPres);
}
 
/* retourne le nombre d'arguments d'une fonction
  -1 si ce n'est pas une fonction */
int TPnbarg(mmachine m,int node)
{
  char *a;

  if (node==NIL) return -1;
  node>>=1;
  a=(char*)&m->tape[(m->tape[node+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  if (strcmp(a,"#fun")) return -1;
  node=m->tape[node+SizeHeader+SIZETYP];
  node>>=1;
  if (node==NIL) return -1;
  a=(char*)&m->tape[(m->tape[node+SizeHeader+OFFTNAM]>>1)+SizeHeader];
  if (strcmp(a,"#tup")) return -1;
  return (m->tape[node]>>1)-SIZETYP;
}

/* unification d'une fonction
   0:tuple d'arguments 1:node function
 ->0:node resultat
*/
int TPunionfun(mmachine m, manlyz z)
{
  int s,t,f,k;

  s=MMpull(m);
  f=m->top[m->pp]>>1;
  t=m->tape[f+SizeHeader+SIZETYP];
  if (k=TPunif(m,z,s,t)) return k;
  f=m->top[m->pp]>>1;
  m->top[m->pp]=m->tape[f+SizeHeader+SIZETYP+1];
  return 0;
}

/* verification de fonction : les inconnues du resultat doivent etre
   dans les parametres 
  0: chaine de type
->0: chaine de type*/
int TPcheckfun(mmachine m)
{
  int k;

  if (MMpush(m,m->top[m->pp])) return MERRMEM;
  if (k=TPtypgraph(m)) return k;
  MMpull(m);
  return 0;
}