femlexical.cpp

FreeFEM is an implementation of the GFEM language dedicated to the finite element method. It provid

// Emacs will be in -*- Mode: c++ -*-
//
// ********** DO NOT REMOVE THIS BANNER **********
//
// SUMMARY: Language for a Finite Element Method
//
// AUTHORS:  C. Prud'homme
// ORG    :          
// E-MAIL :  [e-mail]
//
// ORIG-DATE:     June-94
// LAST-MOD: 17-Oct-01 at 16:26:38 by Christophe Prud'homme
//
// DESCRIPTION:  
/*
  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.
  
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

*/
// DESCRIP-END.
//

#include <cstdlib>
#include <cstdio>
#include <ctype.h>
#include <cstring>
#include <cmath>

#include <femGraphic.hpp>
#include <femMesh.hpp> 
#include <femMisc.hpp> 
#include <femLexical.hpp> 

#define MAXIDLENGTH 40

namespace fem
{
ident           idents[MAXIDENTS];
ident          *curident;
int             numligne = 1;
drapeaux        flag;
int             numidents = 0;
float           curcst;
Symbol          cursym = error;
char            curchaine[100];
char           *thestring = NULL, *curchar = NULL;
programme      *curprog;

char*           safedup (const char *s);
ident*          ajoute (const char *s, int pos);
ident*          lisident (char **s);
int             lisreel (char **s, float *x);
void            installe (char *funcname, Symbol s);
				
long 
wherearewe ()
{
  return curchar - thestring;
}

char *
safedup (const char *s)
{
  char *newstring;

  newstring = new char[strlen(s)+1];
  strcpy (newstring, s);
  return newstring;
}


ident*          
lisident (char **s)
{
  char            buffer[MAXIDLENGTH];
  int             r, nb = 0;

  for (nb = 0; (nb < MAXIDLENGTH) && isalnum (**s); nb++)
    buffer[nb] = *(*s)++;
  if (nb == MAXIDLENGTH)
     {
       fprintf (stderr, "Identificateur trop long!\n");
       return NULL;
     }
  buffer[nb] = 0;
  for (r = 0; r < numidents; r++)
    if (strcmp (idents[r].name, buffer) == 0)
       {
	 if (idents[r].symb == newvar)
	   idents[r].symb = oldvar;
	 return idents + r;
       }
  if (numidents == MAXIDENTS)
     {
       fprintf (stderr, "Too many different identifiers");
       return NULL;
     }
  idents[numidents].name = safedup (buffer);
  idents[numidents].symb = newvar;
  idents[numidents].table = NULL;
  return idents + numidents++;
}


ident * 
ajoute (const char *s, int pos)
{
  int             i;
  char           *newident = NULL;

  if (numidents == MAXIDENTS)
     {
       erreur ("Too many variables: out of memory");
       return NULL;
     }
  newident = safedup (s);
  strcpy (newident, s);
  for (i = numidents++; i > pos; i--)
  {  idents[i].name = idents[i - 1].name;
    idents[i].value = idents[i - 1].value;
    idents[i].symb = idents[i - 1].symb;
    idents[i].table = idents[i - 1].table;
    /// was idents[i] = idents[i - 1];
  }
  idents[pos].name = newident;
  idents[pos].symb = newvar;
  return idents + pos ;
}

int 
lisreel (char **s, float *x)
{
#define stop -1
#define erreur -2

  float           mantisse = 0.F;
  float           inc = 0.1F;
  int             etat = 0;
  int             signe = 1;
  int             signexpo = 1;
  int             expo = 0;
  char            c, *t = *s;

  while (etat >= 0)
    {
      c = *t++;
      switch (etat)
	{
	case 0:
	  if (isdigit (c))
	    {
	      etat = 1;
	      mantisse = (float)(c - '0');
	    }
	  else
	    switch (c)
	      {
	      case '.':
		etat = 2;
		break;
	      case '-':
		signe = -1;
	      case '+':
		etat = 3;
		break;
	      default:
		etat = erreur;
	      }
	  break;

	case 1:
	  if (isdigit (c))
	    mantisse = 10 * mantisse + c - '0';
	  else
	    switch (c)
	      {
	      case '.':
		etat = 4;
		break;
	      case 'e':
	      case 'E':
		etat = 5;
		break;
	      default:
		etat = stop;
	      }
	  break;

	case 2:
	  if (isdigit (c))
	    {
	      etat = 4;
	      mantisse = (c - '0') * inc;
	      inc /= 10;
	    }
	  else
	    etat = erreur;
	  break;

	case 3:
	  if (isdigit (c))
	    {
	      etat = 1;
	      mantisse = (float)(c - '0');
	    }
	  else
	    etat = (c == '.') ? 2 : erreur;
	  break;

	case 4:
	  if (isdigit (c))
	    {
	      mantisse += (c - '0') * inc;
	      inc /= 10;
	    }
	  else
	    etat = ((c == 'e') || (c == 'E')) ? 5 : stop;
	  break;

	case 5:
	  if (isdigit (c))
	    {
	      etat = 7;
	      expo = c - '0';
	    }
	  else
	    switch (c)
	      {
	      case '-':
		signexpo = -1;
	      case '+':
		etat = 6;
		break;
	      default:
		etat = erreur;
	      }
	  break;

	case 6:
	  if (isdigit (c))
	    {
	      etat = 7;
	      expo = c - '0';
	    }
	  else
	    etat = erreur;
	  break;

	case 7:
	  if (isdigit (c))
	    expo = 10 * expo + c - '0';
	  else
	    etat = stop;
	}
    }
  *s = t - 1;
  *x = signe * mantisse * ::pow (10., (double) signexpo * expo);
  return etat == stop;
}

void 
nextsym (void)
{
  int             i;

  while (isspace (*curchar))
     {
       if ((*curchar == '\n') || (*curchar == '\r'))
	 numligne++;
       curchar++;
     }
  switch (*curchar++)
     {
     case ':':
       if (*curchar == '=')
	  {
	    cursym = becomes;
	    curchar++;
	  }
       else
	 cursym = colon;
       break;

     case '{':
       cursym = lbrace;
       break;

     case '}':
       cursym = rbrace;
       break;

     case '(':
       cursym = lpar;
       break;

     case ')':
       cursym = rpar;
       break;

     case '[':
       cursym = bracketl;
       break;

     case ']':
       cursym = bracketr;
       break;

     case ',':
       cursym = comma;
       break;

     case ';':
       cursym = semicolon;
       break;

     case '+':
       cursym = op_plus;
       break;

     case '-':
       cursym = op_minus;
       break;

     case '*':
       cursym = star;
       break;

     case '/':
       if (*curchar++ == '*')
	  {
	    while (*curchar != '*' || *(curchar + 1) != '/')
	       {
		 if (*curchar == '\n')
		   numligne++;
		 curchar++;
	       }
	    curchar += 2;
	    nextsym ();
	    return;
	  }
       curchar--;
       cursym = slash;
       break;

     case '%':
       cursym = modulo;
       break;
       
     case '^':
       cursym = expo;
       break;

     case '\'':
       i = 0;
       while (*curchar != '\'' && *curchar != '\0')
	  {
	    curchaine[i++] = *curchar;
	    curchar++;
	  }
       if (*curchar == '\0')
	 cursym = error;
       else
	 cursym = chaine;
       curchaine[i] = '\0';
       curchar++;
       break;

     case '<':
       if (*curchar == '=')
	  {
	    curchar++;
	    cursym = le;
	  }
       else
	 cursym = lt;
       break;

     case '>':
       if (*curchar == '=')
	  {
	    curchar++;
	    cursym = ge;
	  }
       else
	 cursym = gt;
       break;

     case '=':
       if (*curchar == '=')
	  {
	    curchar++;
	    cursym = eq;
	  }
       else
	 cursym = fctdef;
       break;

     default:
       curchar--;
       if (isdigit (*curchar) || (*curchar == '.'))
	 if (lisreel (&curchar, &curcst))
	   cursym = cste;
	 else
	   cursym = error;
       else if (isalpha (*curchar))
	 if ((curident = lisident (&curchar)) != NULL)
	   cursym = curident->symb;
	 else
	   cursym = error;
       else
	 cursym = *curchar ? error : _end;
     }
}

void 
installe (char *funcname, Symbol s)
{
  lisident (&funcname)->symb = s;
}


void 
initlex (const char *s)
{
  flag.bdy = 1;
  flag.build = 0;
  flag.onbdy = 0;
  flag.solv = 0;
  flag.fct = 0;
  flag.eq = 0;
  flag.param = 0;
  flag.complexe = 0;
  flag.precise = 0;
  flag.t = 0;
  flag.fem = 0;
  numligne = 1;
  numidents = 0;
  cursym = error;
  thestring = safedup (s);
  curchar = thestring;
  curprog = NULL;
/*  strcpy(thestring, s); */
  installe ("one", one);
  installe ("wait", wait_state);
  installe ("nowait", nowait);
  installe ("nographics", nographics);
  installe ("sin", sine);
  installe ("cos", cosine);
  installe ("atan", atane);
  installe ("exp", exponential);
  installe ("log", logarithm);
  installe ("abs", absolute);
  installe ("sqrt", root);
  installe ("acos", acose);
  installe ("asin", asine);
  installe ("tan", tane);
  installe ("cosh", coshe);
  installe ("sinh", sinhe);
  installe ("tanh", tanhe);
  installe ("min", mini);
  installe ("max", maxi);
  installe ("dx", partial_x);
  installe ("dy", partial_y);
  installe ("and", et);
  installe ("or", ou);
  installe ("if", si);
  installe ("then", alors);
  installe ("else", autrement);
  installe ("iter", loop);
  installe ("border", symb_bdy);
  installe ("buildmesh", symb_build);
  installe ("solve", symb_solv);
  installe ("laplace", symb_lapl);
  installe ("id", symb_id);
  installe ("div", symb_div);
  installe ("onbdy", symb_dch);
  installe ("dnu", symb_frr);
  installe ("plot3d", trace3d);
  installe ("plot", trace);
  installe ("changewait", changewait);
  installe ("load", charge);
  installe ("save", sauve);
  installe ("saveall", sauvetout);
  installe ("loadmesh", chargmsh);
  installe ("savemesh", sauvmsh);
  installe ("x", oldvar);
  installe ("y", oldvar);
  installe ("t", oldvar);
  installe ("ib", oldvar);
  installe ("iv", oldvar);
  installe ("nexist", oldvar);
  installe ("I", oldvar);
  installe ("nx", oldvar);
  installe ("ny", oldvar);
  installe ("pi", oldvar);
  installe ("begin", lbrace);
  installe ("end", rbrace);
  installe ("halt", arret);
  installe ("include", fctfile);
  installe ("convect", symb_convect);
  installe ("region", oldvar);
  installe ("exec", symb_exec);
  installe ("user", symb_user);
  installe ("Re", partreal);
  installe ("Im", partimag);
  installe ("rhsconvect", rhsconvect);
  installe ("pde", symb_pde);
  installe ("dxx", d_xx);
  installe ("dyy", d_yy);
  installe ("dxy", d_xy);
  installe ("dyx", d_yx);
  installe ("complex", symb_complex);
  installe ("precise", symb_precise);
  installe ("scal", prodscal);
  installe ("adaptmesh", adaptmesh);
  installe ("polygon", polygon);
  installe ("intt", gint);
  installe ("int", bint);
  installe ("varsolve", varsolve);
  installe ("penal", penall);
  nextsym ();
}
}