/*        YACC INPUT TO GENERATE FIRST PASS OF RUSSELL PARSER           */

/* Error recovery assumes modified parser. The parser variable yychar   */
/* is referenced but not altered.                                       */

/* The syntax tree is built during the parse. No other semantic         */
/* actions are performed.                                               */

/* Denotations are only incompletely parsed using the yacc parser.      */
/* Mkappl is then called to refine the parse.                           */

/* Note: Nonterminals consisting only of lower case letters generate    */
/* the empty string. They are introduced only to perform appropriate     */
/* semantic actions.                                                    */

%token CAND 
%token CHARACTERS 
%token CONSTANTS 
%token COR 
%token DO 
%token ELSE 
%token ELSIF 
%token END 
%token ENUM 
%token EXPORT 
%token FI 
%token FIELD 
%token FUNC 
%token HIDE 
%token IF 
%token IN 
%token EXTEND 
%token LET 
%token NI 
%token OD 
%token READONLY 
%token RECORD 
%token THEN 
%token TYPE 
%token UNION 
%token USE 
%token VAL 
%token VAR 
%token WITH 
%token RIGHT_ARROW 
%token EQUALS_EQUALS 
%token EQUALS_EQUALS_EQUALS 
%token COLON 
%token WORDID 
%token OPID
%token PROD 
%token QSTRING 
%token UQSTRING 
%token LEFT_ANGLE_BRACKET 
%token RIGHT_ANGLE_BRACKET 
%token EXTERN
%token SIGNATURE

%left COR
%left CAND


%{
#define YYDEBUG 1
#define CAND 257
#define CHARACTERS 258
#define CONSTANTS 259
#define COR 260
#define DO 261
#define ELSE 262
#define ELSIF 263
#define END 264
#define ENUM 265
#define EXPORT 266
#define FI 267
#define FIELD 268
#define FUNC 269
#define HIDE 270
#define IF 271
#define IN 272
#define EXTEND 273
#define LET 274
#define NI 275
#define OD 276
#define READONLY 277
#define RECORD 278
#define THEN 279
#define TYPE 280
#define UNION 281
#define USE 282
#define VAL 283
#define VAR 284
#define WITH 285
#define RIGHT_ARROW 286
#define EQUALS_EQUALS 287
#define EQUALS_EQUALS_EQUALS 288
#define COLON 289
#define WORDID 290
#define OPID 291
#define PROD 292
#define QSTRING 293
#define UQSTRING 294
#define LEFT_ANGLE_BRACKET 295
#define RIGHT_ANGLE_BRACKET 296
#define EXTERN 297
#define SIGNATURE 298
#define INSERTIONCHAR 299
#define YYERRCODE 256



#   include "../../proto.h"

#   include <stdio.h>
#   include "../../parm.h"
#   include "../applinfer/precedence.h"
#   include "../../stree/ststructs.mh"
#   include "rcs.h"    /* bit vectors defining RUSSELL character set */
#   include "../stt/sttdefs.h"
#   include "../../pass4/sigs.h"
#   include <a.out.h>
  // #   include "tokens.h"
/* The following should really be handled with %union, 	*/
/* but that would be lots of work to fix.							*/
typedef NODE * NodeStar;
#   define YYSTYPE NodeStar

#   define maxskip 8 /* maximum number of tokens to be skipped in error */
                     /* recovery, other than in denotation sequences    */

#   ifdef BAD
        extern boolean BADflag;
#   endif

#   ifdef DEBUG
	int yydebug;
#   endif

#   define LIST_END 0x7fff
    int paramstop []   /* stop symbols for parameter error recovery */
    =   { ';',
          ']',
          '{',
          VAR,
          VAL,
          FUNC,
	  TYPE,
	  SIGNATURE,
	  EOF,
	  LIST_END     };
    int denseqstop []   /* stop symbols for statement list error recovery */
    =   { ';',
	  '#',
	  ELSIF,
	  ELSE,
          FI,
          OD,
          ')',
          NI,
          '}',
          IF,
          DO,
          LET,
          FUNC,
          '(',
          WITH,
          IN,
	  EOF,
	  LIST_END       };
    int condstop []     /* stop symbols for error recovery in various       */
                        /* conditional constructs                           */
    =   {  OD,
           FI,
           RIGHT_ARROW,
           '#',
           ';',
           LET,
           DO,
	   IF,
	   THEN,
	   ELSE,
           '(',
	   EOF,
	   LIST_END       };
    int declstop []     /* stop symbols for error recovery in declarations  */
    =   { EQUALS_EQUALS,
	  EQUALS_EQUALS_EQUALS,
          ';',
          '}',
          IN,
          NI,
          IF,
          DO,
          LET,
          '(',
	  EOF,
	  LIST_END        };

    NODE * sig_in();    /* Read signature info from object file */

    extern boolean initflag;    /* This is a compiler initialization run */
    extern boolean OOflag;      /* Save info for intermediate code optimizer */
    NODE * insrtptr = NIL;  /* pointer to dummy BLOCKDENOTATION vertex into */
			    /* which the syntax tree is to be inserted.     */
			    /* Set up by a previous initialization run of   */
			    /* compiler.                                    */
    extern NODE * id_Boolean;  /* LETTERID node in which the parameter node  */
                               /* for Boolean must be inserted.              */
    extern NODE * id_Void;     /* Analogous node for Void                    */
    extern NODE * id_Integer;  /* Analogous node for Integer                 */
    extern NODE * id_Null;     /* Analogous for Null                         */
    extern NODE * appl_Null;   /* Node corresponding to application of Null  */
    extern sttrelptr indx_Boolean; /* string table index of 'Boolean' */
    extern sttrelptr indx_Integer;
    extern sttrelptr indx_Void;
    extern sttrelptr indx_simple;
    extern sttrelptr indx_standard;
    extern sttrelptr indx_inline;

    extern sttrelptr indx_put;
    extern sttrelptr indx_Callcc;
    extern sttrelptr indx_Array;
    extern sttrelptr indx_Null;

    NODE * stxtree = NIL; /* pointer to root of syntax tree */

    unsigned i; /* temporary */
    extern sttrelptr     /* indices in string table of type components with   */
			 /* predefined signatures.                            */
	indx_assign,
	indx_passign,
	indx_massign,
        indx_equals,   
        indx_less,
        indx_greater,
        indx_le,
        indx_ge,
        indx_ne,
	indx_New,
	indx_ptr_New,
	indx_init_New,
	indx_ValueOf,
	indx_sconc,
	indx_pconc;

    NODE * sig_assign, /* pointers to trees representing predefined */
         * sig_equals, /* signatures.                               */
         * sig_less,
         * sig_greater,
         * sig_New,
         * sig_const,
	 * sig_ValueOf,
	 * sig_sconc,
	 * sig_pconc,
	 * sig_Signature;

extern char * (getname());

extern NODE * mkappl();

extern char * (* inline_cnvt)();

boolean has_externs; /* Mentions separately compiled Russell programs */

/* Defines to establish and test the presence of an optional element */
#   define PRESENT ((NodeStar)1)
#   define NOTPRESENT 0
#   define is_present(x)  ((x) == PRESENT)
%}

%%
Program :
	{ $$ = insrtptr; /* Remember original value */ }
    Denotation =
        { if (stxtree != NIL) {
            /* insert new syntax tree in standard prologue */
		if ($1 != NIL)
		  chgfld(&($1 -> bld_den_seq),mklist((unsigned int)$2, -1));
                else
		    yyperror("No insertion marker in standard prologue");
          } else {
	    stxtree = lock($2);
          }
        }
    | error
	{  yyperror("Syntax error");  }
    | error
	{  yyperror("Syntax error");  } 
      Denotation.seq
    ;
Parameters :
    Id.list  Opt.Colon Signature  =
	{ 
	    NODE *p;

	    if (!$2) {
		yyperror("Missing colon in parameter specification");
	    }
            lock($1); lock($3);
            if (first($1) -> id_str_table_index == indx_Boolean 
                && (id_Boolean -> id_last_definition == NIL)) {
                    $$ = p = split(PARAMETER, $1, $3);
		    chgfld ( &(id_Boolean -> id_last_definition), first(p) );
		    /* this is the actual definition */
                    id_Boolean -> id_def_found = TRUE;
                    if (!initflag) {
                        yywarn ("No builtin type Boolean");
                    }
            } else if (first($1) -> id_str_table_index == indx_Void 
                && (id_Void -> id_last_definition == NIL)) {
                    $$ = p = split(PARAMETER, $1, $3);
                    chgfld ( &(id_Void -> id_last_definition), first(p) );
                    id_Void -> id_def_found = TRUE;
                    if (!initflag) {
                        yywarn ("No builtin type Void");
                    }
            } else if (first($1) -> id_str_table_index == indx_Integer 
                && (id_Integer -> id_last_definition == NIL)) {
                    $$ = p = split(PARAMETER, $1, $3);
                    chgfld ( &(id_Integer -> id_last_definition), first(p) );
                    id_Integer -> id_def_found = TRUE;
                    if (!initflag) {
                        yywarn ("No builtin type Integer");
                    }
	    } else if (first($1) -> id_str_table_index == indx_Null 
		&& (id_Null -> id_last_definition == NIL)) {
                    $$ = p = split(PARAMETER, $1, $3);
		    chgfld ( &(id_Null -> id_last_definition), first(p) );
		    id_Null -> id_def_found = TRUE;
                    if (!initflag) {
			yywarn ("No builtin constant Null");
                    }
            } else {
                $$ = split(PARAMETER, $1, $3);
            }
            vfree(unlock($1));  vfree(unlock($3));
        }
    | Signature  =
      {  $$ = mklist((unsigned int) mknode(PARAMETER,NIL,$1), -1 ); }
    | error
	      { int i = 0;
                int c;

		yyperror("Error in Parameter Specification");
                for ( c = yychar; !in(c, paramstop); c = yylex() )
                    if ( ++i > maxskip ) break;
		yyclearin;
		switch (c) {
                    case VAL:
                    case VAR:
                    case FUNC:
                        yyunlex(c); yyunlex(';'); break;
                    case '{':
                        yyunlex(c); yyunlex(WORDID); yyunlex(VAL);
                        yyunlex(']'); break;
                    case ';':
                    case ']':
			yyunlex(c); break;
		    case EOF:
			exit(1);
                    default: /* recover at outer level */
                        yyunlex(c); yyunlex(']'); 
                }
#               ifdef DEBUG
                    if ( yydebug ) rec_on(c);
#               endif
		$$ = emptylist();
	      }

    ;
Opt.Colon :
    COLON
	{ $$ = (NodeStar)TRUE; }
    |
	{ $$ = (NodeStar)FALSE; }
    ;
Opt.Parameters :
    Parameters  =
        { $$ = $1; }
    |  =
        { $$ = emptylist(); }
    ;
Opt.Parameter.list :
    Opt.Parameters =
        { $$ = $1; }
    | Opt.Parameter.list ';' Opt.Parameters =
        { $$ = conc($1,$3); }
    ;
Id.list :
    ID  =
      { $$ = mklist((unsigned int)$1, -1); }
    | Id.list ',' ID  =
        { $$ = addright($1,$3); }
    ;
Signature : 
    ID
	{ $$ = $1; }
    | ManifestSignature
	{ $$ = $1; }
    ;
ManifestSignature :
    SIGNATURE
	{
	  $$ = sig_Signature;
	}
    | VAR BasicDenotation  = 
	{
	  $$ = mknode(VARSIGNATURE,$2);
	}
    | VAL BasicDenotation =
	{
	  $$ = mknode(VALSIGNATURE,$2);
	}
    | FuncSignature  =
        { $$ = $1; }
    | TYPE '(' Opt.Simple CONSTANTS QSTRING QSTRING QSTRING UQSTRING QSTRING ')'
      Opt.Id  '{' Opt.TypeSignatureComponent.list '}'  =
	{ 
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  $$ = mknode(TYPESIGNATURE,$11,$13,$5,$6,$7,$9);
	  $$ -> ts_string_max = atoi((char *)$8);
	  $$ -> ts_simple_type = (int)$3;
	}
    | TYPE '(' Opt.Simple CONSTANTS QSTRING QSTRING QSTRING UQSTRING ')'
      Opt.Id  '{' Opt.TypeSignatureComponent.list '}'  =
	{ 
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  $$ = mknode(TYPESIGNATURE,$10,$12,$5,$6,$7,NIL);
	  $$ -> ts_string_max = atoi((char *)$8);
	  $$ -> ts_simple_type = (int)$3;
	}
    | TYPE '(' Opt.Simple CONSTANTS QSTRING QSTRING QSTRING ')'
      Opt.Id  '{' Opt.TypeSignatureComponent.list '}'  =
	{ 
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  $$ = mknode(TYPESIGNATURE,$9,$11,$5,$6,$7,NIL);
	  $$ -> ts_string_max = -1;
	  $$ -> ts_simple_type = (int)$3;
	}
    | TYPE '(' Opt.Simple CONSTANTS QSTRING ')'
      Opt.Id  '{' Opt.TypeSignatureComponent.list '}'  =
	{ 
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  $$ = mknode(TYPESIGNATURE,$7,$9,$5,NIL,NIL,NIL);
	  $$ -> ts_string_max = -1;
	  $$ -> ts_simple_type = (int)$3;
	}
    | TYPE '(' Opt.Simple ')'
      Opt.Id  '{' Opt.TypeSignatureComponent.list '}'  =
	{ 
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  $$ = mknode(TYPESIGNATURE,$5,$7,NIL,NIL,NIL,NIL);
	  $$ -> ts_string_max = -1;
	  $$ -> ts_simple_type = (int)$3;
	}
    | TYPE  Opt.Id  '{' Opt.TypeSignatureComponent.list '}'  =
	{ 
	  $$ = mknode(TYPESIGNATURE,$2,$4,NIL,NIL,NIL,NIL);
	  $$ -> ts_string_max = -1;
	  $$ -> ts_simple_type = FALSE;
	}
    ;
Opt.Simple :
    ID  =
	{
	  if ($1 -> id_str_table_index == indx_simple) {
	    $$ = (NodeStar)TRUE;  /* simple type, no pointers to activation records */
	  } else {
	    yywarn("Compiler directive not understood");
	    $$ = (NodeStar)FALSE;
	  }
	  vfree($1);
	}
    |     =
	{ $$ = FALSE; }
    ;
Opt.InLine :
    '(' ID QSTRING ')'
	{
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  if ($2 -> id_str_table_index == indx_inline) {
	    $$ = (NodeStar)((*inline_cnvt)($3));
	  } else {
	    yywarn("Compiler directive not understood");
	    $$ = NIL;
	  }
	  vfree($2);
	}
    |      =
	{ $$ = NIL; }
    ;   
Special :
    '(' ID ID UQSTRING ')'
	{
	  if (!initflag) {
	    yywarn("Compiler directive outside initialization");
	  }
	  if ($2 -> id_str_table_index == indx_standard) {
	    int num_arg = atoi((char *)$4);

	    if ($3 -> id_str_table_index == indx_New) {
		$$ = (NodeStar)special(STD_NEW, num_arg);
	    } else if ($3 -> id_str_table_index == indx_ptr_New) {
		$$ = (NodeStar)special(PTR_NEW, num_arg);
	    } else if ($3 -> id_str_table_index == indx_init_New) {
		$$ = (NodeStar)special(INIT_NEW, num_arg);
	    } else if ($3 -> id_str_table_index == indx_ValueOf) {
		$$ = (NodeStar)special(STD_VALUEOF, num_arg);
	    } else if ($3 -> id_str_table_index == indx_assign) {
		$$ = (NodeStar)special(STD_ASSIGN, num_arg);
	    } else if ($3 -> id_str_table_index == indx_put) {
		$$ = (NodeStar)special(STD_PUT, num_arg);
	    } else if ($3 -> id_str_table_index == indx_Callcc) {
		$$ = (NodeStar)special(STD_CALLCC, num_arg);
	    } else if ($3 -> id_str_table_index == indx_Array) {
		$$ = (NodeStar)special(STD_ARRAY, num_arg);
	    } else if ($3 -> id_str_table_index == indx_passign) {
		$$ = (NodeStar)special(STD_PASSIGN, num_arg);
	    } else if ($3 -> id_str_table_index == indx_massign) {
		$$ = (NodeStar)special(STD_MASSIGN, num_arg);
	    } else {
		yywarn("Bad standard directive");
		$$ = 0;
	    }
	  } else {
	    yywarn("Compiler directive not understood");
	    $$ = NIL;
	  }
	  vfree($2); vfree($3);
	}
    ;   
FuncSignature :
    FUNC Special Opt.InLine '[' Opt.Parameter.list ']' Signature =
	{
	  $$ = mknode(FUNCSIGNATURE,$3,$5,$7);
	  $$ -> fsig_special = (int)$2;
	}
    | FUNC Opt.InLine '[' Opt.Parameter.list ']' Signature =
	{
	  $$ = mknode(FUNCSIGNATURE,$2,$4,$6);
	  if ($2 != NIL) {
	    /* Remember that this is a primitive other than put or callcc */
	    $$ -> fsig_special = special(OTHER_BUILTIN, 0);
	  }
	}
    ;
Opt.TypeSignatureComponents :
    TypeSignatureComponents  =
        { $$ = $1; }
    |      =
        { $$ = emptylist(); }
    ;
Opt.TypeSignatureComponent.list :
    Opt.TypeSignatureComponents =
        { $$ = $1; }
    | Opt.TypeSignatureComponent.list ';' Opt.TypeSignatureComponents =
        { $$ = conc($1,$3); }
    ;
Opt.Id :
    ID =
        { $$ = $1; }
    |  =
        { $$ = NIL; }
    ;
TypeSignatureComponents :
    Id.list Opt.Colon Signature  =
        { 
	    if (!$2) {
		yyperror("Missing colon in type component");
	    }
	  lock($1); lock($3);
	  if ($3 -> kind == VARSIGNATURE) {
	    yyperror("Variable as type signature component");
	  }
          $$ = split(TSCOMPONENT, $1, $3);
          vfree(unlock($1)); vfree(unlock($3));
        }
    | Id.list Opt.Colon Opt.Readonly FIELD BasicDenotation  =
        {
          NODE * vl_field_sig;
          NODE * vr_field_sig;

	  if (!$2) {
	      yyperror("Missing colon in field specification");
	  }
          vl_field_sig = mknode(FUNCSIGNATURE,
                                NIL,  /* in-line code */
                                mklist((unsigned int)mknode(PARAMETER,
                                              NIL,
                                              mknode(VALSIGNATURE,
                                                     mknode(LETTERID,-1))),
                                       -1),
                                mknode(VALSIGNATURE, $5));
          lock($1); lock($5);
          if ( is_present($3) ) {
            $$ = split(TSCOMPONENT,$1,vl_field_sig);
          } else {
            vr_field_sig = mknode(FUNCSIGNATURE,
                                  NIL,  /* in-line code */
                                  mklist((unsigned int)mknode(PARAMETER,
                                                NIL,
                                                mknode(VARSIGNATURE,
                                                       mknode(LETTERID,-1))),
                                         -1),
                                  mknode(VARSIGNATURE, $5));
            $$ = conc(split(TSCOMPONENT,$1,vl_field_sig),
                      split(TSCOMPONENT,$1,vr_field_sig));
          }
          vfree(unlock($1)); vfree(unlock($5));
        }
    | ID =
        { 
            NODE * result;
            switch ($1 -> kind) {
                case OPRID:
                    i = $1 -> id_str_table_index;
                    if ( i == indx_assign )
                        result = mknode(TSCOMPONENT,$1,sig_assign);
                    else if (i == indx_less || i == indx_le )
                        result = mknode(TSCOMPONENT,$1,sig_less);
                    else if ( i == indx_greater || i == indx_ge )
                        result = mknode(TSCOMPONENT,$1,sig_greater);
                    else if ( i == indx_equals || i == indx_ne )
			result = mknode(TSCOMPONENT,$1,sig_equals);
		    else if ( i == indx_sconc )
			result = mknode(TSCOMPONENT,$1,sig_sconc);
		    else if ( i == indx_pconc )
			result = mknode(TSCOMPONENT,$1,sig_pconc);
                    else 
			yyperror("Missing signature");
                    break;

                case LETTERID:
                    i = $1 -> id_str_table_index;
                    if ( i == indx_New )
                        result = mknode(TSCOMPONENT,$1,sig_New);
                    else if ( i == indx_ValueOf )
                        result = mknode(TSCOMPONENT,$1,sig_ValueOf);
                    else if ( *(getname(i)) == '\'' ) /* quoted id */
                        result = mknode(TSCOMPONENT,$1,sig_const);
                    else
			yyperror("Missing signature");
                    break;

#             ifdef DEBUG
                default:
                        dbgmsg("parser: incorrect id structure");
#             endif
            }
            $$ = mklist((unsigned int)result,-1);
        }
    | CHARACTERS  =
        {
            /* return a singleton list containing a DEFCHARSIGS node with */
            /* all bits corresponding to valid RUSSELL characters set. */
            /* Note machine dependence. */
	  $$ = mklist((unsigned int)mknode(DEFCHARSIGS, RCS0, RCS1, RCS2, RCS3), -1);
	}
    | error
	{
	    yyperror("Error in type signature component");
	    $$ = emptylist();
	}
    ;
Opt.Readonly :
    READONLY =
        { $$ = PRESENT; }
    |   =
        { $$ = NOTPRESENT; }
    ;
Denotation :
    ManifestSignature
	{ $$ = $1; }
    | BasicDenotation
    ;
BasicDenotation:
    Primary.list  =
        {
#           ifdef BAD
                if (BADflag)
                    flcheck(0,0);
                else
                    flcheck(0,1);
#           endif
            lock($1);
            $$ = mkappl($1);
            lock($$);
            vfree(unlock($1));
            unlock($$);
#           ifdef BAD
                if (BADflag)
                    flcheck(0,0);
                else
                    flcheck(0,1);
#           endif
        }
    | '\002' /* STX (marks the insertion place in a compiler initialization */
             /* run) */   =
        {
            if (!initflag) {
		yywarn("use of insertion character in non-initialization run");
		$$ = insrtptr = mknode(BLOCKDENOTATION,emptylist(),NIL);
		insrtptr -> bld_precedence = INFINITE;
            } else {
		$$ = insrtptr = mknode(BLOCKDENOTATION,emptylist(),NIL);
		insrtptr -> bld_precedence = INFINITE;
            }
        }
    ;
Primary.list :
    Primary =
      { $$ = mklist((unsigned int)$1, -1); }
    | ArgList
    { $$ = mklist((unsigned int)$1, -1); }
    | Primary.list Primary 
	{ $$ = addright($1,$2); }
    | Primary.list ArgList
	{ $$ = addright($1,$2); }
    ;
Primary :
    FuncConstruction
        { $$ = $1; }
    | Selection
	{ $$ = $1; }
    | CAND
        { $$ = mknode(WORDCAND); }
    | COR
        { $$ = mknode(WORDCOR); }
    | TypeConstruction
        { $$ = $1; }
    | Primary TypeModifier
	{ $$ = mknode(MODPRIMARY,$1,$2,NIL); }
    | '(' Denotation.seq ')'
        { int prec;
	  NODE *p;
#         ifdef DEBUG
            if ( is_empty($2) ) {
                dbgmsg("parser: empty denotation seq\n");
                abort();
            }
#         endif
          if (first($2) == last($2)) {
              /* just return the single denotation in the sequence */
                $$ = p = last($2);
                lock(p);
                vfree($2);
                unlock(p);
          }
          else {
              prec = precedence( last($2) );
	      $$ = p = mknode(BLOCKDENOTATION,emptylist(),$2);
	      p -> bld_precedence = prec;
          }
        }
    | IF GuardedDenotation.list FI =
        { $$ = mknode(GUARDEDLIST,$2); }
    | DO GuardedDenotation.list OD =
        { $$ = mknode(LOOPDENOTATION,$2); }
    | LET Opt.Declaration.list IN Denotation.seq NI =
        { int prec;  NODE *p;
	  prec = precedence( last($4) );
	  $$ = p = mknode(BLOCKDENOTATION,$2,$4);
	  p -> bld_precedence = prec;
	}
    | USE Opt.Denotation.list IN Denotation.seq NI =
        { int prec;  NODE *p;
	  prec = precedence( last($4) );
	  $$ = p = mknode(USELIST,$2,$4);
	  p -> usl_precedence = prec;
        }
    | EXTERN '{' QSTRING '}' =
	{
	  has_externs = TRUE;
	  $$ = mknode(REXTERNDEF, read_signature($3), $3);
	  $$ -> sig_done = SIG_DONE;
	}
    ;
Denotation.seq :
    Denotation.seq ';' Opt.Denotation =
        { $$ = addright($1,$3); }
    | Denotation =
      { $$ = mklist((unsigned int)$1, -1); }
    | error 
	       {    int c;

		    yyperror("Error in Expression Sequence");
                    for (c = yychar; !in(c, denseqstop); c = yylex());
		    yyclearin;
		    switch(c)  {
                        case ';':
                        case '#':
			case FI:
			case ELSIF:
			case ELSE:
                        case OD:
                        case ')':
		    case NI:   // was 'NI' DJD
                        case '}':
                            yyunlex(c);
                            break;
                        case IF:
                        case DO:
                        case LET:
                        case FUNC:
                        case '(':
                            yyunlex(c);
                            yyunlex(';');
                            break;
                        case WITH:
                            yyunlex(c);
                            yyunlex(WORDID);
                            yyunlex(';');
                            break;
                        case IN:
                            yyunlex(c);
                            yyunlex(LET);
                            yyunlex(';');
			    break;
			case EOF:
			    exit(1);
                        default:
                            yyunlex(c);
                    }
#                   ifdef DEBUG
                        if (yydebug) rec_on(c);
#                   endif
			$$ = mklist((unsigned int)id_Integer, -1);  /* fake it */
	       }
    ;
Opt.Denotation :
    Denotation  =
        { $$ = $1; }
    |  =
        { $$ = NIL; }
    ;
FuncConstruction :
    IncompleteFuncSignature '{' Denotation.seq '}' =
	{ 
	  if (length($3) == 1) {
	      $$ = mknode(FUNCCONSTR,$1,first($3));
	  } else {
	      $$ = mknode(FUNCCONSTR,$1,
			      mknode(BLOCKDENOTATION,emptylist(),$3));
	      $$->fc_body->bld_precedence = INFINITE; /* doesn't matter */
	  }
	  $1 -> fsig_construction = $$;
	  if (initflag || TRUE) {
	    /* Make sure that global functions receive the same name */
	    /* in all compilations.                                  */
	    char * name = (char *)malloc(15);
	    static int global_fn_count;
	    sprintf(name, "fn_global_%d", ++ global_fn_count);
	    $$ -> fc_code_label = name;
	  }
	}
    | IncompleteFuncSignature '{' EXTERN QSTRING '}' =
	{
	  if ($1 -> fsig_result_sig == NIL) {
	    yyperror("Must specify result signature for extern");
	  }
	  $$ = mknode(FUNCCONSTR, $1, mknode(EXTERNDEF, $4));
	}
    ;
IncompleteFuncSignature :
    FuncSignature  =
        { $$ = $1; }
    | FUNC Special Opt.InLine '[' Opt.Parameter.list ']'  =
	{ 
	  $$ = mknode(FUNCSIGNATURE, $3, $5, NIL);
	  $$ -> fsig_special = (int)$2;
	}
    | FUNC Opt.InLine '[' Opt.Parameter.list ']'  =
	{ $$ = mknode(FUNCSIGNATURE, $2, $4, NIL); }
    ;
Selection :
    Primary '$' ID Opt.SigClause =
        { 
            initfld(&($3->sel_type), $1);
            initfld(&($3->signature), $4);
            $$ = $3;
        }
    | Primary '$' STRING =
        {
            initfld(&($3->sel_type), $1);
            $$ = $3;
        }
    | ID Opt.SigClause =
        { 
            initfld(&($1->signature), $2);
            $$ = $1;
        }
    | STRING =
        {
            $$ = $1;
        }
    ;
TypeConstruction :
    Enumeration =
        { $$ = $1; }
    | Record =
        { $$ = $1; }
    | Extension =
        { $$ = $1; }
    | Product =
        { $$ = $1; }
    | Union =
        { $$ = $1; }
    ;
Guard :
    Denotation =
        { $$ = $1; }
    | ELSE =
        { $$ = mknode(WORDELSE); }
    | error
	{ yyperror("Error while trying to parse guard"); }
    ;
ArgList :
    '[' Opt.Denotation.list ']' =
        { $$ = $2; }
    ;
Opt.Denotation.list :
    Denotation =
      { $$ = mklist((unsigned int)$1, -1); }
    | Denotation ',' Opt.Denotation.list =
        { $$ = addleft($3,$1); }
    |   =
        { $$ = emptylist(); }
    ;
Opt.Declaration.list :
    Opt.Declarations =
        { $$ = $1; }
    | Opt.Declaration.list ';' Opt.Declarations =
        { $$ = conc($1,$3); }
    ;
Opt.Declarations :
    Id.list Opt.ColonSignature EQUALS_EQUALS Denotation =
        { 
            lock($1); lock($2); lock($4);
            $$ = split(DECLARATION,$1,$4,$2);
            vfree(unlock($1)); vfree(unlock($2)); vfree(unlock($4));
        }
    | Id.list Opt.ColonSignature EQUALS_EQUALS_EQUALS Denotation =
        { 
	    NODE *q;
            lock($1); lock($2); lock($4);
	    $$ = q = split(DECLARATION,$1,$4,$2);
	    maplist(p, q, {
		p -> decl_sig_transp = TRUE;
	    });
            vfree(unlock($1)); vfree(unlock($2)); vfree(unlock($4));
        }
    |   =
        { $$ = emptylist(); }
    | error   { int c;
		int i = 0;

		yyperror("Error in declaration");
                for ( c = yychar; !in(c, declstop); c = yylex() )
                    if ( ++i > maxskip ) break;
                yyclearin;
                switch (c)  {
                    case EQUALS_EQUALS:
                        yyunlex(c);
                        yyunlex(WORDID);
                        yyunlex(';');
                        break;
                    case ';' :
                    case '}' :
                    case IN:
                        yyunlex(c);
                        break;
                    case NI:
                        yyunlex(c);
                        yyunlex(WORDID);
                        yyunlex(IN);
                        break;
                    case IF:
                    case DO:
                    case LET:
                    case '(':
                        yyunlex(c);
                        yyunlex(EQUALS_EQUALS);
                        yyunlex(WORDID);
			break;
		    case EOF:
			exit(1);
                    default :
                        yyunlex(c);
                        yyunlex(NI);
                        yyunlex(IN);
                }
#               ifdef DEBUG
                    if (yydebug) rec_on(c);
#               endif
		$$ = emptylist();
	      }
    ;
Opt.ColonSignature :
    Opt.Colon Signature  =
        { $$ = $2; }
    |  =
        { $$ = NIL; }
    ;
Enumeration :
    ENUM '{' Id.list '}' =
        { $$ = mknode(ENUMERATION,$3); }
    ;
Extension :
    EXTEND '{' Denotation '}' =
        { $$ = mknode(EXTENSION,$3); }
    ;
Product :
    PROD Opt.Id '{' Opt.Parameter.list '}'  =
        { 
          maplist (s, $4, {
            if (s -> par_id == NIL) {
		yyperror("Anonymous fields not allowed in product");
            }
          });
	  $$ = mknode(PRODCONSTRUCTION,$2,$4); 
	}
    | PROD error
	{ yyperror("Error in product construction"); }
    ;
Record :
    RECORD '{' Opt.RecordElement.list '}' =
        { $$ = mknode(RECORDCONSTRUCTION,$3); }
    | RECORD error
	{ yyperror("Error in record construction"); }
    ;
Union :
    UNION Opt.Id '{' Opt.Parameter.list '}' =
        {
          maplist (s, $4, {
            if (s -> par_id == NIL) {
		yyperror("Anonymous fields not allowed in union");
            }
          });
          $$ = mknode(UNIONCONSTRUCTION,$2,$4);
        }
    | UNION error
	{ yyperror("Error in union construction"); }
    ;
Opt.RecordElement.list :
    Opt.RecordElements =
        { $$ = $1; }
    | Opt.RecordElement.list ';' Opt.RecordElements =
        { $$ = conc($1,$3); }
    ;
Opt.RecordElements :
    RecordElements =
        { $$ = $1; }
    |  =
        { $$ = emptylist(); }
    ;
RecordElements :
    Id.list Opt.Colon Denotation =
        { 
	    if (!$2) {
		yyperror("Missing colon in record element specification");
	    }
            lock($1); lock($3);
            $$ = split(RECORDELEMENT,$1,$3);
            vfree(unlock($1)); vfree(unlock($3));
        }
    ;
TypeModifier :
    WithList =
        { $$ = $1; }
    | ExportList =
        { $$ = $1; }
    ;
WithList :
    WITH Opt.Id '{' Opt.Declaration.list '}'  =
	{ $$ = mknode(WITHLIST,$2,$4); }
    | WITH error
	{ yyperror("Error in \"with\" type modification"); }
    ;
ExportList :
    Start.ExportList Opt.Id '{' ExportElement.list '}' =
      { $$ = mknode((unsigned int)$1,$2,$4);  }
    | EXPORT error
	{ yyperror("Error in \"export\" type modification"); }
    | HIDE error
	{ yyperror("Error in \"hide\" type modification"); }
    ;
Start.ExportList :
    EXPORT =
        { $$ = (NODE *)EXPORTLIST; }
    | HIDE =
        { $$ = (NODE *)HIDELIST; }
    ;
ExportElement.list :
    ExportElement =
      { $$ = mklist((unsigned int)$1, -1); }
    | ExportElement ';' ExportElement.list =
        { $$ = addleft($3,$1); }
    |   =
        { $$ = emptylist(); }
    ;
ExportElement :
    ID Opt.SigClause Opt.ExportList =
        { $$ = mknode(EXPORTELEMENT,$1,$2,$3); }
    | CONSTANTS =
        { $$ = mknode(ALLCONSTANTS); }
    | error
	{ yyperror("Error in \"export\"ed or hidden element specification"); }
    ;
Opt.ExportList :
    ExportList =
        { $$ = $1; }
    |   =
        { $$ = NIL; }
    ;
Opt.SigClause :
    LEFT_ANGLE_BRACKET Signature RIGHT_ANGLE_BRACKET  =
        { $$ = $2; }
    |   =
        { $$ = NIL; }
    ;
Opt.ElseList :
    ElseList
	{ $$ = $1; }
    |
	{
	    extern NODE * appl_Null;
	    $$ = appl_Null;
	}
    ;
ElseList :
    ELSE Denotation.seq
	{
	    if (length($2) == 1) {
		$$ = first($2);
	    } else {
		NODE *p = mknode(BLOCKDENOTATION, emptylist(), $2);
		$$ = p;
		p -> bld_precedence = INFINITE; /* doesnt matter */
	    }
	}
    | ELSIF Denotation THEN Denotation.seq Opt.ElseList
	{
	    NODE * ge1;  /* First guarded element */
	    NODE * ge2;  /* Second guarded element */

	    if (length($4) == 1) {
		ge1 = mknode(GUARDEDELEMENT,$2,first($4));
	    } else {
		ge1 = mknode(GUARDEDELEMENT,$2,
			    mknode(BLOCKDENOTATION,emptylist(),$4));
		ge1->ge_element->bld_precedence = INFINITE; /* doesn't matter */
	    }
	    /* $5 is a denotation to be executed if orignal */
	    /* guard does not apply                         */
	    ge2 = mknode(GUARDEDELEMENT, mknode(WORDELSE), $5);
	    $$ = mknode(GUARDEDLIST, mklist((unsigned int)ge1, ge2, -1));
	}
    ;
GuardedDenotation.list :
    GuardedDenotation =
      { $$ = mklist((unsigned int)$1, -1); }
    | GuardedDenotation.list '#' GuardedDenotation =
	{ $$ = addright($1,$3); }
    | Denotation THEN Denotation.seq Opt.ElseList
	{
	    NODE * ge1;  /* First guarded element */
	    NODE * ge2;  /* Second guarded element */

	    if (length($3) == 1) {
		ge1 = mknode(GUARDEDELEMENT,$1,first($3));
	    } else {
		ge1 = mknode(GUARDEDELEMENT,$1,
			    mknode(BLOCKDENOTATION,emptylist(),$3));
		ge1->ge_element->bld_precedence = INFINITE; /* doesn't matter */
	    }
	    /* $4 is a denotation to be executed if orignal */
	    /* guard does not apply                         */
	    ge2 = mknode(GUARDEDELEMENT, mknode(WORDELSE), $4);
	    $$ = mklist((unsigned int)ge1, ge2, -1);
	}
    | error 
        {   
	  int i = 0;
          int c;

	  yyperror("Error in Loop or If");
          for (c = yychar; !in(c,condstop); c = yylex() )
              if ( ++i > maxskip ) break;
          yyclearin;
          switch(c) {
              case '#' :
              case FI :
              case OD :
                  yyunlex(c); break;
	      case RIGHT_ARROW :
	      case ELSE :
	      case THEN :
              case ';' :
		  yyunlex(RIGHT_ARROW); yyunlex(WORDID); yyunlex('#'); break;
              case LET :
              case '(' :
              case DO :
              case IF :
                  yyunlex(c);
                  yyunlex(RIGHT_ARROW);
                  yyunlex(WORDID);
                  yyunlex('#');
		  break;
	      case EOF:
		  exit(1);
              default :
                  yyunlex(c); yyunlex(END);
          }
#         ifdef DEBUG
              if (yydebug) rec_on(c);
#         endif
	  $$ = emptylist();
        }
    ;
GuardedDenotation :
    Guard RIGHT_ARROW Denotation.seq =
	{   if (length($3) == 1) {
		$$ = mknode(GUARDEDELEMENT,$1,first($3));
	    } else {
		NODE *p = mknode(GUARDEDELEMENT,$1,
				mknode(BLOCKDENOTATION,emptylist(),$3));
		$$= p;
		p->ge_element->bld_precedence = INFINITE; /* doesn't matter */
	    }
	}
    ;
ID :
    WORDID =
        { $$ = mknode(LETTERID,$1); }
    | OPID =
        { $$ = mknode(OPRID,$1); }
    ;
STRING :
    QSTRING =
        { $$ = mknode(QSTR,$1); }
    | UQSTRING =
        { $$ = mknode(UQSTR,$1); }
    ;
%%
 
in(element,list)
int element;
int list[];
{   int i;
    i = 0;
    while (element != list[i] && list[i] != LIST_END) ++i;
    return (element == list[i]);
}
 

# ifdef DEBUG
    rec_on(c)
    int c;
    {
        if ( c < 0400 ) {
            dbgmsg ( "recovery attempted on %c\n", c);
        }
        else {
            dbgmsg ( "recovery attempted on token number %d\n", c);
        }
    }
# endif

