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

         typmagv.c : type checking des variables
*/
// Modification history:
//$ FA(03/05/2001): Promote to C++ file
//$ FA(03/05/2001): Use new lexer interface (lexer.h)
//$ FA(04/05/2001): Accept floating-point literals
//$ FA(06/06/2001): Includes baselib.h
//$ FA(17/07/2001): Use lexer utility function a2i() as a replacement of Mgetnum()
//

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

#include "loadpak.h"
#include "lexer.h"
extern "C" {
#include "mmemory.h"
#include "mbytec.h"
#include "baselib.h"
#include "listlab.h"
#include "typmisc.h"
}

int TCreadvt(mmachine m,manlyz z,int ind);

/* lecture d'une Expression Variable [L'] (le premier crochet a ete lu) */
int TCreadvtab(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=TCreadvt(m,z,ind)) return k;
          n++;
        }
    }
  if (MMpush(m,(n+SIZETYP)*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  return 0;
}

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

//$ FA(04/05/2001): Accept floating-point literals
  if (z->lex.current().kind() == Token::kInt) {
    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 MERROK;
  }
  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 MERROK;
  }
//
  if (!strcmp(z->tok,"-"))
    {
      if (Mreadtok(z)) return MERRTYP;
      int i;
      if (!a2i(z->tok, &i))  //$ FA(17/07/2001)
        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;
    }
//$ FA(04/05/2001): Accept negative floating-point literals
  if (!strcmp(z->tok, "-.")) {
    if (Mreadtok(z) || z->lex.current().kind() != Token::kFloat)
      return MERRTYP;
	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 MERROK;
  }
//
  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]=='[') return TCreadvtab(m,z,ind);
  if (z->tok[0]=='(')
    {
      if (Mreadtok(z)) return 0;
      if (k=TCreadvt(m,z,ind)) return k;
      if ((Mreadtok(z))||(z->tok[0]!=')'))
        {
          sprintf(z->mess,") expected");
          return MERRTYP;
        }
      return 0;
    }

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

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

  if (k=TCreadv2(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=TCreadvt(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;
}