%{
$include "defs.icn"
$include "global_vars.icn"
global yylhs
 %}
%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 H
%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


%%
Program :
	{ $$ := insrtptr  }
    Denotation =
        { if (\stxtree) then {
            		if (\$1) then
				   $1 . bld_den_seq := mklist([$2])
                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  =
	{ 
	    if (/$2) then { 
		yyperror("Missing colon in parameter specification")
	    }
            lock($1) 
lock($3)
            if ((first($1) . id_str_table_index = indx_Boolean) & 
                 (/(id_Boolean . id_last_definition))) then {
                    $$ := p := split(PARAMETER, $1, $3)
		    id_Boolean . id_last_definition := first(p) 
		   
                    id_Boolean . id_def_found := TRUE
                    if (initflag = FALSE) then {
                        yywarn ("No builtin type Boolean")
                    }
	      } else if ((first($1) . id_str_table_index = indx_Void) & 
		        (/(id_Void . id_last_definition))) then {
                    $$ := p := split(PARAMETER, $1, $3)
		    id_Void . id_last_definition := first(p) 
                    id_Void . id_def_found := TRUE
                    if (initflag = FALSE) then {
                        yywarn ("No builtin type Void")
                    }
	      } else if ((first($1) . id_str_table_index = indx_Integer) & 
		        (/id_Integer . id_last_definition)) then {
                    $$ := p := split(PARAMETER, $1, $3)
                    id_Integer . id_last_definition := first(p) 
                    id_Integer . id_def_found := TRUE
                    if (initflag = FALSE) then {
                        yywarn ("No builtin type Integer")
                    }
	      } else if ((first($1) . id_str_table_index = indx_Null) & 
		       (/(id_Null . id_last_definition))) then {
                    $$ := p := split(PARAMETER, $1, $3)
		    id_Null . id_last_definition := first(p) 
		    id_Null . id_def_found := TRUE
                    if (initflag = FALSE) then {
			yywarn ("No builtin constant Null")
                    }
            } else {
                $$ := split(PARAMETER, $1, $3)
            }
            vfree(unlock($1)) 
 vfree(unlock($3))
        }
    | Signature  =
        {  $$ := mklist([ mknode([PARAMETER,nil,$1]) ]) }
    | error
	      { 
		local i , c, p

		  i := 0
		yyperror("Error in Parameter Specification")
		c := yychar
		  while not (in(c, paramstop)) do {
		    i +:= 1
                    if ( i > maxskip ) then {
			break
		      }
		        c := yylex() 
		      
                      }					   
		yyclearin
		case (c)  of {
                     VAL:
                        {
                        yyunlex(c) 
                        yyunlex(";")
			 }

                     VAR:
                        {
                        yyunlex(c) 
                        yyunlex(";")
			 }

                     FUNC: 
                        {
                        yyunlex(c) 
                        yyunlex(";")
			 }

			"{": {
                        yyunlex(c) 
                        yyunlex(WORDID) 
                          yyunlex(VAL)
                        yyunlex("]") 
			  }
                     ";":

		       {
			yyunlex(c)
			  }
		       "]":
		       {
			yyunlex(c)
			  }
 
		EOF: {
			exit(1)
			  }
		default:{ 
                        yyunlex(c)
			  yyunlex("]") 
			  }
                }
		$$ := emptylist()
	      }

    ;
Opt.Colon :
    COLON
	{ $$ := TRUE }
    |
	{ $$ := FALSE }
    ;
Opt.Parameters :
    Parameters  =
        { $$ := $1 }
    |  =
        { $$ := emptylist() }
    ;
Opt.Parameter.list :
    Opt.Parameters =
        { $$ := $1 }
    | Opt.Parameter.list ';' Opt.Parameters =
        { $$ := conc($1,$3) }
    ;
Id.list :
    ID  =
        { $$ := mklist([$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 = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  $$ := mknode([TYPESIGNATURE,$11,$13,$5,$6,$7,$9])
	  $$ . ts_string_max := $8
	  $$ . ts_simple_type := $3
	}
    | TYPE "(" Opt.Simple CONSTANTS QSTRING QSTRING QSTRING UQSTRING ")"
      Opt.Id  "{" Opt.TypeSignatureComponent.list "}"  =
	{ 
	  if (initflag = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  $$ := mknode([TYPESIGNATURE,$10,$12,$5,$6,$7,nil])
	  $$ . ts_string_max := $8
	  $$ . ts_simple_type := $3
	}
    | TYPE "(" Opt.Simple CONSTANTS QSTRING QSTRING QSTRING ")"
      Opt.Id  "{" Opt.TypeSignatureComponent.list "}"  =
	{ 
	  if (initflag = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  $$ := mknode([TYPESIGNATURE,$9,$11,$5,$6,$7,nil])
	  $$ . ts_string_max := -1
	  $$ . ts_simple_type := $3
	}
    | TYPE "(" Opt.Simple CONSTANTS QSTRING ")"
      Opt.Id  "{" Opt.TypeSignatureComponent.list "}"  =
	{ 
	  if (initflag = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  $$ := mknode([TYPESIGNATURE,$7,$9,$5,nil,nil,nil])
	  $$ . ts_string_max := -1
	  $$ . ts_simple_type := $3
	}
    | TYPE "(" Opt.Simple ")"
      Opt.Id  "{" Opt.TypeSignatureComponent.list "}"  =
	{ 
	  if (initflag = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  $$ := mknode([TYPESIGNATURE,$5,$7,nil,nil,nil,nil])
	  $$ . ts_string_max := -1
	  $$ . ts_simple_type := $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) then {
	    $$ := TRUE 
	  } else {
	    yywarn("Compiler directive not understood")
	    $$ := FALSE
	  }
	  vfree($1)
	}
    |     =
	{ $$ := FALSE }
    ;
Opt.InLine :
    "(" ID QSTRING ")"
	{
	  if (initflag = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  if ($2 . id_str_table_index = indx_inline) then {
	    $$ := ((*inline_cnvt)($3))
	  } else {
	    yywarn("Compiler directive not understood")
	    $$ := nil
	  }
	  vfree($2)
	}
    |      =
	{ $$ := nil }
    ;
Special :
    "(" ID ID UQSTRING ")"
	{
	  local num_arg
	  if (initflag = FALSE) then {
	    yywarn("Compiler directive outside initialization")
	  }
	  if ($2 . id_str_table_index = indx_standard) then {
	    num_arg := $4

	    if ($3 . id_str_table_index = indx_New) then {
		$$ := special(STD_NEW, num_arg)
	    } else if ($3 . id_str_table_index = indx_ptr_New) then {
		$$ := special(PTR_NEW, num_arg)
	    } else if ($3 . id_str_table_index = indx_init_New) then {
		$$ := special(INIT_NEW, num_arg)
	    } else if ($3 . id_str_table_index = indx_ValueOf) then {
		$$ := special(STD_VALUEOF, num_arg)
	    } else if ($3 . id_str_table_index = indx_assign) then {
		$$ := special(STD_ASSIGN, num_arg)
	    } else if ($3 . id_str_table_index = indx_put) then {
		$$ := special(STD_PUT, num_arg)
	    } else if ($3 . id_str_table_index = indx_Callcc) then {
		$$ := special(STD_CALLCC, num_arg)
	    } else if ($3 . id_str_table_index = indx_Array) then {
		$$ := special(STD_ARRAY, num_arg)
	    } else if ($3 . id_str_table_index = indx_passign) then {
		$$ := special(STD_PASSIGN, num_arg)
	    } else if ($3 . id_str_table_index = indx_massign) then {
		$$ := 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 := $2
	}
    | FUNC Opt.InLine "[" Opt.Parameter.list "]" Signature =
	{
	  $$ := mknode([FUNCSIGNATURE,$2,$4,$6])
	  if (\$2) then {
	    $$ . 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 = FALSE) then {
		yyperror("Missing colon in type component")
	    }
	  lock($1) 
          lock($3)
	  if ($3 . kind = VARSIGNATURE) then {
	    yyperror("Variable as type signature component")
	  }
          $$ := split(TSCOMPONENT, $1, $3)
          vfree(unlock($1)) 
          vfree(unlock($3))
        }
    | Id.list Opt.Colon Opt.Readonly FIELD BasicDenotation  =
        {
	  if ($2 := FALSE) then {
	      yyperror("Missing colon in field specification")
	  }
          vl_field_sig := mknode([FUNCSIGNATURE,
                                nil, 
                                mklist([mknode([PARAMETER,
                                              nil,
                                              mknode([VALSIGNATURE,
                                                     mknode([LETTERID])])])
                                       ]),
                                mknode([VALSIGNATURE, $5])])
          lock($1) 
          lock($5)
          if ( is_present($3) ) then {
            $$ := split(TSCOMPONENT,$1,vl_field_sig)
          } else {
            vr_field_sig := mknode([FUNCSIGNATURE,
                                  nil, 
                                  mklist([mknode([PARAMETER,
                                                nil,
                                                mknode([VARSIGNATURE,
                                                       mknode([LETTERID])])])
                                         ]),
                                  mknode([VARSIGNATURE, $5])])
            $$ := conc(split(TSCOMPONENT,$1,vl_field_sig),
                      split(TSCOMPONENT,$1,vr_field_sig))
          }
          vfree(unlock($1)) 
          vfree(unlock($5))
        }
    | ID =
        { 
            case ($1 . kind) of {
	    OPRID: {
                    i := $1 . id_str_table_index
                    if ( i = indx_assign ) then
                        result := mknode([TSCOMPONENT,$1,sig_assign])
		      else if ((i = indx_less) | (i = indx_le )) then
                        result := mknode([TSCOMPONENT,$1,sig_less])
			else if (( i = indx_greater) | (i = indx_ge )) then
                        result := mknode([TSCOMPONENT,$1,sig_greater])
			  else if ( (i = indx_equals) | (i = indx_ne) ) then
			result := mknode([TSCOMPONENT,$1,sig_equals])
		    else if (i = indx_sconc ) then
			result := mknode([TSCOMPONENT,$1,sig_sconc])
		    else if ( i = indx_pconc ) then
			result := mknode([TSCOMPONENT,$1,sig_pconc])
                    else 
			yyperror("Missing signature")
			  }
	    LETTERID: {
                    i := $1 . id_str_table_index
                    if ( i = indx_New ) then
                        result := mknode([TSCOMPONENT,$1,sig_New])
                    else if ( i = indx_ValueOf ) then
                        result := mknode([TSCOMPONENT,$1,sig_ValueOf])
                    else if ( *(getname(i)) = "\"" ) then
                        result := mknode([TSCOMPONENT,$1,sig_const])
                    else
			yyperror("Missing signature")
			  }

	    default: {
                        rpt_err("parser: incorrect id structure")
	    }
            }
            $$ := mklist([result])
        }
    | CHARACTERS  =
        {
		$$ := mklist([mknode([DEFCHARSIGS, RCS0, RCS1, RCS2, RCS3])])
	}
    | error
	{
	    yyperror("Error in type signature component")
	    $$ := emptylist()
	}
    ;
Opt.Readonly :
    READONLY =
        { $$ := PRESENT }
    |   =
        { $$ := NOTPRESENT }
    ;
Denotation :
    ManifestSignature
	{ $$ := $1 }
    | BasicDenotation
    ;
BasicDenotation:
    Primary.list  =
        {
            lock($1)
            $$ := mkappl($1)
            lock($$)
            vfree(unlock($1))
            unlock($$)
        }
    | "\002" 
                =
        {
            if (initflag = FALSE) then {
		yyperror("use of insertion character in non-initialization run")
            } else {
		$$ := insrtptr := mknode([BLOCKDENOTATION,emptylist(),nil])
		insrtptr . bld_precedence := INFINITE
            }
        }
    ;
Primary.list :
    Primary =
        { $$ := mklist([$1]) }
    | ArgList
        { $$ := mklist([$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 ")"
    { local  prec, p
          if (first($2) = last($2)) then {
                             $$ := 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 =
      {
	
	  prec := precedence( last($4) )
	  $$ := p := mknode([BLOCKDENOTATION,$2,$4])
	  p . bld_precedence := prec
	}
    | USE Opt.Denotation.list IN Denotation.seq NI =
      { 
	  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([$1]) }
    | error 
	       {  local c

		    yyperror("Error in Expression Sequence")
		   c := yychar
		   while not(in(c, denseqstop)) do 
			    c := yylex()
		    yyclearin
		    case (c) of {
                         ";":
                            yyunlex(c)
                         "#":
                            yyunlex(c)
			 FI:
                            yyunlex(c)
			 ELSIF:
                            yyunlex(c)
			 ELSE:
                            yyunlex(c)
                         OD:
                            yyunlex(c)
                         ")":
                            yyunlex(c)
                         "NI":
                            yyunlex(c)
                         "}":
                            yyunlex(c)
                         IF:
                         {
                            yyunlex(c)
                            yyunlex(";")
			 }
                         DO:
                         {
                            yyunlex(c)
                            yyunlex(";")
			 }
                         LET:
                         {
                            yyunlex(c)
                            yyunlex(";")
			 }
                         FUNC:
                         {
                            yyunlex(c)
                            yyunlex(";")
			 }
                         "(": 
                         {
                            yyunlex(c)
                            yyunlex(";")
			 }
		       WITH: {
                            yyunlex(c)
                            yyunlex(WORDID)
                            yyunlex(";")
		       }
		       IN: {
                            yyunlex(c)
                            yyunlex(LET)
                            yyunlex(";")
		       }
		       EOF: {
			 exit(1)
                          }
                        default:
                            yyunlex(c)
                    }
		    $$ := mklist([id_Integer]) 
	       }
    ;
Opt.Denotation :
    Denotation  =
        { $$ := $1 }
    |  =
        { $$ := nil }
    ;
FuncConstruction :
    IncompleteFuncSignature "{" Denotation.seq "}" =
	{ 
	  if (length($3) = 1) then {
	      $$ := mknode([FUNCCONSTR,$1,first($3)])
	  } else {
	      $$ := mknode([FUNCCONSTR,$1,
			      mknode([BLOCKDENOTATION,emptylist(),$3])])
	      $$.fc_body.bld_precedence := INFINITE 
	  }
	  $1 . fsig_construction := $$
	  if (initflag = TRUE) then {
	    global_fn_count := global_fn_count + 1
	    $$ . fc_code_label := "fn_global_" || global_fn_count
	  }
	}
    | IncompleteFuncSignature "{" EXTERN QSTRING "}" =
	{
	  if (/($1 . fsig_result_sig)) then {
	    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 := $2
	}
    | FUNC Opt.InLine "[" Opt.Parameter.list "]"  =
	{ $$ := mknode([FUNCSIGNATURE, $2, $4, nil]) }
    
Selection :
    Primary "$" ID Opt.SigClause =
        { 
	$3.sel_type :=  $1
	$3.signature := $4
            $$ := $3
        }
    | Primary "$" STRING =
        {
	$3.sel_type := $1
            $$ := $3
        }
    | ID Opt.SigClause =
        { 
	$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([$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 =
        { 
            lock($1) 
	    lock($2) 
	    lock($4)
	    $$ := q := split(DECLARATION,$1,$4,$2)
	  temp := q.cn_hd_field
	  while \temp do {
	    p := temp.cn_hd_field
	    p . decl_sig_transp := TRUE
	    temp := temp.cn_tl_field
	    }
            vfree(unlock($1)) 
	    vfree(unlock($2)) 
	    vfree(unlock($4))
        }
    |   =
        { $$ := emptylist() }
      | error
           { 
		i := 0

		yyperror("Error in declaration")
		c := yychar
		  while not (in(c, declstop)) do {
		    i +:= 1
                    if ( i > maxskip ) then {
			break
		      }
		        c := yylex() 
		      
                      }
                yyclearin
                case (c)  of {
		EQUALS_EQUALS: {
                        yyunlex(c)
                        yyunlex(WORDID)
                        yyunlex(";")
			  }
                     ";" :
                        yyunlex(c)
                     "}" :
                        yyunlex(c)
                     IN:
                        yyunlex(c)
		       NI:  {
                        yyunlex(c)
                        yyunlex(WORDID)
                        yyunlex(IN)
			  }
                     IF:
		       {
                        yyunlex(c)
                        yyunlex(EQUALS_EQUALS)
                        yyunlex(WORDID)
			  }
                     DO:
		       {
                        yyunlex(c)
                        yyunlex(EQUALS_EQUALS)
                        yyunlex(WORDID)
			  }
                     LET:
		       {
                        yyunlex(c)
                        yyunlex(EQUALS_EQUALS)
                        yyunlex(WORDID)
			  }
                     "(": 
		       {
                        yyunlex(c)
                        yyunlex(EQUALS_EQUALS)
                        yyunlex(WORDID)
			  }
		     EOF:
			exit(1)
		default : {
                        yyunlex(c)
                        yyunlex(NI)
                        yyunlex(IN)
			  }
                }
		$$ := 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 "}"  =
        { 
	temp := $4.cn_hd_field
	while \temp do {
	      s := temp.cn_hd_field
	      if (/(s . par_id)) then {
		yyperror("Anonymous fields not allowed in product")
		}
	       temp := temp.cn_tl_field
	      }
	  $$ := 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 "}" =
        {

	temp := $4.cn_hd_field
	while \temp do {
	  s := temp. cn_hd_field
	      if (/(s . par_id)) then {
		yyperror("Anonymous fields not allowed in union")
            }
	  
	  temp := temp.cn_tl_field
	  }
          $$ := 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 = FALSE) then {
		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([$1,$2,$4])  }
    | EXPORT error
	{ yyperror("Error in \"export\" type modification") }
    | HIDE error
	{ yyperror("Error in \"hide\" type modification") }
    ;
Start.ExportList :
    EXPORT =
        { $$ := EXPORTLIST }
    | HIDE =
        { $$ := HIDELIST }
    ;
ExportElement.list :
    ExportElement =
        { $$ := mklist([$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 }
    |
	{
	    $$ := appl_Null
	}
    ;
ElseList :
    ELSE Denotation.seq
	{
	    if (length($2) = 1) then {
		$$ := first($2)
	    } else {
		p := mknode([BLOCKDENOTATION, emptylist(), $2])
		$$ := p
		p . bld_precedence := INFINITE
	    }
	}
    | ELSIF Denotation THEN Denotation.seq Opt.ElseList
	{
	  local ge1, ge2  

	    if (length($4) = 1) then {
		ge1 := mknode([GUARDEDELEMENT,$2,first($4)])
	    } else {
		ge1 := mknode([GUARDEDELEMENT,$2,
			    mknode([BLOCKDENOTATION,emptylist(),$4])])
		ge1.ge_element.bld_precedence := INFINITE 
	    }
		    ge2 := mknode([GUARDEDELEMENT, mknode([WORDELSE]), $5])
	    $$ := mknode([GUARDEDLIST, mklist([ge1, ge2])])
	}
    ;
GuardedDenotation.list :
    GuardedDenotation =
        { $$ := mklist([$1]) }
    | GuardedDenotation.list "#" GuardedDenotation =
	{ $$ := addright($1,$3) }
    | Denotation THEN Denotation.seq Opt.ElseList
	{
	  local ge1, ge2

	    if (length($3) = 1) then {
		ge1 := mknode([GUARDEDELEMENT,$1,first($3)])
	    } else {
		ge1 := mknode([GUARDEDELEMENT,$1,
			    mknode([BLOCKDENOTATION,emptylist(),$3])])
		ge1.ge_element.bld_precedence := INFINITE 
	    }
	    ge2 := mknode([GUARDEDELEMENT, mknode([WORDELSE]), $4])
	    $$ := mklist([ge1, ge2])
	}
    | error 
    { local i, c   
	  i := 0

	  yyperror("Error in Loop or If")
		c := yychar
		  while not (in(c, condstop)) do {
		    i +:= 1
                    if ( i > maxskip ) then {
			break
		      }
		        c := yylex() 
		      
                      }
          yyclearin
          case (c) of {
               "#" :
                  yyunlex(c)
               FI :
                  yyunlex(c)
               OD :
                  yyunlex(c)
	       RIGHT_ARROW :
		 {
		  yyunlex(RIGHT_ARROW) 
		 yyunlex(WORDID) 
		 yyunlex("#") 
		    }
	       ELSE :
		 {
		  yyunlex(RIGHT_ARROW) 
		 yyunlex(WORDID) 
		 yyunlex("#") 
		    }
	       THEN :
		 {
		  yyunlex(RIGHT_ARROW) 
		 yyunlex(WORDID) 
		 yyunlex("#") 
		    }
		 ";" : 
		 {
		  yyunlex(RIGHT_ARROW) 
		 yyunlex(WORDID) 
		 yyunlex("#") 
		    }
               LET :
		 {
                  yyunlex(c)
                  yyunlex(RIGHT_ARROW)
                  yyunlex(WORDID)
                  yyunlex("#")
		    }
               "(" :
		 {
                  yyunlex(c)
                  yyunlex(RIGHT_ARROW)
                  yyunlex(WORDID)
                  yyunlex("#")
		    }
               DO :
		 {
                  yyunlex(c)
                  yyunlex(RIGHT_ARROW)
                  yyunlex(WORDID)
                  yyunlex("#")
		    }
		 IF :
		 {
                  yyunlex(c)
                  yyunlex(RIGHT_ARROW)
                  yyunlex(WORDID)
                  yyunlex("#")
		    }
	       EOF:
		  exit(1)
	  default : 
		 {
                  yyunlex(c) 
		    yyunlex(END)
		    }
          }
	  $$ := emptylist()
        }
    ;
GuardedDenotation :
    Guard RIGHT_ARROW Denotation.seq =
	{ 
	  if (length($3) = 1) then {
		$$ := mknode([GUARDEDELEMENT,$1,first($3)])
	    } else {
		p := mknode([GUARDEDELEMENT,$1,
				mknode([BLOCKDENOTATION,emptylist(),$3])])
		$$:= p
		p.ge_element.bld_precedence := INFINITE 
	    }
	}
    ;
ID :
    WORDID =
        { $$ := mknode([LETTERID,$1]) }
    | OPID =
        { $$ := mknode([OPRID,$1]) }
    
STRING :
    QSTRING =
        { $$ := mknode([QSTR,$1]) }
    | UQSTRING =
        { $$ := mknode([UQSTR,$1]) }
    ;
%%