Logo Search packages:      
Sourcecode: eli version File versions

expconstit.c

/* This file is part of the Eli translator construction system.

Eli 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.

Eli 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 Eli; see the file COPYING.  If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
/* $Id: expconstit.c,v 4.7 1997/08/29 09:09:06 peter Exp $ */
static char rcs_id[] = "$Id: expconstit.c,v 4.7 1997/08/29 09:09:06 peter Exp $";

/***********************************************************************\
*                                                     *
*           Implementation of LIGA expand pass              *
*                                                     *
*     Module:           expconstit.c                              *
*     File:       expconstit.c                              *
*     Contents:   functions to expand CONSTITUENT and       *
*                 CONSTITUENTS                              *
*     Author:           Hans Detlef Siewert                       *
*     Creation date:    02 Apr 1991                         *
*     Last change:      26 Sep 1991                         *
*                                                     *
\***********************************************************************/

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

#include "LIGA.h"
#include "LIGAMacros.h"
#include "middle_mem.h"
/* Includes for option handling */
#include "option_enums.h"
#include "option_types.h"

#include "ligaconsts.h"
#include "expconst.h"
#include "exp_types.h"
#include "exp_io.h"
#include "expref.h"
#include "expidl.h"
#include "expand.h"
#include "exptrav.h"
#include "expconstit.h"
#include "exp_prot.h"

/* **** EXPANSION OF CONSTITUENT(S) CONSTRUCTS *

 * To expand the CONSTITUENT and the CONSTITUENTS constructs this pass first *
 * call the function find_constits(). It searches for all constructs by
 * calling * the recursive function constits_in_call() for all call rules of
 * all * attributions. This function appends all constructs that are found to
 * a global * list by calling the append_const(). All constructs are compared
 * to other * constructs by calling equal_constits() to combine the expansion
 * of similar * constituents; they are collected in special lists. *  In the
 * next step expand_constits() is called. It uses the previous collected *
 * list and examines all constructs. For each construct and its identical *
 * constructs first all flags for productions and symbols are cleared and
 * then * mark_constituent() is called. All productions containing a
 * construct are * marked as target productions. In the recursive function
 * mark_constit_trans() * all symbols and productions on paths from the
 * constructs to occurrences of * the constituent symbol are marked for
 * transport. All productions containing a * source symbol (the symbol given
 * in the construct) on the right hand side are * marked as source
 * productions. In contrast to the traversing functions used * while
 * expanding INCLUDING and CHAIN constructs, mark_constit_trans() starts * at
 * the root of the subtrees and traverses the tree downwards. This is *
 * necessary because of the specific subtree accesses. An additional flag *
 * is used to mark visited productions to avoid endless loops. *  When the
 * productions and symbols have been marked, the function *
 * expand_constituent() is called by the function expand_constits(). It
 * examines * all attributions of the productions. In source and transport
 * productions it * generates appropriate assignments for transports. This is
 * done by calling * gen_constrans() which calls the function rhs_const() to
 * create an expression * that retrieves the values from the rhs symbols. For
 * each symbol symb_const() * is called to get its values. The values from
 * the rhs symbols are combined by * generating calls of the appropriate
 * concatTl() function. An error results if * the users wanted to retrieve
 * only one CONSTITUENT but multiple symbols are * marked on the right hand
 * side. The function symb_const() further uses the * function gen_create()
 * to generate calls of the creatTl() function. *  If only the lhs symbol of
 * a production is marked but no symbols from the rhs * then a call to the
 * nullTl() function is generated by the function * expand_contituent() by
 * calling the function gen_empty(). This is also an * error if one
 * CONSTITUENT attribute should have been retrieved. *  The function
 * repl_constit() replaces all constructs in target productions. * It uses
 * the function rhs_const() to create the expression and replaces the *
 * construct with it. *
 * 
 ***
 * 
 */


/* * GLOBAL VARIABLES */

ConstNode constituents;       /* global list of all CONSTITUENT(S)s    */

/* * LOCAL VARIABLES */

static int newassigns;        /* total number of new assignments               */

/* * LOCAL FUNCTIONS */

static void
#ifdef __STDC__
show_constituent (ConstNode cptr)
#else
show_constituent (cptr)
     ConstNode cptr;
#endif
/* show this CONSTITUENT(S) contruct and it's similar constructs         */
{
   CoSyNode csn;
   SyAttrNode san;
   ConstNode sameconstit;
   SEQExpr stmp;
   Expr shexp;

   if (!cptr)
      return;

   fprintf (ProtocolFile, "\n%s construct:\n",
        singleOfConstit (cptr->constit) ? "CONSTITUENT" : "CONSTITUENTS");

   fprintf (ProtocolFile, "   %s",
          singleOfConstit (cptr->constit) ? "CONSTITUENT (" :
          "CONSTITUENTS (");

   for (csn = cptr->src; csn; csn = csn->next)
     {
      /* show all source attributes for this symbol */
      for (san = csn->attrs; san; san = san->next)
        {
           (void) fprintf (ProtocolFile,
                       "%s.%s",
                       dnameOfSymb (symbref (csn->symbdid)),
                       nameOfAttrdef (san->ad));
           if (san->next || (csn->next && csn->next->attrs))
            fprintf (ProtocolFile, ", ");
        }
     }
   fprintf (ProtocolFile, ")\n   ");
   if (!singleOfConstit (cptr->constit) && !cptr->dep)
      /* no CONSTITUENT and no CONSTITUENTS that doesn't carry a value */
      (void) fprintf (ProtocolFile,
                  "WITH (%s, %s, %s, %s)\n   ",
                  cptr->list_name,
                  cptr->concat_name,
                  cptr->creat_name,
                  cptr->empty_name);

   fprintf (ProtocolFile, "SHIELD (");
   if (cptr->shield_symbs)
      foreachinSEQExpr (cptr->shield_symbs, stmp, shexp)
     {
      (void) fprintf (ProtocolFile, "%s",
                  dnameOfSymb (symbref (vOfVal (ExprToVal (shexp)))));
      if (stmp->next)
         fprintf (ProtocolFile, ", ");
     }
   fprintf (ProtocolFile, ")\n");

   if (cptr->dep)
      fprintf (ProtocolFile, "   This %s does not carry a value\n",
             singleOfConstit (cptr->constit) ?
             "CONSTITUENT" :
             "CONSTITUENTS");

   sameconstit = cptr->same;
   if (sameconstit)
      fprintf (ProtocolFile, "Occurrence 1:\n   ");
   else
      fprintf (ProtocolFile, "Occurrence:\n   ");

   prot_position (ProtocolFile,
              rowOfConstit (cptr->constit),
              colOfConstit (cptr->constit));
   protout (ProtocolFile, "   RULE ");
   prot_rule (ProtocolFile, cptr->prodid);

   if (sameconstit)     /* there are identical constructs */
     {
      int occnt = 2;
      (void) fprintf (ProtocolFile, "\tidentical constructs:\n");
      /* show all identical constructs */
      for (; sameconstit; sameconstit = sameconstit->same)
        {
           (void) fprintf (ProtocolFile, "Occurrence %d:\n", occnt++);
           prot_position (ProtocolFile,
                      rowOfConstit (sameconstit->constit),
                      colOfConstit (sameconstit->constit));
           protout (ProtocolFile, "   RULE ");
           prot_rule (ProtocolFile, sameconstit->prodid);
        }   /* for */
     }      /* if */
}     /* show_constituent() */

static void
#ifdef __STDC__
mark_constituent (ConstNode cptr)
#else
mark_constituent (cptr)
     ConstNode cptr;
#endif
/* mark symbols and productions for expansion of CONSTITUENT(S)          */
{
   ConstNode same;
   SNode symbs;
   CoSyNode csn;
   int foundany = FALSE;
   int nfound;
   SEQExpr tmpse;
   Expr shexp;
   int shdid;

   markedsymbs = 0;
   markedprods = 0;

   /* mark all source symbols */
   for (csn = cptr->src; csn; csn = csn->next)
      symbflag (csn->symbdid) |= src_symb;

   /* mark all shielded symbols (replace by new shield semantic) */
   foreachinSEQExpr (cptr->shield_symbs, tmpse, shexp)
   {
      shdid = vOfVal (ExprToVal (shexp));
      symbflag (shdid) |= shield_symb;
   }

   /* mark all start productions as target productions */
   for (same = cptr; same; same = same->same)
     {
      prodflag (same->prodid) |= target_prod;
     }      /* for */

   protout (ProtocolFile, "Transport attributes:\n");

   /* mark all subtrees in start productions containing the attribute */
   for (same = cptr; same; same = same->same)
     {
      nfound = 0;

      if (subtreeOfConstit (same->constit))
         /* there is a subtree specification for nonterminal "same->subdid"
            "same->subdid" becomes the "root" of the CONSTITUENTS construct
            accessible targets are BELOW "same->subdid", i.e. they don't
            include "same->subdid" itself (see function symb_const()) 
          */
        {
           if (mark_constit_trans (same->subdid, same))
            nfound = 1;
        }

      else
        {   /* examine all subtrees below rhs symbols */
           for (symbs = prodright (same->prodid)->right;
              symbs;
              symbs = symbs->right)
           { 
             if (!(symbflag(symbs->symbdid) & shield_symb))
             {
                 if (mark_constit_trans (symbs->symbdid, same))
                   nfound++;
             }
             if (symbflag (symbs->symbdid) & src_symb)
             {
                 /* mark as source production */
                 prodflag (same->prodid) |= start_prod;
                 
                 /* symbol found at the root of the subtree */
                 nfound++;
             }    /* if src_symb */
           }      /* for prodright */
        }   /* not subtreeOfConstit */

      if ((nfound > 1) && singleOfConstit (same->constit))
        {
           /* multiple CONSTITUENT symbols reachable */
           print_err (
                    rowOfProd (prodref (same->prodid)),
                    colOfProd (prodref (same->prodid)),
                    "multiple CONSTITUENT symbols in this context",
                    COML_ERRID);
           if (!same->cancelled)
            print_err (
                       rowOfConstit (same->constit),
                       colOfConstit (same->constit),
                       "multiple CONSTITUENT symbols",
                       COML_ERRID);
           (void) fprintf (ProtocolFile, "\n*** ERROR  ");
           (void) fprintf (ProtocolFile,
                       "multiple CONSTITUENT symbols ");
           (void) fprintf (ProtocolFile,
                       "in production %s in line %d, col %d\n\n",
                       dnameOfProd (prodref (same->prodid)),
                       rowOfConstit (prodref (same->prodid)),
                       colOfConstit (prodref (same->prodid)));
           same->cancelled = TRUE;
        }   /* nfound > 1 */
      if ((nfound == 0) && singleOfConstit (same->constit))
        {   /* no CONSTITUENT symbol reachable */
           print_err (
                    rowOfProd (prodref (same->prodid)),
                    colOfProd (prodref (same->prodid)),
                    "CONSTITUENT symbol not reachable in this context",
                    0);
           print_err (
                    rowOfConstit (same->constit),
                    colOfConstit (same->constit),
                    "CONSTITUENT symbol not reachable",
                    0);
           (void) fprintf (ProtocolFile, "\n*** ERROR  ");
           (void) fprintf (ProtocolFile,
                       "CONSTITUENT symbol not reachable ");
           (void) fprintf (ProtocolFile,
                       "in production %s in line %d, col %d\n\n",
                       dnameOfProd (prodref (same->prodid)),
                       rowOfConstit (prodref (same->prodid)),
                       colOfConstit (prodref (same->prodid)));
           same->cancelled = TRUE;
        }
      if (nfound > 0)
         foundany = TRUE;
     }      /* for same */

   if (!foundany && !singleOfConstit (cptr->constit))
     {      /* empty CONSTITUENTS list */
      (void) fprintf (ProtocolFile, "\n*** WARNING  ");
      (void) fprintf (ProtocolFile,
                  "no CONSTITUENTS symbols found in subtrees");
     }      /* if !foundany */
   protout (ProtocolFile,
          "\tmarked for transport: %d symbols, %d productions\n",
          markedsymbs, markedprods);

}     /* mark_constituent() */

static void
#ifdef __STDC__
gen_empty (Attribution attrib, ConstNode cptr)
#else
gen_empty (attrib, cptr)
     Attribution attrib;
     ConstNode cptr;
#endif
/* create assignment of empty list to transport attribute of lhs symbol  */
{
   int prod;
   Symb symb;
   Attrdef ad;
   Call emptycall, new;
   Expr expr;
   Attracc access;
   Name v_name;

   prod = prodidOfAttribution (attrib);

   symb = symbref (prodright (prod)->symbdid);

   /* transport attribute should be the first attribute */
   retrievefirstSEQAttrdef (attrsOfSymb (symb), ad);
   if (strcmp (genattrOfConstit (cptr->constit), nameOfAttrdef (ad)))
     {
      print_err (
                 rowOfConstit (cptr->constit),
                 colOfConstit (cptr->constit),
                 "expconstit.c: internal error #1", NO_ERRID);
      cptr->cancelled = TRUE;
      return;
     }      /* if */
   protout (ProtocolFile,
          "Computations in transport context (empty list):\n   RULE ");
   if (EXP_PROT)
      prot_rule (ProtocolFile, prod);

   if (!cptr->dep)      /* CONSTITUENTS carries a value */
     {
      protout (ProtocolFile, "      %s<1>.%s = %s();\n",
             dnameOfSymb (symb),
             genattrOfConstit (cptr->constit),
             cptr->empty_name);
     }
   else
     {
      protout (ProtocolFile, "      %s<1>.%s doesn't depend on anything;\n",
             dnameOfSymb (symb),
             genattrOfConstit (cptr->constit));
     }
   /* initialize call of assignment */
   new = NCall;
   nameOfCall (new) = ASSIGNFCT;
   initializeSEQExpr (paramsOfCall (new));
   rowOfCall (new) = rowOfProd (prodref (prod));
   colOfCall (new) = colOfProd (prodref (prod));

   /* initialize left hand side of the new assignment */
   access = NAttracc;
   symbnoOfAttracc (access) = 0;    /* lhs symbol of production */
   attridOfAttracc (access) = didOfAttrdef (ad);
   rowOfAttracc (access) = rowOfProd (prodref (prod));
   colOfAttracc (access) = colOfProd (prodref (prod));
   ExprToAttracc (expr) = access;
   appendrearSEQExpr (paramsOfCall (new), expr);

   /* initialize call of empty function */
   emptycall = NCall;
   nameOfCall (emptycall) = cptr->empty_name;
   initializeSEQExpr (paramsOfCall (emptycall));
   rowOfCall (emptycall) = rowOfProd (prodref (prod));
   colOfCall (emptycall) = colOfProd (prodref (prod));
   ExprToCall (expr) = emptycall;
   appendrearSEQExpr (paramsOfCall (new), expr);

   /* append special name to mark assignments to VOID attributes */
   if (cptr->list_tid == DIDVOID
       || cptr->list_tid == DIDVOLI
       || cptr->dep)
     {
      v_name = NName;
      nOfName (v_name) = TNVOID;
      rowOfName (v_name) = rowOfProd (prodref (prod));
      colOfName (v_name) = colOfProd (prodref (prod));
      ExprToName (expr) = v_name;
      appendrearSEQExpr (paramsOfCall (new), expr);
     }      /* if */
   /* append new call to the list of attribution rules */
   ExprToCall (expr) = new;
   appendrearSEQAttrrule (attrrulesOfAttribution (attrib), expr);
   newassigns++;
}     /* gen_empty() */

static Expr
#ifdef __STDC__
gen_create (ConstNode cptr, Attracc acc, Symb sd, Attrdef ad, char **info)
#else
gen_create (cptr, acc, sd, ad, info)
     ConstNode cptr;
     Attracc acc;
     Symb sd;
     Attrdef ad;
     char **info;
#endif
/* generate list create function call from attribute access              */
{
   Call call;
   Expr result;

   /* build call to create list */
   call = NCall;
   nameOfCall (call) = cptr->creat_name;
   initializeSEQExpr (paramsOfCall (call));
   rowOfCall (call) = 0;
   colOfCall (call) = 0;

   /* append attribute access to call parameter list */
   ExprToAttracc (result) = acc;
   appendrearSEQExpr (paramsOfCall (call), result);

   /* result is the new call */
   ExprToCall (result) = call;

   /* create gen_creaion */
   *info = middle_tempMalloc (__FILE__, __LINE__,
                        strlen (dnameOfSymb (sd)) +
                        strlen (nameOfAttrdef (ad)) +
                        strlen (nameOfCall (call)) + 12);
   if (!cptr->dep)      /* this CONSTITUENTS carries a value */
     {
      (void) sprintf (*info, "%s(%s<%d>.%s)",
                  nameOfCall (call),
                  dnameOfSymb (sd),
                  symbnoOfAttracc (acc) + 1,
                  nameOfAttrdef (ad));
     }
   else
     {
      (void) sprintf (*info, "%s<%d>.%s",
                  dnameOfSymb (sd),
                  symbnoOfAttracc (acc) + 1,
                  nameOfAttrdef (ad));
     }

   return (result);
}     /* gen_create() */

static Expr
#ifdef __STDC__
gen_concat (
            Expr expr1, char *info1, int infolen1,
            Expr expr2, char *info2, int infolen2,
            ConstNode cptr, char **info, int *infolen)
#else
gen_concat (expr1, info1, infolen1, expr2, info2, infolen2, cptr, info, infolen)
     Expr expr1;
     char *info1;
     Expr expr2;
     char *info2;
     ConstNode cptr;
     char **info;
     int *infolen;
#endif
/* generate concatenation of two constituent list expressions            */
{
   Call call;
   Expr result;

   /* build call to concatenate lists */
   call = NCall;
   nameOfCall (call) = cptr->concat_name;
   initializeSEQExpr (paramsOfCall (call));
   rowOfCall (call) = 0;
   colOfCall (call) = 0;

   /* include both expressions in call parameter list */
   appendrearSEQExpr (paramsOfCall (call), expr1);
   appendrearSEQExpr (paramsOfCall (call), expr2);

   /* expression is the new call */
   ExprToCall (result) = call;

   /* create information */
   *info = middle_tempMalloc (__FILE__, __LINE__, infolen1 + infolen2 + strlen (nameOfCall (call)) + 6);
   if (!cptr->dep)      /* this CONSTITUENTS carries a value */
     {
      (void) sprintf (*info, "%s(%s, %s)",
                  nameOfCall (call), info1, info2);
      *infolen = infolen1 + infolen2 + strlen (nameOfCall (call)) + 6;
     }
   else
     {
      (void) sprintf (*info, "%s and %s",
                  info1, info2);
      *infolen = infolen1 + infolen2 + 6;

     }
   return (result);
}     /* gen_concat() */

static Expr
#ifdef __STDC__
collect_attrs (ConstNode cptr, int symbno, Symb sd, CoSyNode csn, char **info)
#else
collect_attrs (cptr, symbno, sd, csn, info)
     ConstNode cptr;
     int symbno;
     Symb sd;
     CoSyNode csn;
     char **info;
#endif
/* collect source attributes from a source symbol                        */
{
   SyAttrNode san;
   Attracc newaccess;
   Expr collection, source_expr;
   char *collection_info, *source_info;
   int infolen;
   int first;

   first = TRUE;
   /* loop through all source attributes of this symbol */
   for (san = csn->attrs; san; san = san->next)
     {
      /* create source attribute access */
      newaccess = NAttracc;
      symbnoOfAttracc (newaccess) = symbno;
      attridOfAttracc (newaccess) = didOfAttrdef (san->ad);
      rowOfAttracc (newaccess) = 0;
      colOfAttracc (newaccess) = 0;

      source_expr = gen_create (
                        cptr, newaccess, sd, san->ad, &source_info);

      if (first)
        {
           first = FALSE;
           collection = source_expr;
           collection_info = source_info;
           *info = source_info;
           infolen = strlen (source_info) + 1;
        }
      /* if */
      else
        {
           collection = gen_concat (
                              collection, collection_info, infolen,
                   source_expr, source_info, strlen (source_info) + 1,
                              cptr, info, &infolen);
           collection_info = *info;
        }   /* else */
     }      /* for */

   return (collection);
}     /* collect_attrs() */

static Expr
#ifdef __STDC__
symb_const (int subtreerepl,
          Attribution attrib,
          ConstNode cptr,
          int symbno,
          int symbdid,
          char **info,
          int *infolen)
#else
symb_const (subtreerepl, attrib, cptr, symbno, symbdid, info, infolen)
     int subtreerepl;
     Attribution attrib;
     ConstNode cptr;
     int symbno, symbdid;
     char **info;
     int *infolen;
#endif
/* create a new expression to get the constituents from the rhs symbol   */
{
   int direct_source;
   int trnsp_source;
   Expr result;
   CoSyNode csn;
   Attrdef trans_ad;
   Attracc newaccess;
   Expr trans_expr, source_expr;
   char *trans_info, *source_info;

   ExprToCall (result) = NULL;
   trans_info = (char *) NULL;
   source_info = (char *) NULL;

   direct_source = (symbflag (symbdid) & src_symb) && !subtreerepl;
   /* symbol is a direct source if it is a source and not the symbol
      of the subtree specification, in which case symbol is excluded
      as a source
    */
   trnsp_source = (symbflag (symbdid) & trnsp_symb) &&
      (!(symbflag (symbdid) & shield_symb)
       || subtreerepl);

   if (direct_source)
     {
      for (csn = cptr->src; csn; csn = csn->next)
         if (csn->symbdid == symbdid)
            break;

      if (singleOfConstit (cptr->constit))
        {   /* create source attribute access */
           newaccess = NAttracc;
           symbnoOfAttracc (newaccess) = symbno;
           attridOfAttracc (newaccess) = didOfAttrdef (csn->attrs->ad);
           rowOfAttracc (newaccess) = 0;
           colOfAttracc (newaccess) = 0;

           /* expression is simply the access */
           ExprToAttracc (source_expr) = newaccess;

           /* generate information */
           source_info = middle_Malloc (__FILE__, __LINE__,
                          strlen (dnameOfSymb (symbref (symbdid))) +
                        strlen (nameOfAttrdef (csn->attrs->ad)) + 10);
           (void) sprintf (source_info, "%s<%d>.%s",
                       dnameOfSymb (symbref (symbdid)),
                       symbno + 1,
                       nameOfAttrdef (csn->attrs->ad));
        }
      /* if */
      else
        {
           source_expr = collect_attrs (
                                  cptr, symbno, symbref (symbdid),
                                  csn, &source_info);
        }   /* else */
     }      /* if */
   /* retrieve transport list from actual symbol if necessary */
   if (trnsp_source)
     {
      /* get definition of the transport attribute */
      retrievefirstSEQAttrdef (
                           attrsOfSymb (symbref (symbdid)),
                           trans_ad);

      /* create attribute access to transport attribute */
      newaccess = NAttracc;
      symbnoOfAttracc (newaccess) = symbno;
      attridOfAttracc (newaccess) = didOfAttrdef (trans_ad);
      rowOfAttracc (newaccess) = 0;
      colOfAttracc (newaccess) = 0;

      /* transport expression is access to transport attribute */
      ExprToAttracc (trans_expr) = newaccess;

      /* generate information */
      trans_info = middle_tempMalloc (__FILE__, __LINE__,
                          strlen (dnameOfSymb (symbref (symbdid))) +
                            strlen (nameOfAttrdef (trans_ad)) + 10);
      (void) sprintf (trans_info, "%s<%d>.%s",
                  dnameOfSymb (symbref (symbdid)),
                  symbno + 1,
                  nameOfAttrdef (trans_ad));
     }      /* if */
   /* combine source attributes and transport list if necessary */
   if (trnsp_source)
     {
      if (direct_source)
        {
           if (singleOfConstit (cptr->constit))
             {
              /* multiple CONSTITUENT symbols reachable */
              print_err (
                   rowOfProd (prodref (prodidOfAttribution (attrib))),
                   colOfProd (prodref (prodidOfAttribution (attrib))),
                       "multiple CONSTITUENT symbols in this context",
                         COML_ERRID);
              (void) fprintf (ProtocolFile, "\n*** ERROR  ");
              (void) fprintf (ProtocolFile,
                          "multiple CONSTITUENT symbols ");
              (void) fprintf (ProtocolFile,
                          "in production %s in line %d, col %d\n\n",
                          dnameOfProd (prodref (
                                   prodidOfAttribution (attrib))),
                   rowOfProd (prodref (prodidOfAttribution (attrib))),
                  colOfProd (prodref (prodidOfAttribution (attrib))));
              cptr->cancelled = TRUE;
              ExprToCall (result) = NULL;
              return (result);
             }    /* if */
           /* concatenate lists of transport and source attribute */
           result = gen_concat (
                      trans_expr, trans_info, strlen (trans_info) + 1,
                   source_expr, source_info, strlen (source_info) + 1,
                            cptr, info, infolen);
        }
      /* if */
      else
        {
           /* result is access to transport attribute */
           result = trans_expr;
           *info = trans_info;
           *infolen = strlen (trans_info) + 1;
        }   /* else */
     }
   /* if */
   else
     {
      if (direct_source)
        {
           /* result is access to source attribute */
           result = source_expr;
           *info = source_info;
           *infolen = strlen (source_info) + 1;
        }
      /* if */
      else
        {
           /* symbol is neither transport nor source symbol */
           /* so the result is empty */
           ExprToCall (result) = NULL;
           *info = (char *) NULL;
           *infolen = 0;
        }   /* else */
     }      /* else */

   return (result);
}     /* symb_const() */

static Expr
#ifdef __STDC__
rhs_const (Attribution attrib, ConstNode cptr, char **info)
#else
rhs_const (attrib, cptr, info)
     Attribution attrib;
     ConstNode cptr;
     char **info;
#endif
/* create a new expression to get the constituents from rhs symbols      */
{
   int pid;
   Expr result;
   SNode sn;
   int sno;
   Expr concexpr;
   char *concinfo;
   int concinfolen;
   Expr newexpr;
   char *newinfo;
   int newinfolen;
   int infolen;

   ExprToCall (result) = NULL;
   pid = prodidOfAttribution (attrib);

   /* examine all symbols on the rhs of the production */
   /* there must be something to transport! */
   sno = 0;
   for (sn = prodright (pid)->right; sn; sn = sn->right)
     {
      sno++;
      /* consider only src_symb and not shielded trnsp_symb */
      if (!((symbflag (sn->symbdid) & src_symb) ||
            ((symbflag (sn->symbdid) & trnsp_symb) &&
             !(symbflag (sn->symbdid) & shield_symb))))
         continue;

      /* create expression to get constituents from rhs symbol */
      newexpr = symb_const (
                        FALSE, attrib, cptr,
                        sno, sn->symbdid,
                        &newinfo, &newinfolen);

      /* new expression must not be empty */
      if (!ExprToCall (newexpr))
        {
           if (!cptr->cancelled)
             {
              print_err (
                         rowOfProd (prodref (pid)),
                         colOfProd (prodref (pid)),
                         "expconstit.c: internal error #4",
                         NO_ERRID);
             }    /* if */
           cptr->cancelled = TRUE;
           return (newexpr);
        }   /* if */
      if (!ExprToCall (result))
        {
           /* result is the single expression */
           result = newexpr;
           *info = (char *) middle_tempMalloc (__FILE__, __LINE__, newinfolen);
           (void) strcpy (*info, newinfo);
           infolen = newinfolen;
        }
      /* if */
      else
        {
           if (singleOfConstit (cptr->constit))
             {
              /* multiple CONSTITUENT symbols reachable */
              print_err (
                         rowOfProd (prodref (pid)),
                         colOfProd (prodref (pid)),
                       "multiple CONSTITUENT symbols in this context",
                         COML_ERRID);
              (void) fprintf (ProtocolFile, "\n*** ERROR  ");
              (void) fprintf (ProtocolFile,
                          "multiple CONSTITUENT symbols ");
              (void) fprintf (ProtocolFile,
                          "in production %s in line %d, col %d\n\n",
                          dnameOfProd (prodref (pid)),
                          rowOfProd (prodref (pid)),
                          colOfProd (prodref (pid)));
              cptr->cancelled = TRUE;
              ExprToCall (result) = NULL;
              return (result);
             }
           /* if */
           else
             {
              /* concatenate previous and new expression */
              concexpr = gen_concat (
                                 result, *info, infolen,
                                 newexpr, newinfo, newinfolen,
                                 cptr, &concinfo, &concinfolen);
              result = concexpr;
              *info = (char *) middle_tempMalloc (__FILE__, __LINE__, concinfolen);
              (void) strcpy (*info, concinfo);
              infolen = concinfolen;
             }    /* else */
        }   /* else */
     }      /* for */

   return (result);
}     /* rhs_const() */

static void
#ifdef __STDC__
repl_constit (Attribution attrib, ConstNode cptr)
#else
repl_constit (attrib, cptr)
     Attribution attrib;
     ConstNode cptr;
#endif
/* replace CONSTITUENT(S) construct by a transport expression            */
{
   int prod;
   ConstNode cn;
   int rules;
   Call emptycall;
   Expr rhsexpr;
   Expr conexpr;
   SEQExpr se;
   Expr nextexpr;
   char *info;
   int infolen;
   int parmcnt;

   if (cptr->cancelled)
      return;

   prod = prodidOfAttribution (attrib);

   protout (ProtocolFile, "Access in target context:\n   ");
   if (EXP_PROT)
      prot_rule (ProtocolFile, prod);

   /* handle all constructs in this production */
   rules = 0;
   for (cn = cptr; cn; cn = cn->same)
     {
      if (cn->prodid == prod)
        {
           rules++;
           info = NULL;

           /* generate new expression for transport from the rhs symbols */
           if (subtreeOfConstit (cn->constit))
             {
              rhsexpr = symb_const (TRUE, attrib, cn,
                              subtreeOfConstit (cn->constit),
                              cn->subdid,
                              &info, &infolen);
             }
           /* if */
           else
             {
              rhsexpr = rhs_const (attrib, cn, &info);
             }    /* else */

           /* no expression has been generated due to cancellation */
           /* or because there are not constituents below */
           if (!ExprToCall (rhsexpr))
             {
              if (cn->cancelled)
                {
                   return;
                } /* if */
              /* initialize call of empty function */
              emptycall = NCall;
              nameOfCall (emptycall) = cn->empty_name;
              initializeSEQExpr (paramsOfCall (emptycall));
              rowOfCall (emptycall) = rowOfProd (prodref (prod));
              colOfCall (emptycall) = colOfProd (prodref (prod));
              ExprToCall (rhsexpr) = emptycall;
              info = middle_Malloc (__FILE__, __LINE__, strlen (nameOfCall (emptycall)) + 3);
              if (!cptr->dep) /* this CONSTITUIENTS carries a value */
                 (void) sprintf (info, "%s()", nameOfCall (emptycall));
              else
                 (void) sprintf (info, "nothing");
             }    /* if */
           /* replace the construct */
           if (cn->parmno == 1)
             {
              removefirstSEQExpr (paramsOfCall (cn->constcall));
              appendfrontSEQExpr (
                              paramsOfCall (cn->constcall),
                              rhsexpr);
             }
           /* if */
           else
             {
              /* search the parameter of call that precedes        */
              /* the parameter containing the construct            */
              parmcnt = 0;
              foreachinSEQExpr (paramsOfCall (cn->constcall), se, conexpr)
              {
                 parmcnt++;
                 if (emptySEQExpr (tailSEQExpr (se)))
                   {
                    print_err (
                               rowOfConstit (cn->constit),
                               colOfConstit (cn->constit),
                               "expconstit.c: internal error #5",
                               NO_ERRID);
                    cn->cancelled = TRUE;
                    return;
                   }    /* if */
                 retrievefirstSEQExpr (tailSEQExpr (se), nextexpr);
                 if (parmcnt + 1 == cn->parmno)
                   {
                    removefirstSEQExpr (se->next);
                    appendfrontSEQExpr (se->next, rhsexpr);
                    break;
                   }    /* if */
              }   /* foreachinSEQExpr */
             }    /* else */

           /* print info */
           if (!cptr->dep)
             {    /* this CONSTITUENTS carries a value */
              protout (ProtocolFile,
                     "      %s carries value of %s construct\n",
                     info,
                     singleOfConstit (cn->constit) ?
                     "CONSTITUENT" :
                     "CONSTITUENTS");
             }
           else
             {
              protout (ProtocolFile,
                     "      %s represents %s construct\n",
                     info,
                     singleOfConstit (cn->constit) ?
                     "CONSTITUENT" :
                     "CONSTITUENTS");

             }
        }   /* if */
     }      /* for */

   /* construct must have been found */
   if (!rules)
     {
      print_err (0, 0, "expconstit.c: internal error #6", NO_ERRID);
      cptr->cancelled = TRUE;
      return;
     }      /* if */
}     /* repl_constit() */

static void
#ifdef __STDC__
gen_constrans (Attribution attrib, ConstNode cptr)
#else
gen_constrans (attrib, cptr)
     Attribution attrib;
     ConstNode cptr;
#endif
/* generate CONSTITUENT(S) transport                                     */
{
   int pid;
   Expr rhsexpr;
   Expr expr;
   Symb symb;
   Attrdef ad;
   Attracc access;
   Call new;
   Name v_name;
   char *info;

   pid = prodidOfAttribution (attrib);

   /* generate new expression for non empty transport from rhs symbols */
   info = NULL;
   rhsexpr = rhs_const (attrib, cptr, &info);

   /* expression must have been generated */
   if (!ExprToCall (rhsexpr))
     {
      if (!cptr->cancelled)
        {
           print_err (
                    rowOfConstit (cptr->constit),
                    colOfConstit (cptr->constit),
                    "expconstit.c: internal error #10", NO_ERRID);
           cptr->cancelled = TRUE;
        }   /* if */
      return;
     }      /* if */
   symb = symbref (prodright (pid)->symbdid);

   /* generate new assignment */

   /* transport attribute should be the first attribute */
   retrievefirstSEQAttrdef (attrsOfSymb (symb), ad);
   if (strcmp (genattrOfConstit (cptr->constit), nameOfAttrdef (ad)))
     {
      print_err (
                 rowOfConstit (cptr->constit),
                 colOfConstit (cptr->constit),
                 "expconstit.c: internal error #11", NO_ERRID);
      cptr->cancelled = TRUE;
      return;
     }      /* if */
   /* initialize call of assignment */
   new = NCall;
   nameOfCall (new) = ASSIGNFCT;
   initializeSEQExpr (paramsOfCall (new));
   rowOfCall (new) = rowOfProd (prodref (pid));
   colOfCall (new) = colOfProd (prodref (pid));

   /* initialize left hand side of the new assignment */
   access = NAttracc;
   symbnoOfAttracc (access) = 0;    /* lhs symbol of production */
   attridOfAttracc (access) = didOfAttrdef (ad);
   rowOfAttracc (access) = rowOfProd (prodref (pid));
   colOfAttracc (access) = colOfProd (prodref (pid));
   ExprToAttracc (expr) = access;
   appendrearSEQExpr (paramsOfCall (new), expr);

   /* append expression from rhs constituents to assignment call */
   appendrearSEQExpr (paramsOfCall (new), rhsexpr);

   /* append  special name to mark assignments to VOID attributes */
   if (cptr->list_tid == DIDVOID
       || cptr->list_tid == DIDVOLI
       || cptr->dep)
     {
      v_name = NName;
      nOfName (v_name) = TNVOID;
      rowOfName (v_name) = rowOfProd (prodref (pid));
      colOfName (v_name) = colOfProd (prodref (pid));
      ExprToName (expr) = v_name;
      appendrearSEQExpr (paramsOfCall (new), expr);
     }      /* if */
   /* append new call to the list of attribution rules */
   ExprToCall (expr) = new;
   appendrearSEQAttrrule (attrrulesOfAttribution (attrib), expr);
   newassigns++;

   /* print informations */
   protout (ProtocolFile,
          "Computations in transport context:\n   RULE ");
   if (EXP_PROT)
      prot_rule (ProtocolFile, pid);
   if (!cptr->dep)      /* this CONSTITUENTS carries a value */
     {
      protout (ProtocolFile, "      %s<1>.%s = %s;\n",
             dnameOfSymb (symb),
             genattrOfConstit (cptr->constit),
             info);
     }
   else
     {
      protout (ProtocolFile, "      %s<1>.%s depends on %s;\n",
             dnameOfSymb (symb),
             genattrOfConstit (cptr->constit),
             info);
     }
}     /* gen_constrans() */

static void
#ifdef __STDC__
expand_constituent (ConstNode cptr)
#else
expand_constituent (cptr)
     ConstNode cptr;
#endif
/* expand CONSTITUENT(S) construct by generating assignments and calls   */
{
   SEQAttribution tmp;
   Attribution attrib;
   int pid;

   if (cptr->cancelled)
     {
      protout (ProtocolFile, "\t\texpansion cancelled\n");
      return;
     }
   /* examine all attributions of productions */
   foreachinSEQAttribution (attrrulesOfAttrEval (IdlStruct), tmp, attrib)
   {
      pid = prodidOfAttribution (attrib);
      if (prodflag (pid) & target_prod)
       /* replace CONSTITUENT(S) constructs */
       repl_constit (attrib, cptr);

      if (prodflag (pid) & trans_prod)
       /* retrieve source and transport attributes     */
       /* from the rhs symbols and collect them in the         */
       /* transport attribute of the lhs symbol        */
       gen_constrans (attrib, cptr);

      else if (symbflag (lhsOfProd (prodref (pid))) & trnsp_symb)
       /* nothing to transport here */
      {
         if (singleOfConstit (cptr->constit))
           {
            /* CONSTITUENT symbol not reachable */
            print_err (
                       rowOfProd (prodref (pid)),
                       colOfProd (prodref (pid)),
                     "CONSTITUENT symbol not reached in this context",
                       0);
            if (!cptr->cancelled)
               print_err (
                        rowOfConstit (cptr->constit),
                        colOfConstit (cptr->constit),
                 "CONSTITUENT symbol not reachable in each alternative",
                        0);
            (void) fprintf (ProtocolFile, "\n*** ERROR  ");
            (void) fprintf (ProtocolFile,
                        "CONSTITUENT symbol not reached ");
            (void) fprintf (ProtocolFile,
                        "in production %s in line %d, col %d\n\n",
                        dnameOfProd (prodref (pid)),
                        rowOfProd (prodref (pid)),
                        colOfProd (prodref (pid)));
            cptr->cancelled = TRUE;
           }
         else
            gen_empty (attrib, cptr);
      }
   }  /* foreachinSEQAttribution */
}     /* expand_constituent() */

/* * GLOBAL FUNCTIONS */

void
#ifdef __STDC__
find_constits (void)
#else
find_constits ()
#endif
/* search all CONSTITUENT(S) constructs and build a list for them        */
{
   SEQAttribution tmp1;
   Attribution attrib;
   SEQAttrrule tmp2;
   Attrrule rule;
   int counter;



   newattrname = (char *) middle_tempMalloc (__FILE__, __LINE__, strlen (CONST_ATTR) + 9);
   if (!newattrname)
      deadly ("expand: out of memory\n");
   constscount = 0;
   constituents = (ConstNode) NULL;
   counter = 0;

   foreachinSEQAttribution (attrrulesOfAttrEval (IdlStruct), tmp1, attrib)
   {
      foreachinSEQAttrrule (attrrulesOfAttribution (attrib), tmp2, rule)
      {
       if (typeof (rule) == KCall)
         {
            counter += constits_in_call (
                                   AttrruleToCall (rule),
                                   prodidOfAttribution (attrib),
                                   FALSE);
         }  /* if */
      }           /* foreachinSEQAttrrule */
   }  /* foreachinSEQAttribution */

/*   switch (counter)
   {
   case 0:
   (void) fprintf(ProtocolFile, "\nNo CONSTITUENT(S)s found\n");
   break;
   case 1:
   (void) fprintf(ProtocolFile, "\nOne CONSTITUENT(S) found\n");
   break;
   default:
   (void) fprintf(ProtocolFile,
   "\n%d CONSTITUENT(S)s found\n", counter);
   }
 */

}     /* find_constits() */

void
#ifdef __STDC__
expand_constits (void)
#else
expand_constits ()
#endif
/* expand all CONSTITUENT(S) constructs                                  */
{
   ConstNode cptr;

   if (!constscount)
      return;

   newattrs = 0;
   newassigns = 0;
   if (EXP_PROT)
     {
      fprintf (ProtocolFile, "\nExpanding CONSTITUENT(S)s\n");
      fprintf (ProtocolFile, "--------------------------\n");
     }
   /* examine all constituent(s) constructs in the list  */
   for (cptr = constituents; cptr; cptr = cptr->next)
     {
      clear_psflags ();

      if (EXP_PROT)
         show_constituent (cptr);

      mark_constituent (cptr);
      expand_constituent (cptr);
     }      /* for */

   fprintf (ProtocolFile, "\nCONSTITUENT(S) Expansion Summary\n");
   fprintf (ProtocolFile, "=================================\n");
   fprintf (ProtocolFile, "   Number of expanded CONSTITUENT(S)s:  %d\n",
          constscount);
   fprintf (ProtocolFile, "   Number of new attributes:            %d\n",
          newattrs);
   fprintf (ProtocolFile, "   Number of new computations:          %d\n",
          newassigns);

   constituents = (ConstNode) NULL;
}     /* expand_constits() */

/***********************\
* end of expconstit.c   *
\***********************/

/* HaDeS */

Generated by  Doxygen 1.6.0   Back to index