path: root/gcc/f/stt.c

/* stt.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
   Contributed by James Craig Burley.

This file is part of GNU Fortran.

GNU Fortran 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, or (at your option)
any later version.

GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.

   Related Modules:
      None

   Description:
      Manages lists of tokens and related info for parsing.

   Modifications:
*/

/* Include files. */

#include "proj.h"
#include "stt.h"
#include "bld.h"
#include "expr.h"
#include "info.h"
#include "lex.h"
#include "malloc.h"
#include "sta.h"
#include "stp.h"

/* Externals defined here. */


/* Simple definitions and enumerations. */


/* Internal typedefs. */


/* Private include files. */


/* Internal structure definitions. */


/* Static objects accessed by functions in this module. */


/* Static functions (internal). */


/* Internal macros. */


/* ffestt_caselist_append -- Append case to list of cases

   ffesttCaseList list;
   ffelexToken t;
   ffestt_caselist_append(list,range,case1,case2,t);

   list must have already been created by ffestt_caselist_create.  The
   list is allocated out of the scratch pool.  The token is consumed.  */

void
ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
			ffebld case2, ffelexToken t)
{
  ffesttCaseList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST case list", sizeof (*new));
  new->next = list->previous->next;
  new->previous = list->previous;
  new->next->previous = new;
  new->previous->next = new;
  new->expr1 = case1;
  new->expr2 = case2;
  new->range = range;
  new->t = t;
}

/* ffestt_caselist_create -- Create new list of cases

   ffesttCaseList list;
   list = ffestt_caselist_create();

   The list is allocated out of the scratch pool.  */

ffesttCaseList
ffestt_caselist_create (void)
{
  ffesttCaseList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST case list root",
		       sizeof (*new));
  new->next = new->previous = new;
  new->t = NULL;
  new->expr1 = NULL;
  new->expr2 = NULL;
  new->range = FALSE;
  return new;
}

/* ffestt_caselist_kill -- Kill list of cases

   ffesttCaseList list;
   ffestt_caselist_kill(list);

   The tokens on the list are killed.

   02-Mar-90  JCB  1.1
      Don't kill the list itself or change it, since it will be trashed when
      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */

void
ffestt_caselist_kill (ffesttCaseList list)
{
  ffesttCaseList next;

  for (next = list->next; next != list; next = next->next)
    {
      ffelex_token_kill (next->t);
    }
}

/* ffestt_dimlist_append -- Append dim to list of dims

   ffesttDimList list;
   ffelexToken t;
   ffestt_dimlist_append(list,lower,upper,t);

   list must have already been created by ffestt_dimlist_create.  The
   list is allocated out of the scratch pool.  The token is consumed.  */

void
ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
		       ffelexToken t)
{
  ffesttDimList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST dim list", sizeof (*new));
  new->next = list->previous->next;
  new->previous = list->previous;
  new->next->previous = new;
  new->previous->next = new;
  new->lower = lower;
  new->upper = upper;
  new->t = t;
}

/* Convert list of dims into ffebld format.

   ffesttDimList list;
   ffeinfoRank rank;
   ffebld array_size;
   ffebld extents;
   ffestt_dimlist_as_expr (list, &rank, &array_size, &extents);

   The dims in the list are converted to a list of ITEMs; the rank of the
   array, an expression representing the array size, a list of extent
   expressions, and the list of ITEMs are returned.

   If is_ugly_assumed, treat a final dimension with no lower bound
   and an upper bound of 1 as a * bound.  */

ffebld
ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
			ffebld *array_size, ffebld *extents,
			bool is_ugly_assumed)
{
  ffesttDimList next;
  ffebld expr;
  ffebld as;
  ffebld ex;			/* List of extents. */
  ffebld ext;			/* Extent of a given dimension. */
  ffebldListBottom bottom;
  ffeinfoRank r;
  ffeinfoKindtype nkt;
  ffetargetIntegerDefault low;
  ffetargetIntegerDefault high;
  bool zero = FALSE;		/* Zero-size array. */
  bool any = FALSE;
  bool star = FALSE;		/* Adjustable array. */

  assert (list != NULL);

  r = 0;
  ffebld_init_list (&expr, &bottom);
  for (next = list->next; next != list; next = next->next)
    {
      ++r;
      if (((next->lower == NULL)
	   || (ffebld_op (next->lower) == FFEBLD_opCONTER))
	  && (ffebld_op (next->upper) == FFEBLD_opCONTER))
	{
	  if (next->lower == NULL)
	    low = 1;
	  else
	    low = ffebld_constant_integerdefault (ffebld_conter (next->lower));
	  high = ffebld_constant_integerdefault (ffebld_conter (next->upper));
	  if (low
	      > high)
	    zero = TRUE;
	  if ((next->next == list)
	      && is_ugly_assumed
	      && (next->lower == NULL)
	      && (high == 1)
	      && (ffebld_conter_orig (next->upper) == NULL))
	    {
	      star = TRUE;
	      ffebld_append_item (&bottom,
				  ffebld_new_bounds (NULL, ffebld_new_star ()));
	      continue;
	    }
	}
      else if (((next->lower != NULL)
		&& (ffebld_op (next->lower) == FFEBLD_opANY))
	       || (ffebld_op (next->upper) == FFEBLD_opANY))
	any = TRUE;
      else if (ffebld_op (next->upper) == FFEBLD_opSTAR)
	star = TRUE;
      ffebld_append_item (&bottom,
			  ffebld_new_bounds (next->lower, next->upper));
    }
  ffebld_end_list (&bottom);

  if (zero)
    {
      as = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
      ffebld_set_info (as, ffeinfo_new
		       (FFEINFO_basictypeINTEGER,
			FFEINFO_kindtypeINTEGERDEFAULT,
			0,
			FFEINFO_kindENTITY,
			FFEINFO_whereCONSTANT,
			FFETARGET_charactersizeNONE));
      ex = NULL;
    }
  else if (any)
    {
      as = ffebld_new_any ();
      ffebld_set_info (as, ffeinfo_new_any ());
      ex = ffebld_copy (as);
    }
  else if (star)
    {
      as = ffebld_new_star ();
      ex = ffebld_new_star ();	/* ~~Should really be list as below. */
    }
  else
    {
      as = NULL;
      ffebld_init_list (&ex, &bottom);
      for (next = list->next; next != list; next = next->next)
	{
	  if ((next->lower == NULL)
	      || ((ffebld_op (next->lower) == FFEBLD_opCONTER)
		  && (ffebld_constant_integerdefault (ffebld_conter
						      (next->lower)) == 1)))
	    ext = ffebld_copy (next->upper);
	  else
	    {
	      ext = ffebld_new_subtract (next->upper, next->lower);
	      nkt
		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
					ffeinfo_kindtype (ffebld_info
							  (next->lower)),
					ffeinfo_kindtype (ffebld_info
							  (next->upper)));
	      ffebld_set_info (ext,
			       ffeinfo_new (FFEINFO_basictypeINTEGER,
					    nkt,
					    0,
					    FFEINFO_kindENTITY,
					    ((ffebld_op (ffebld_left (ext))
					      == FFEBLD_opCONTER)
					     && (ffebld_op (ffebld_right
							    (ext))
						 == FFEBLD_opCONTER))
					    ? FFEINFO_whereCONSTANT
					    : FFEINFO_whereFLEETING,
					    FFETARGET_charactersizeNONE));
	      ffebld_set_left (ext,
			       ffeexpr_convert_expr (ffebld_left (ext),
						     next->t, ext, next->t,
						     FFEEXPR_contextLET));
	      ffebld_set_right (ext,
				ffeexpr_convert_expr (ffebld_right (ext),
						      next->t, ext,
						      next->t,
						      FFEEXPR_contextLET));
	      ext = ffeexpr_collapse_subtract (ext, next->t);

	      nkt
		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
					ffeinfo_kindtype (ffebld_info (ext)),
					FFEINFO_kindtypeINTEGERDEFAULT);
	      ext
		= ffebld_new_add (ext,
				  ffebld_new_conter
				  (ffebld_constant_new_integerdefault_val
				   (1)));
	      ffebld_set_info (ffebld_right (ext), ffeinfo_new
			       (FFEINFO_basictypeINTEGER,
				FFEINFO_kindtypeINTEGERDEFAULT,
				0,
				FFEINFO_kindENTITY,
				FFEINFO_whereCONSTANT,
				FFETARGET_charactersizeNONE));
	      ffebld_set_info (ext,
			       ffeinfo_new (FFEINFO_basictypeINTEGER,
					    nkt, 0, FFEINFO_kindENTITY,
					    (ffebld_op (ffebld_left (ext))
					     == FFEBLD_opCONTER)
					    ? FFEINFO_whereCONSTANT
					    : FFEINFO_whereFLEETING,
					    FFETARGET_charactersizeNONE));
	      ffebld_set_left (ext,
			       ffeexpr_convert_expr (ffebld_left (ext),
						     next->t, ext,
						     next->t,
						     FFEEXPR_contextLET));
	      ffebld_set_right (ext,
				ffeexpr_convert_expr (ffebld_right (ext),
						      next->t, ext,
						      next->t,
						      FFEEXPR_contextLET));
	      ext = ffeexpr_collapse_add (ext, next->t);
	    }
	  ffebld_append_item (&bottom, ext);
	  if (as == NULL)
	    as = ext;
	  else
	    {
	      nkt
		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
					ffeinfo_kindtype (ffebld_info (as)),
				      ffeinfo_kindtype (ffebld_info (ext)));
	      as = ffebld_new_multiply (as, ext);
	      ffebld_set_info (as,
			       ffeinfo_new (FFEINFO_basictypeINTEGER,
					    nkt, 0, FFEINFO_kindENTITY,
					    ((ffebld_op (ffebld_left (as))
					      == FFEBLD_opCONTER)
					     && (ffebld_op (ffebld_right
							    (as))
						 == FFEBLD_opCONTER))
					    ? FFEINFO_whereCONSTANT
					    : FFEINFO_whereFLEETING,
					    FFETARGET_charactersizeNONE));
	      ffebld_set_left (as,
			       ffeexpr_convert_expr (ffebld_left (as),
						     next->t, as, next->t,
						     FFEEXPR_contextLET));
	      ffebld_set_right (as,
				ffeexpr_convert_expr (ffebld_right (as),
						      next->t, as,
						      next->t,
						      FFEEXPR_contextLET));
	      as = ffeexpr_collapse_multiply (as, next->t);
	    }
	}
      ffebld_end_list (&bottom);
      as = ffeexpr_convert (as, list->next->t, NULL,
			    FFEINFO_basictypeINTEGER,
			    FFEINFO_kindtypeINTEGERDEFAULT, 0,
			    FFETARGET_charactersizeNONE,
			    FFEEXPR_contextLET);
    }

  *rank = r;
  *array_size = as;
  *extents = ex;
  return expr;
}

/* ffestt_dimlist_create -- Create new list of dims

   ffesttDimList list;
   list = ffestt_dimlist_create();

   The list is allocated out of the scratch pool.  */

ffesttDimList
ffestt_dimlist_create (void)
{
  ffesttDimList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST dim list root",
		       sizeof (*new));
  new->next = new->previous = new;
  new->t = NULL;
  new->lower = NULL;
  new->upper = NULL;
  return new;
}

/* ffestt_dimlist_kill -- Kill list of dims

   ffesttDimList list;
   ffestt_dimlist_kill(list);

   The tokens on the list are killed.  */

void
ffestt_dimlist_kill (ffesttDimList list)
{
  ffesttDimList next;

  for (next = list->next; next != list; next = next->next)
    {
      ffelex_token_kill (next->t);
    }
}

/* Determine type of list of dimensions.

   Return KNOWN for all-constant bounds, ADJUSTABLE for constant
   and variable but no * bounds, ASSUMED for constant and * but
   not variable bounds, ADJUSTABLEASSUMED for constant and variable
   and * bounds.

   If is_ugly_assumed, treat a final dimension with no lower bound
   and an upper bound of 1 as a * bound.  */

ffestpDimtype
ffestt_dimlist_type (ffesttDimList list, bool is_ugly_assumed)
{
  ffesttDimList next;
  ffestpDimtype type;

  if (list == NULL)
    return FFESTP_dimtypeNONE;

  type = FFESTP_dimtypeKNOWN;
  for (next = list->next; next != list; next = next->next)
    {
      bool ugly_assumed = FALSE;

      if ((next->next == list)
	  && is_ugly_assumed
	  && (next->lower == NULL)
	  && (next->upper != NULL)
	  && (ffebld_op (next->upper) == FFEBLD_opCONTER)
	  && (ffebld_constant_integerdefault (ffebld_conter (next->upper))
	      == 1)
	  && (ffebld_conter_orig (next->upper) == NULL))
	ugly_assumed = TRUE;

      if (next->lower != NULL)
	{
	  if (ffebld_op (next->lower) != FFEBLD_opCONTER)
	    {
	      if (type == FFESTP_dimtypeASSUMED)
		type = FFESTP_dimtypeADJUSTABLEASSUMED;
	      else
		type = FFESTP_dimtypeADJUSTABLE;
	    }
	}
      if (next->upper != NULL)
	{
	  if (ugly_assumed
	      || (ffebld_op (next->upper) == FFEBLD_opSTAR))
	    {
	      if (type == FFESTP_dimtypeADJUSTABLE)
		type = FFESTP_dimtypeADJUSTABLEASSUMED;
	      else
		type = FFESTP_dimtypeASSUMED;
	    }
	  else if (ffebld_op (next->upper) != FFEBLD_opCONTER)
	    type = FFESTP_dimtypeADJUSTABLE;
	}
    }

  return type;
}

/* ffestt_exprlist_append -- Append expr to list of exprs

   ffesttExprList list;
   ffelexToken t;
   ffestt_exprlist_append(list,expr,t);

   list must have already been created by ffestt_exprlist_create.  The
   list is allocated out of the scratch pool.  The token is consumed.  */

void
ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t)
{
  ffesttExprList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST expr list", sizeof (*new));
  new->next = list->previous->next;
  new->previous = list->previous;
  new->next->previous = new;
  new->previous->next = new;
  new->expr = expr;
  new->t = t;
}

/* ffestt_exprlist_create -- Create new list of exprs

   ffesttExprList list;
   list = ffestt_exprlist_create();

   The list is allocated out of the scratch pool.  */

ffesttExprList
ffestt_exprlist_create (void)
{
  ffesttExprList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST expr list root",
		       sizeof (*new));
  new->next = new->previous = new;
  new->expr = NULL;
  new->t = NULL;
  return new;
}

/* ffestt_exprlist_drive -- Drive list of token pairs into function

   ffesttExprList list;
   void fn(ffebld expr,ffelexToken t);
   ffestt_exprlist_drive(list,fn);

   The expr/token pairs in the list are passed to the function one pair
   at a time.  */

void
ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken))
{
  ffesttExprList next;

  if (list == NULL)
    return;

  for (next = list->next; next != list; next = next->next)
    {
      (*fn) (next->expr, next->t);
    }
}

/* ffestt_exprlist_kill -- Kill list of exprs

   ffesttExprList list;
   ffestt_exprlist_kill(list);

   The tokens on the list are killed.

   02-Mar-90  JCB  1.1
      Don't kill the list itself or change it, since it will be trashed when
      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */

void
ffestt_exprlist_kill (ffesttExprList list)
{
  ffesttExprList next;

  for (next = list->next; next != list; next = next->next)
    {
      ffelex_token_kill (next->t);
    }
}

/* ffestt_formatlist_append -- Append null format to list of formats

   ffesttFormatList list, new;
   new = ffestt_formatlist_append(list);

   list must have already been created by ffestt_formatlist_create.  The
   new item is allocated out of the scratch pool.  The caller must initialize
   it appropriately.  */

ffesttFormatList
ffestt_formatlist_append (ffesttFormatList list)
{
  ffesttFormatList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST format list",
		       sizeof (*new));
  new->next = list->previous->next;
  new->previous = list->previous;
  new->next->previous = new;
  new->previous->next = new;
  return new;
}

/* ffestt_formatlist_create -- Create new list of formats

   ffesttFormatList list;
   list = ffestt_formatlist_create(NULL);

   The list is allocated out of the scratch pool.  */

ffesttFormatList
ffestt_formatlist_create (ffesttFormatList parent, ffelexToken t)
{
  ffesttFormatList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST format list root",
		       sizeof (*new));
  new->next = new->previous = new;
  new->type = FFESTP_formattypeNone;
  new->t = t;
  new->u.root.parent = parent;
  return new;
}

/* ffestt_formatlist_kill -- Kill tokens on list of formats

   ffesttFormatList list;
   ffestt_formatlist_kill(list);

   The tokens on the list are killed.  */

void
ffestt_formatlist_kill (ffesttFormatList list)
{
  ffesttFormatList next;

  /* Always kill from the very top on down. */

  while (list->u.root.parent != NULL)
    list = list->u.root.parent->next;

  /* Kill first token for this list. */

  if (list->t != NULL)
    ffelex_token_kill (list->t);

  /* Kill each item in this list. */

  for (next = list->next; next != list; next = next->next)
    {
      ffelex_token_kill (next->t);
      switch (next->type)
	{
	case FFESTP_formattypeI:
	case FFESTP_formattypeB:
	case FFESTP_formattypeO:
	case FFESTP_formattypeZ:
	case FFESTP_formattypeF:
	case FFESTP_formattypeE:
	case FFESTP_formattypeEN:
	case FFESTP_formattypeG:
	case FFESTP_formattypeL:
	case FFESTP_formattypeA:
	case FFESTP_formattypeD:
	  if (next->u.R1005.R1004.t != NULL)
	    ffelex_token_kill (next->u.R1005.R1004.t);
	  if (next->u.R1005.R1006.t != NULL)
	    ffelex_token_kill (next->u.R1005.R1006.t);
	  if (next->u.R1005.R1007_or_R1008.t != NULL)
	    ffelex_token_kill (next->u.R1005.R1007_or_R1008.t);
	  if (next->u.R1005.R1009.t != NULL)
	    ffelex_token_kill (next->u.R1005.R1009.t);
	  break;

	case FFESTP_formattypeQ:
	case FFESTP_formattypeDOLLAR:
	case FFESTP_formattypeP:
	case FFESTP_formattypeT:
	case FFESTP_formattypeTL:
	case FFESTP_formattypeTR:
	case FFESTP_formattypeX:
	case FFESTP_formattypeS:
	case FFESTP_formattypeSP:
	case FFESTP_formattypeSS:
	case FFESTP_formattypeBN:
	case FFESTP_formattypeBZ:
	case FFESTP_formattypeSLASH:
	case FFESTP_formattypeCOLON:
	  if (next->u.R1010.val.t != NULL)
	    ffelex_token_kill (next->u.R1010.val.t);
	  break;

	case FFESTP_formattypeR1016:
	  break;		/* Nothing more to do. */

	case FFESTP_formattypeFORMAT:
	  if (next->u.R1003D.R1004.t != NULL)
	    ffelex_token_kill (next->u.R1003D.R1004.t);
	  next->u.R1003D.format->u.root.parent = NULL;	/* Parent already dying. */
	  ffestt_formatlist_kill (next->u.R1003D.format);
	  break;

	default:
	  assert (FALSE);
	}
    }
}

/* ffestt_implist_append -- Append token pair to list of token pairs

   ffesttImpList list;
   ffelexToken t;
   ffestt_implist_append(list,start_token,end_token);

   list must have already been created by ffestt_implist_create.  The
   list is allocated out of the scratch pool.  The tokens are consumed.	 */

void
ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last)
{
  ffesttImpList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST token list", sizeof (*new));
  new->next = list->previous->next;
  new->previous = list->previous;
  new->next->previous = new;
  new->previous->next = new;
  new->first = first;
  new->last = last;
}

/* ffestt_implist_create -- Create new list of token pairs

   ffesttImpList list;
   list = ffestt_implist_create();

   The list is allocated out of the scratch pool.  */

ffesttImpList
ffestt_implist_create (void)
{
  ffesttImpList new;

  new = malloc_new_kp (ffesta_scratch_pool, "FFEST token list root",
		       sizeof (*new));
  new->next = new->previous = new;
  new->first = NULL;
  new->last = NULL;
  return new;
}

/* ffestt_implist_drive -- Drive list of token pairs into function

   ffesttImpList list;
   void fn(ffelexToken first,ffelexToken last);
   ffestt_implist_drive(list,fn);

   The token pairs in the list are passed to the function one pair at a time.  */

void
ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken))
{
  ffesttImpList next;

  if (list == NULL)
    return;

  for (next = list->next; next != list; next = next->next)
    {
      (*fn) (next->first, next->last);
    }
}

/* ffestt_implist_kill -- Kill list of token pairs

   ffesttImpList list;
   ffestt_implist_kill(list);

   The tokens on the list are killed.  */

void
ffestt_implist_kill (ffesttImpList list)
{
  ffesttImpList next;

  for (next = list->next; next != list; next = next->next)
    {
      ffelex_token_kill (next->first);
      if (next->last != NULL)
	ffelex_token_kill (next->last);
    }
}

/* ffestt_tokenlist_append -- Append token to list of tokens

   ffesttTokenList tl;
   ffelexToken t;
   ffestt_tokenlist_append(tl,t);

   tl must have already been created by ffestt_tokenlist_create.  The
   list is allocated out of the scratch pool.  The token is consumed.  */

void
ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t)
{
  ffesttTokenItem ti;

  ti = malloc_new_kp (ffesta_scratch_pool, "FFEST token item", sizeof (*ti));
  ti->next = (ffesttTokenItem) &tl->first;
  ti->previous = tl->last;
  ti->next->previous = ti;
  ti->previous->next = ti;
  ti->t = t;
  ++tl->count;
}

/* ffestt_tokenlist_create -- Create new list of tokens

   ffesttTokenList tl;
   tl = ffestt_tokenlist_create();

   The list is allocated out of the scratch pool.  */

ffesttTokenList
ffestt_tokenlist_create (void)
{
  ffesttTokenList tl;

  tl = malloc_new_kp (ffesta_scratch_pool, "FFEST token list", sizeof (*tl));
  tl->first = tl->last = (ffesttTokenItem) &tl->first;
  tl->count = 0;
  return tl;
}

/* ffestt_tokenlist_drive -- Drive list of tokens

   ffesttTokenList tl;
   void fn(ffelexToken t);
   ffestt_tokenlist_drive(tl,fn);

   The tokens in the list are passed to the given function.  */

void
ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) (ffelexToken))
{
  ffesttTokenItem ti;

  if (tl == NULL)
    return;

  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
    {
      (*fn) (ti->t);
    }
}

/* ffestt_tokenlist_handle -- Handle list of tokens

   ffesttTokenList tl;
   ffelexHandler handler;
   handler = ffestt_tokenlist_handle(tl,handler);

   The tokens in the list are passed to the handler(s).	 */

ffelexHandler
ffestt_tokenlist_handle (ffesttTokenList tl, ffelexHandler handler)
{
  ffesttTokenItem ti;

  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
    handler = (ffelexHandler) (*handler) (ti->t);

  return (ffelexHandler) handler;
}

/* ffestt_tokenlist_kill -- Kill list of tokens

   ffesttTokenList tl;
   ffestt_tokenlist_kill(tl);

   The tokens on the list are killed.

   02-Mar-90  JCB  1.1
      Don't kill the list itself or change it, since it will be trashed when
      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */

void
ffestt_tokenlist_kill (ffesttTokenList tl)
{
  ffesttTokenItem ti;

  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
    {
      ffelex_token_kill (ti->t);
    }
}