/*     
      TYPE CHECKING of MAGMA . Magma 1.0 . 1996 . Sylvain HUET

         typmag2.cpp : module de type checking de magma (2e partie)
*/
// Modification history:
//$ FA(03/05/2001): Promoted to C++ file
//$ FA(03/05/2001): Use new lexer interface (lexer.h)

#include <stdio.h>
#include <string.h>
#include "loadpak.h"
#include "lexer.h"
extern "C" {
#include "mmemory.h"
#include "mbytec.h"
#include "mbytec2.h"
#include "listlab.h"
#include "typmisc.h"
}

int TCreadlab(mmachine m, manlyz z, int ind);
int TCreada(mmachine m,manlyz z,int ind);
int TCreadp(mmachine m,manlyz z,int ind);

/* lecture d'une Expression [L'] (le premier crochet a ete lu) */
int TCreadtab(mmachine m,manlyz z,int ind)
{
  int k,n,q;

  if (MMpush(m,NIL)) return MERRMEM;
  if (Mpushstring(m,"#tup")) return MERRMEM;
  n=0;
  q=1;
  while(q)
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"missing element");
          return MERRTYP;
        }
      if (z->tok[0]==']') q=0;
      else
        {
          if (k=TCreada(m,z,ind)) return k;
          n++;
        }
    }
  if (MMpush(m,(n+SIZETYP)*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  return 0;
}

/* empilement d'une fonction */
int TCpushfun(mmachine m,manlyz z,int ind)
{
  int i,k,n;

  if (Mreadtok(z)) return MERRTYP;
  i=Msearchvar(m,m->top[ind+PKGVAR],z->tok);
  if (i==NIL)
    i=Msearchinpak(m,m->top[ind+PKGLP],z->tok);
  if (i==NIL)
    {
      sprintf(z->mess,"'%s' unknown\n",z->tok);
      return MERRLINK;    /* linkage impossible */
    }
  n=m->tape[i+SizeHeader+OFFVTYP]>>1;
  if (n==-1)
    {
      sprintf(z->mess,"'%s' not a function\n",z->tok);
      return MERRLINK;    /* linkage impossible */
    }
  if (MMpush(m,m->tape[i+SizeHeader+OFFVSTYP])) return MERRMEM;
  if (k=TPtypgraph(m)) return k;
  return 0;
}

/* lecture d'une Expression T */
int TCreadt(mmachine m,manlyz z,int ind)
{
  int k;

//$ FA(04/05/2001): Accept floating-point literals
  if (z->lex.current().kind() == Token::kInt) {  // use new Lexer methods to detect literals
    if (MMpush(m,NIL)) return MERRMEM;
    if (Mpushstring(m,"#I")) return MERRMEM;
    if (MMpush(m,SIZETYP*2)) return MERRMEM;
    if (k=MBdeftab(m)) return k;
    return 0;
  }
  if (z->lex.current().kind() == Token::kFloat) {
    if (MMpush(m,NIL)) return MERRMEM;
    if (Mpushstring(m,"#F")) return MERRMEM;
    if (MMpush(m,SIZETYP*2)) return MERRMEM;
    if (k=MBdeftab(m)) return k;
    return 0;
  }
//
  if (z->tok[0]=='\'')
    {
      //if (Mreadtok(z)) return MERRTYP;
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#I")) return MERRMEM;
      if (MMpush(m,SIZETYP*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      return 0;
    }
  if (!strcmp(z->tok,"nil"))
    {
      if (k=TPnil(m)) return k;
      return 0;
    }
  if (z->tok[0]=='\"')
    {
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#S")) return MERRMEM;
      if (MMpush(m,SIZETYP*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      return 0;
    }
  if (z->tok[0]=='(')
    {
      if (k=TCreadp(m,z,ind)) return k;
      if ((Mreadtok(z))||(z->tok[0]!=')'))
        {
          sprintf(z->mess,") expected");
          return MERRTYP;
        }
      return 0;
    }
  if (z->tok[0]=='{')
    {
      if (k=TCreadp(m,z,ind)) return k;
      if ((Mreadtok(z))||(z->tok[0]!='}'))
        {
          sprintf(z->mess,"} expected");
          return MERRTYP;
        }
      return 0;
    }
  if (z->tok[0]=='[') return TCreadtab(m,z,ind);
  if (z->tok[0]=='@') return TCpushfun(m,z,ind);

  if (z->lex.current().is(Token::kIdent)) return TCreadlab(m,z,ind);

  sprintf(z->mess,"term expected");
  return MERRTYP;
}

/* lecture d'une Expression A6 */
int TCreada6(mmachine m,manlyz z,int ind)
{
  int k;

  if ((!strcmp(z->tok,"-"))||(!strcmp(z->tok,"-."))||(!strcmp(z->tok,"~")))
    {
      if (!strcmp(z->tok,"-."))
        {
          if (Mpushstring(m,"fun [F] F")) return MERRMEM;
        }
      else if (Mpushstring(m,"fun [I] I")) return MERRMEM;
      if (Mreadtok(z))
        {
          sprintf(z->mess,"missing element");
          return MERRTYP;
        }
      if (k=TPtypgraph(m)) return k;
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;

      if (k=TCreada6(m,z,ind)) return k;
      if (MMpush(m,(1+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (k=TPunionfun(m)) return k;
      return 0;
    }
  return TCreadt(m,z,ind);
}

/* lecture d'une Expression A5 */
int TCreada5(mmachine m,manlyz z,int ind)
{
  int k;

  if (k=TCreada6(m,z,ind)) return k;
  while(1)
    {
      if (Mreadtok(z)) return 0;
      if ((strcmp(z->tok,"&"))&&(strcmp(z->tok,"|"))
          &&(strcmp(z->tok,"^"))
          &&(strcmp(z->tok,">>"))&&(strcmp(z->tok,"<<")))
        {
          z->giveback=1;
          return 0;
        }
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;
      if (MMpush(m,m->top[m->pp+2])) return MERRMEM;
      if (Mreadtok(z))
        {
          sprintf(z->mess,"expression expected");
          return MERRTYP;
        }
      if (k=TCreada6(m,z,ind)) return k;
      if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (Mpushstring(m,"fun [I I] I")) return MERRMEM;
      if (k=TPtypgraph(m)) return k;
      m->top[m->pp+2]=m->top[m->pp];
      m->pp++;
      if (k=TPunionfun(m)) return k;
    }
}

/* lecture d'une Expression A4 */
int TCreada4(mmachine m,manlyz z,int ind)
{
  int k,i;

  if (k=TCreada5(m,z,ind)) return k;
  while(1)
    {
      if (Mreadtok(z)) return 0;
      if ((!strcmp(z->tok,"*"))||(!strcmp(z->tok,"/")))
        i=1;
      else if ((!strcmp(z->tok,"*."))||(!strcmp(z->tok,"/.")))
        i=0;
      else
        {
          z->giveback=1;
          return 0;
        }
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;
      if (MMpush(m,m->top[m->pp+2])) return MERRMEM;
      if (Mreadtok(z))
        {
          sprintf(z->mess,"expression expected");
          return MERRTYP;
        }
      if (k=TCreada5(m,z,ind)) return k;
      if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (i)
        {
          if (Mpushstring(m,"fun [I I] I")) return MERRMEM;
        }
      else
        if (Mpushstring(m,"fun [F F] F")) return MERRMEM;
      if (k=TPtypgraph(m)) return k;
      m->top[m->pp+2]=m->top[m->pp];
      m->pp++;
      if (k=TPunionfun(m)) return k;
    }
}

/* lecture d'une Expression A3 */
int TCreada3(mmachine m,manlyz z,int ind)
{
  int k,i;

  if (k=TCreada4(m,z,ind)) return k;
  while(1)
    {
      if (Mreadtok(z)) return 0;
      if ((!strcmp(z->tok,"+"))||(!strcmp(z->tok,"-")))
        i=1;
      else if ((!strcmp(z->tok,"+."))||(!strcmp(z->tok,"-.")))
        i=0;
      else
        {
          z->giveback=1;
          return 0;
        }
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;
      if (MMpush(m,m->top[m->pp+2])) return MERRMEM;
      if (Mreadtok(z))
        {
          sprintf(z->mess,"expression expected");
          return MERRTYP;
        }
      if (k=TCreada4(m,z,ind)) return k;
      if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (i)
        {
          if (Mpushstring(m,"fun [I I] I")) return MERRMEM;
        }
      else
        if (Mpushstring(m,"fun [F F] F")) return MERRMEM;
      if (k=TPtypgraph(m)) return k;
      m->top[m->pp+2]=m->top[m->pp];
      m->pp++;
      if (k=TPunionfun(m)) return k;
    }
}

/* lecture d'une Expression A2 */
int TCreada2(mmachine m,manlyz z,int ind)
{
  int i,k;

  if (k=TCreada3(m,z,ind)) return k;
  while(1)
    {
      if (Mreadtok(z)) return 0;
      if ((!strcmp(z->tok,"=="))||(!strcmp(z->tok,"!="))) i=0;
      else if ((!strcmp(z->tok,"<"))||(!strcmp(z->tok,">"))
               ||(!strcmp(z->tok,"<="))||(!strcmp(z->tok,">="))) i=1;
      else if ((!strcmp(z->tok,"=."))||(!strcmp(z->tok,"!=."))||
               (!strcmp(z->tok,"<."))||(!strcmp(z->tok,">."))||
               (!strcmp(z->tok,"<=."))||(!strcmp(z->tok,">=."))) i=2;
      else
        {
          z->giveback=1;
          return 0;
        }
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;
      if (MMpush(m,m->top[m->pp+2])) return MERRMEM;
      if (Mreadtok(z))
        {
          sprintf(z->mess,"expression expected");
          return MERRTYP;
        }
      if (k=TCreada3(m,z,ind)) return k;
      if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (i==1)
        {
          if (Mpushstring(m,"fun [I I] I")) return MERRMEM;
        }
      else if (i==0)
        {
          if (Mpushstring(m,"fun [u0 u0] I")) return MERRMEM;
        }
      else
        {
          if (Mpushstring(m,"fun [F F] I")) return MERRMEM;
        }
       if (k=TPtypgraph(m)) return k;
      m->top[m->pp+2]=m->top[m->pp];
      m->pp++;
      if (k=TPunionfun(m)) return k;
    }
}

/* lecture d'une Expression A1 */
int TCreada1(mmachine m,manlyz z,int ind)
{
  int k;

  if (!strcmp(z->tok,"!"))
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"missing element");
          return MERRTYP;
        }
      if (Mpushstring(m,"fun [I] I")) return MERRMEM;
      if (k=TPtypgraph(m)) return k;
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;

      if (k=TCreada1(m,z,ind)) return k;
      if (MMpush(m,(1+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (k=TPunionfun(m)) return k;
      return 0;
    }
  return TCreada2(m,z,ind);
}

/* lecture d'une Expression A' */
int TCreadap(mmachine m,manlyz z,int ind)
{
  int k;

  if (k=TCreada1(m,z,ind)) return k;
  while(1)
    {
      if (Mreadtok(z)) return 0;
      if ((strcmp(z->tok,"&&"))&&(strcmp(z->tok,"||")))
        {
          z->giveback=1;
          return 0;
        }
      if (MMpush(m,NIL)) return MERRMEM;
      if (Mpushstring(m,"#tup")) return MERRMEM;
      if (MMpush(m,m->top[m->pp+2])) return MERRMEM;
      if (Mreadtok(z))
        {
          sprintf(z->mess,"expression expected");
          return MERRTYP;
        }
      if (k=TCreada1(m,z,ind)) return k;
      if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (Mpushstring(m,"fun [I I] I")) return MERRMEM;
      if (k=TPtypgraph(m)) return k;
      m->top[m->pp+2]=m->top[m->pp];
      m->pp++;
      if (k=TPunionfun(m)) return k;
    }
}

/* lecture d'une Expression A */
int TCreada(mmachine m,manlyz z,int ind)
{
  int k;

  if (k=TCreadap(m,z,ind)) return k;
  
  if (Mreadtok(z)) return 0;
  if (strcmp(z->tok,"::"))
    {
      z->giveback=1;
      return 0;
    }
  if (MMpush(m,NIL)) return MERRMEM;
  if (Mpushstring(m,"#tup")) return MERRMEM;
  if (MMpush(m,m->top[m->pp+2])) return MERRMEM;
  if (Mreadtok(z))
    {
       sprintf(z->mess,"expression expected");
       return MERRTYP;
    }
  if (k=TCreada(m,z,ind)) return k;
  if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  if (Mpushstring(m,"fun [u0 [u0 r1]] [u0 r1]")) return MERRMEM;
  if (k=TPtypgraph(m)) return k;
  m->top[m->pp+2]=m->top[m->pp];
  m->pp++;
  if (k=TPunionfun(m)) return k;
  return 0;
}


/* lecture d'une Expression P  */
int TCreadp(mmachine m,manlyz z,int ind)
{
  int k;

  if (Mreadtok(z)) return MERRTYP;
  while(1)
    {
      if (k=TCreada(m,z,ind)) return k;

      if (Mreadtok(z)) return 0;
      if (strcmp(z->tok,";"))
        {
          z->giveback=1;
          return 0;
        }
      if (Mreadtok(z)) return MERRTYP;
      if ( (!strcmp(z->tok,")"))||(!strcmp(z->tok,"}")) )
        {
          z->giveback=1;
          return 0;
        }
      m->pp++; 
    }
}