import Miranda 2.066 from upstream

1 files changed, 1686 insertions, 0 deletions

diff --git a/new/rules.y b/new/rules.y
new file mode 100644
index 0000000..e44698b
--- /dev/null
+++ b/new/rules.y
@@ -0,0 +1,1686 @@
+/* Miranda token declarations and syntax rules for "YACC" */
+
+/**************************************************************************
+ * Copyright (C) Research Software Limited 1985-90.  All rights reserved. *
+ * The Miranda system is distributed as free software under the terms in  *
+ * the file "COPYING" which is included in the distribution.              *
+ *------------------------------------------------------------------------*/
+
+/* miranda symbols */
+
+%token VALUE EVAL WHERE IF TO LEFTARROW  COLONCOLON  COLON2EQ
+       TYPEVAR  NAME  CNAME  CONST  DOLLAR2  OFFSIDE  ELSEQ
+       ABSTYPE WITH DIAG EQEQ FREE INCLUDE  EXPORT  TYPE
+       OTHERWISE  SHOWSYM  PATHNAME  BNF  LEX  ENDIR  ERRORSY ENDSY
+       EMPTYSY READVALSY LEXDEF CHARCLASS ANTICHARCLASS LBEGIN
+
+%right ARROW
+%right PLUSPLUS ':' MINUSMINUS
+%nonassoc DOTDOT
+%right VEL
+%right '&'
+%nonassoc '>' GE '=' NE LE '<'
+%left '+' '-'
+%left '*'  '/' REM DIV
+%right '^'
+%left '.'   /* fiddle to make '#' behave */
+%left '!'
+%right INFIXNAME INFIXCNAME
+%token CMBASE  /* placeholder to start combinator values - see combs.h */
+
+%{
+/* the following definition has to be kept in line with the token declarations
+   above */
+char *yysterm[]= {
+ 0,
+ "VALUE",
+ "EVAL",
+ "where",
+ "if",
+ "&>",
+ "<-",
+ "::",
+ "::=",
+ "TYPEVAR",
+ "NAME",
+ "CONSTRUCTOR-NAME",
+ "CONST",
+ "$$",
+ "OFFSIDE",
+ "OFFSIDE =",
+ "abstype",
+ "with",
+ "//",
+ "==",
+ "%free",
+ "%include",
+ "%export",
+ "type",
+ "otherwise",
+ "show",
+ "PATHNAME",
+ "%bnf",
+ "%lex",
+ "%%",
+ "error",
+ "end",
+ "empty",
+ "readvals",
+ "NAME",
+ "`char-class`",
+ "`char-class`",
+ "%%begin",
+ "->",
+ "++",
+ "--",
+ "..",
+ "\\/",
+ ">=",
+ "~=",
+ "<=",
+ "mod",
+ "div",
+ "$NAME",
+ "$CONSTRUCTOR"};
+
+%}
+
+/* Miranda syntax rules */
+/* the associated semantic actions perform the compilation */
+
+%{
+#include "data.h"
+#include "lex.h"
+extern word nill,k_i,Void;
+extern word message,standardout;
+extern word big_one;
+#define isltmess_t(t) (islist_t(t)&&tl[t]==message)
+#define isstring_t(t) (islist_t(t)&&tl[t]==char_t)
+extern word SYNERR,errs,echoing,gvars;
+extern word listdiff_fn,indent_fn,outdent_fn;
+extern word polyshowerror;
+word lastname=0;
+word suppressids=NIL;
+word idsused=NIL;
+word tvarscope=0;
+word includees=NIL,embargoes=NIL,exportfiles=NIL,freeids=NIL,exports=NIL;
+word lexdefs=NIL,lexstates=NIL,inlex=0,inexplist=0;
+word inbnf=0,col_fn=0,fnts=NIL,eprodnts=NIL,nonterminals=NIL,sreds=0;
+word ihlist=0,ntspecmap=NIL,ntmap=NIL,lasth=0;
+word obrct=0;
+
+void evaluate(x)
+word x;
+{ extern word debug;
+  word t;
+  t=type_of(x);
+  if(t==wrong_t)return;
+  lastexp=x;
+  x=codegen(x);
+  if(polyshowerror)return;
+  if(process())
+                 /* setup new process for each evaluation */
+  { (void)signal(SIGINT,(sighandler)dieclean);
+      /* if interrupted will flush output etc before going */
+    compiling=0;
+    resetgcstats();
+    output(isltmess_t(t)?x:
+            cons(ap(standardout,isstring_t(t)?x
+                           :ap(mkshow(0,0,t),x)),NIL));
+    (void)signal(SIGINT,SIG_IGN);/* otherwise could do outstats() twice */
+    putchar('\n');
+    outstats();
+    exit(0); }
+}
+
+void obey(x) /* like evaluate but no fork, no stats, no extra '\n' */
+word x;
+{ word t=type_of(x);
+  x=codegen(x);
+  if(polyshowerror)return;
+  compiling=0;
+  output(isltmess_t(t)?x:
+            cons(ap(standardout,isstring_t(t)?x:ap(mkshow(0,0,t),x)),NIL));
+}
+
+int isstring(x)
+word x;
+{ return(x==NILS||tag[x]==CONS&&is_char(hd[x]));
+}
+
+word compose(x) /* used in compiling 'cases' */
+word x;
+{ word y=hd[x];
+  if(hd[y]==OTHERWISE)y=tl[y]; /* OTHERWISE was just a marker - lose it */
+  else y=tag[y]==LABEL?label(hd[y],ap(tl[y],FAIL)):
+         ap(y,FAIL); /* if all guards false result is FAIL */
+  x = tl[x];
+  if(x!=NIL)
+    { while(tl[x]!=NIL)y=label(hd[hd[x]],ap(tl[hd[x]],y)), x=tl[x];
+      y=ap(hd[x],y);
+     /* first alternative has no label - label of enclosing rhs applies */
+    }
+  return(y);
+}
+
+word starts(x) /* x is grammar rhs - returns list of nonterminals in start set */
+word x;
+{ L: switch(tag[x])
+     { case ID: return(cons(x,NIL));
+       case LABEL:
+       case LET:
+       case LETREC: x=tl[x]; goto L;
+       case AP: switch(hd[x])
+                { case G_SYMB:
+                  case G_SUCHTHAT:
+                  case G_RULE: return(NIL);
+                  case G_OPT:
+                  case G_FBSTAR:
+                  case G_STAR: x=tl[x]; goto L;
+                  default: if(hd[x]==outdent_fn)
+                             { x=tl[x]; goto L; }
+                           if(tag[hd[x]]==AP)
+                             if(hd[hd[x]]==G_ERROR)
+                               { x=tl[hd[x]]; goto L; }
+                             if(hd[hd[x]]==G_SEQ)
+                               { if(eprod(tl[hd[x]]))
+                               return(UNION(starts(tl[hd[x]]),starts(tl[x])));
+                                 x=tl[hd[x]]; goto L; } else
+                             if(hd[hd[x]]==G_ALT)
+                               return(UNION(starts(tl[hd[x]]),starts(tl[x])));
+                             else
+                             if(hd[hd[x]]==indent_fn)
+                               { x=tl[x]; goto L; }
+                }
+       default: return(NIL);
+     }
+}
+
+int eprod(x) /* x is grammar rhs - does x admit empty production? */
+word x;
+{ L: switch(tag[x])
+     { case ID: return(member(eprodnts,x));
+       case LABEL:
+       case LET:
+       case LETREC: x=tl[x]; goto L;
+       case AP: switch(hd[x])
+                { case G_SUCHTHAT:
+                  case G_ANY:
+                  case G_SYMB: return(0);
+                  case G_RULE: return(1);
+                  case G_OPT:
+                  case G_FBSTAR:
+                  case G_STAR: return(1);
+                  default: if(hd[x]==outdent_fn)
+                             { x=tl[x]; goto L; }
+                           if(tag[hd[x]]==AP)
+                             if(hd[hd[x]]==G_ERROR)
+                               { x=tl[hd[x]]; goto L; }
+                             if(hd[hd[x]]==G_SEQ)
+                               return(eprod(tl[hd[x]])&&eprod(tl[x])); else
+                             if(hd[hd[x]]==G_ALT)
+                               return(eprod(tl[hd[x]])||eprod(tl[x]));
+                             else
+                             if(hd[hd[x]]==indent_fn)
+                               { x=tl[x]; goto L; }
+                }
+       default: return(x==G_STATE||x==G_UNIT);
+       /* G_END is special case, unclear whether it counts as an e-prodn.
+          decide no for now, sort this out later */
+     }
+}
+
+word add_prod(d,ps,hr)
+word d,ps,hr;
+{ word p,n=dlhs(d);
+  for(p=ps;p!=NIL;p=tl[p])
+  if(dlhs(hd[p])==n)
+     if(dtyp(d)==undef_t&&dval(hd[p])==UNDEF)
+       { dval(hd[p])=dval(d); return(ps); } else
+     if(dtyp(d)!=undef_t&&dtyp(hd[p])==undef_t)
+       { dtyp(hd[p])=dtyp(d); return(ps); }
+     else
+       errs=hr,
+       printf(
+      "%ssyntax error: conflicting %s of nonterminal \"%s\"\n",
+               echoing?"\n":"",
+               dtyp(d)==undef_t?"definitions":"specifications",
+               get_id(n)),
+       acterror();
+  return(cons(d,ps));
+}
+/* clumsy - this algorithm is quadratic in number of prodns - fix later */
+
+word getloc(nt,prods)  /* get here info for nonterminal */
+word nt,prods;
+{ while(prods!=NIL&&dlhs(hd[prods])!=nt)prods=tl[prods];
+  if(prods!=NIL)return(hd[dval(hd[prods])]);
+  return(0);  /* should not happen, but just in case */
+}
+
+void findnt(nt) /* set errs to here info of undefined nonterminal */
+word nt;
+{ word p=ntmap;
+  while(p!=NIL&&hd[hd[p]]!=nt)p=tl[p];
+  if(p!=NIL)
+    { errs=tl[hd[p]]; return; }
+  p=ntspecmap;
+  while(p!=NIL&&hd[hd[p]]!=nt)p=tl[p];
+  if(p!=NIL)errs=tl[hd[p]];
+}
+
+#define isap2(fn,x) (tag[x]==AP&&tag[hd[x]]==AP&&hd[hd[x]]==(fn))
+#define firstsymb(term) tl[hd[term]]
+
+void binom(rhs,x)
+/* performs the binomial optimisation on rhs of nonterminal x
+    x: x alpha1| ... | x alphaN | rest     ||need not be in this order
+        ==>
+    x: rest (alpha1|...|alphaN)*
+*/
+word rhs,x;
+{ word *p= &tl[rhs];  /* rhs is of form label(hereinf, stuff) */
+  word *lastp=0,*holdrhs,suffix,alpha=NIL;
+  if(tag[*p]==LETREC)p = &tl[*p]; /* ignore trailing `where defs' */
+  if(isap2(G_ERROR,*p))p = &tl[hd[*p]];
+  holdrhs=p;
+  while(isap2(G_ALT,*p))
+    if(firstsymb(tl[hd[*p]])==x)
+       alpha=cons(tl[tl[hd[*p]]],alpha),
+       *p=tl[*p],p = &tl[*p];
+    else lastp=p,p = &tl[tl[*p]];
+    /* note each (G_ALT a b) except the outermost is labelled */
+  if(lastp&&firstsymb(*p)==x)
+    alpha=cons(tl[*p],alpha),
+    *lastp=tl[hd[*lastp]];
+  if(alpha==NIL)return;
+  suffix=hd[alpha],alpha=tl[alpha];
+  while(alpha!=NIL)
+       suffix=ap2(G_ALT,hd[alpha],suffix),
+       alpha=tl[alpha];
+  *holdrhs=ap2(G_SEQ,*holdrhs,ap(G_FBSTAR,suffix));
+}
+/* should put some labels on the alpha's - fix later */
+
+word getcol_fn()
+{ extern char *dicp,*dicq;
+  if(!col_fn)
+    strcpy(dicp,"bnftokenindentation"),
+    dicq=dicp+20,
+    col_fn=name();
+  return(col_fn);
+}
+
+void startbnf()
+{ ntspecmap=ntmap=nonterminals=NIL; 
+  if(fnts==0)col_fn=0; /* reinitialise, a precaution */
+}
+
+word ih_abstr(x)  /* abstract inherited attributes from grammar rule */
+word x;
+{ word ih=ihlist;
+  while(ih!=NIL)  /* relies on fact that ihlist is reversed */
+       x=lambda(hd[ih],x),ih=tl[ih];
+  return(x);
+}
+
+int can_elide(x) /* is x of the form $1 applied to ih attributes in order? */
+word x;
+{ word ih;
+  if(ihlist)
+    for(ih=ihlist;ih!=NIL&&tag[x]==AP;ih=tl[ih],x=hd[x])
+       if(hd[ih]!=tl[x])return(0);
+  return(x==mkgvar(1));
+}
+
+int e_re(x) /* does regular expression x match empty string ? */
+{ L: if(tag[x]==AP)
+       { if(hd[x]==LEX_STAR||hd[x]==LEX_OPT)return(1);
+         if(hd[x]==LEX_STRING)return(tl[x]==NIL);
+         if(tag[hd[x]]!=AP)return(0);
+         if(hd[hd[x]]==LEX_OR)
+           { if(e_re(tl[hd[x]]))return(1);
+             x=tl[x]; goto L; } else
+         if(hd[hd[x]]==LEX_SEQ)
+           { if(!e_re(tl[hd[x]]))return(0);
+             x=tl[x]; goto L; } else
+         if(hd[hd[x]]==LEX_RCONTEXT)
+           { x=tl[hd[x]]; goto L; }
+       }
+     return(0);
+}
+
+%}
+
+%%
+
+entity:  /* the entity to be parsed is either a definition script or an
+            expression (the latter appearing as a command line) */
+
+    error|
+
+    script
+        = { lastname=0; /* outstats(); */  }|
+                        /* statistics not usually wanted after compilation */
+
+/*  MAGIC exp '\n' script
+        =  { lastexp=$2; }| /* change to magic scripts 19.11.2013 */
+
+    VALUE exp
+        =  { lastexp=$2; }| /* next line of `$+' */
+
+    EVAL exp
+        = { if(!SYNERR&&yychar==0)
+              { evaluate($2); }
+          }|
+
+    EVAL exp COLONCOLON
+            /* boring problem - how to make sure no junk chars follow here?
+               likewise TO case -- trick used above doesn't work, yychar is
+               here always -1 Why? Too fiddly to bother with just now */
+          = { word t=type_of($2);
+              if(t!=wrong_t)
+                { lastexp=$2;
+                  if(tag[$2]==ID&&id_type($2)==wrong_t)t=wrong_t;
+                  out_type(t);
+                  putchar('\n'); }
+            }|
+
+    EVAL exp TO
+        = { FILE *fil=NULL,*efil;
+            word t=type_of($2);
+            char *f=token(),*ef;
+            if(f)keep(f); ef=token(); /* wasteful of dic space, FIX LATER */
+            if(f){ fil= fopen(f,$3?"a":"w");
+                   if(fil==NULL)
+                     printf("cannot open \"%s\" for writing\n",f); }
+            else printf("filename missing after \"&>\"\n");
+            if(ef)
+              { efil= fopen(ef,$3?"a":"w");
+                if(efil==NULL)
+                  printf("cannot open \"%s\" for writing\n",ef); }
+            if(t!=wrong_t)$2=codegen(lastexp=$2);
+            if(polyshowerror)return;
+            if(t!=wrong_t&&fil!=NULL&&(!ef||efil))
+            { word pid;/* launch a concurrent process to perform task */
+              sighandler oldsig;
+              oldsig=signal(SIGINT,SIG_IGN); /* ignore interrupts */
+              if(pid=fork())
+                { /* "parent" */
+                  if(pid==-1)perror("cannot create process");
+                  else printf("process %d\n",pid);
+                  fclose(fil);
+                  if(ef)fclose(efil);
+                  (void)signal(SIGINT,oldsig); }else
+              { /* "child" */
+                (void)signal(SIGQUIT,SIG_IGN);   /* and quits */
+#ifndef SYSTEM5
+                (void)signal(SIGTSTP,SIG_IGN);   /* and stops */
+#endif
+                close(1); dup(fileno(fil));  /* subvert stdout */
+                close(2); dup(fileno(ef?efil:fil)); /* subvert stderr */
+                /* FUNNY BUG - if redirect stdout stderr to same file by two
+                   calls to freopen, their buffers get conflated - whence do
+                   by subverting underlying file descriptors, as above
+                   (fix due to Martin Guy) */
+                /* formerly used dup2, but not present in system V */
+                fclose(stdin);
+                /* setbuf(stdout,NIL); 
+		/* not safe to change buffering of stream already in use */
+		/* freopen would have reset the buffering automatically */
+                lastexp = NIL;  /* what else should we set to NIL? */
+                /*atcount= 1; */
+                compiling= 0;
+                resetgcstats();
+                output(isltmess_t(t)?$2:
+                        cons(ap(standardout,isstring_t(t)?$2:
+                                       ap(mkshow(0,0,t),$2)),NIL));
+                putchar('\n');
+                outstats();
+                exit(0); } } };
+
+script:
+    /* empty */|
+    defs;
+
+exp:
+    op | /* will later suppress in favour of (op) in arg */
+    e1;
+
+op:
+    '~'
+        =  { $$ = NOT; }|
+    '#'
+        =  { $$ = LENGTH; }|
+    diop;
+
+diop:
+    '-'
+        =  { $$ = MINUS; }|
+    diop1;
+
+diop1:
+    '+'
+        =  { $$ = PLUS; }|
+    PLUSPLUS
+        =  { $$ = APPEND; }|
+    ':'
+        =  { $$ = P; }|
+    MINUSMINUS
+        =  { $$ = listdiff_fn; }|
+    VEL
+        =  { $$ = OR; }|
+    '&'
+        =  { $$ = AND; }|
+    relop |
+    '*'
+        =  { $$ = TIMES; }|
+    '/'
+        =  { $$ = FDIV; }|
+    DIV
+        =  { $$ = INTDIV; }|
+    REM
+        =  { $$ = MOD; }|
+    '^'
+        =  { $$ = POWER; }|
+    '.'
+        =  { $$ = B; }|
+    '!'
+        =  { $$ = ap(C,SUBSCRIPT); }|
+    INFIXNAME|
+    INFIXCNAME;
+
+relop:
+    '>'
+        = { $$ = GR; }|
+    GE
+        = { $$ = GRE; }|
+    eqop
+        = { $$ = EQ; }|
+    NE
+        = { $$ = NEQ; }|
+    LE
+        = { $$ = ap(C,GRE); }|
+    '<'
+        = { $$ = ap(C,GR); };
+
+eqop:
+    EQEQ|  /* silently accept for benefit of Haskell users */
+    '=';
+
+rhs:
+    cases WHERE ldefs 
+        = { $$ = block($3,compose($1),0); }|
+    exp WHERE ldefs 
+        = { $$ = block($3,$1,0); }|
+    exp|
+    cases
+        =  { $$ = compose($1); };
+
+cases:
+    exp ',' if exp
+        =  { $$ = cons(ap2(COND,$4,$1),NIL); }|
+    exp ',' OTHERWISE
+        =  { $$ = cons(ap(OTHERWISE,$1),NIL); }|
+    cases reindent ELSEQ alt
+        =  { $$ = cons($4,$1); 
+             if(hd[hd[$1]]==OTHERWISE)
+               syntax("\"otherwise\" must be last case\n"); };
+
+alt:
+    here exp
+        =  { errs=$1,
+             syntax("obsolete syntax, \", otherwise\" missing\n");
+             $$ = ap(OTHERWISE,label($1,$2)); }|
+    here exp ',' if exp
+        =  { $$ = label($1,ap2(COND,$5,$2)); }|
+    here exp ',' OTHERWISE
+        =  { $$ = ap(OTHERWISE,label($1,$2)); };
+
+if:
+    /* empty */
+        = { extern word strictif;
+            if(strictif)syntax("\"if\" missing\n"); }|
+    IF;
+
+indent:
+    /* empty */
+        = { if(!SYNERR){layout(); setlmargin();}
+          };
+/* note that because of yacc's one symbol look ahead, indent must usually be
+   invoked one symbol earlier than the non-terminal to which it applies 
+   - see `production:' for an exception */
+
+outdent:
+    separator
+        = { unsetlmargin(); };
+
+separator:
+    OFFSIDE | ';' ;
+
+reindent:
+    /* empty */
+        = { if(!SYNERR)
+              { unsetlmargin(); layout(); setlmargin(); }
+          };
+ 
+liste:  /* NB - returns list in reverse order */
+    exp
+        = { $$ = cons($1,NIL); }|
+    liste ',' exp  /* left recursive so as not to eat YACC stack */
+        = { $$ = cons($3,$1); };
+
+e1:
+    '~' e1 %prec '='
+        = { $$ = ap(NOT,$2); }|
+    e1 PLUSPLUS e1
+        = { $$ = ap2(APPEND,$1,$3); }|
+    e1 ':' e1
+        = { $$ = cons($1,$3); }|
+    e1 MINUSMINUS e1
+        = { $$ = ap2(listdiff_fn,$1,$3);  }|
+    e1 VEL e1
+        = { $$ = ap2(OR,$1,$3); }|
+    e1 '&' e1
+        = { $$ = ap2(AND,$1,$3); }|
+    reln |
+    e2;
+
+es1:                     /* e1 or presection */
+    '~' e1 %prec '='
+        = { $$ = ap(NOT,$2); }|
+    e1 PLUSPLUS e1
+        = { $$ = ap2(APPEND,$1,$3); }|
+    e1 PLUSPLUS
+        = { $$ = ap(APPEND,$1); }|
+    e1 ':' e1
+        = { $$ = cons($1,$3); }|
+    e1 ':'
+        = { $$ = ap(P,$1); }|
+    e1 MINUSMINUS e1
+        = { $$ = ap2(listdiff_fn,$1,$3);  }|
+    e1 MINUSMINUS
+        = { $$ = ap(listdiff_fn,$1);  }|
+    e1 VEL e1
+        = { $$ = ap2(OR,$1,$3); }|
+    e1 VEL
+        = { $$ = ap(OR,$1); }|
+    e1 '&' e1
+        = { $$ = ap2(AND,$1,$3); }|
+    e1 '&'
+        = { $$ = ap(AND,$1); }|
+    relsn |
+    es2;
+
+e2:
+    '-' e2 %prec '-'
+        = { $$ = ap(NEG,$2); }|
+    '#' e2 %prec '.'
+        = { $$ = ap(LENGTH,$2);  }|
+    e2 '+' e2
+        = { $$ = ap2(PLUS,$1,$3); }|
+    e2 '-' e2
+        = { $$ = ap2(MINUS,$1,$3); }|
+    e2 '*' e2
+        = { $$ = ap2(TIMES,$1,$3); }|
+    e2 '/' e2
+        = { $$ = ap2(FDIV,$1,$3); }|
+    e2 DIV e2
+        = { $$ = ap2(INTDIV,$1,$3); } |
+    e2 REM e2
+        = { $$ = ap2(MOD,$1,$3); }|
+    e2 '^' e2
+        = { $$ = ap2(POWER,$1,$3); } |
+    e2 '.' e2
+        = { $$ = ap2(B,$1,$3);  }|
+    e2 '!' e2
+        = { $$ = ap2(SUBSCRIPT,$3,$1); }|
+    e3;
+
+es2:               /* e2 or presection */
+    '-' e2 %prec '-'
+        = { $$ = ap(NEG,$2); }|
+    '#' e2 %prec '.'
+        = { $$ = ap(LENGTH,$2);  }|
+    e2 '+' e2
+        = { $$ = ap2(PLUS,$1,$3); }|
+    e2 '+'
+        = { $$ = ap(PLUS,$1); }|
+    e2 '-' e2
+        = { $$ = ap2(MINUS,$1,$3); }|
+    e2 '-'
+        = { $$ = ap(MINUS,$1); }|
+    e2 '*' e2
+        = { $$ = ap2(TIMES,$1,$3); }|
+    e2 '*'
+        = { $$ = ap(TIMES,$1); }|
+    e2 '/' e2
+        = { $$ = ap2(FDIV,$1,$3); }|
+    e2 '/'
+        = { $$ = ap(FDIV,$1); }|
+    e2 DIV e2
+        = { $$ = ap2(INTDIV,$1,$3); } |
+    e2 DIV
+        = { $$ = ap(INTDIV,$1); } |
+    e2 REM e2
+        = { $$ = ap2(MOD,$1,$3); }|
+    e2 REM
+        = { $$ = ap(MOD,$1); }|
+    e2 '^' e2
+        = { $$ = ap2(POWER,$1,$3); } |
+    e2 '^'
+        = { $$ = ap(POWER,$1); } |
+    e2 '.' e2
+        = { $$ = ap2(B,$1,$3);  }|
+    e2 '.'
+        = { $$ = ap(B,$1);  }|
+    e2 '!' e2
+        = { $$ = ap2(SUBSCRIPT,$3,$1); }|
+    e2 '!'
+        = { $$ = ap2(C,SUBSCRIPT,$1); }|
+    es3;
+
+e3:
+    comb INFIXNAME e3
+        = { $$ = ap2($2,$1,$3); }|
+    comb INFIXCNAME e3
+        = { $$ = ap2($2,$1,$3); }|
+    comb;
+
+es3:                     /* e3 or presection */
+    comb INFIXNAME e3
+        = { $$ = ap2($2,$1,$3); }|
+    comb INFIXNAME
+        = { $$ = ap($2,$1); }|
+    comb INFIXCNAME e3
+        = { $$ = ap2($2,$1,$3); }|
+    comb INFIXCNAME
+        = { $$ = ap($2,$1); }|
+    comb;
+
+comb:
+    comb arg
+        = { $$ = ap($1,$2); }|
+    arg;
+
+reln:
+    e2 relop e2
+        = { $$ = ap2($2,$1,$3); }|
+    reln relop e2
+        = { word subject;
+            subject = hd[hd[$1]]==AND?tl[tl[$1]]:tl[$1];
+            $$ = ap2(AND,$1,ap2($2,subject,$3));
+          };  /* EFFICIENCY PROBLEM - subject gets re-evaluated (and
+                 retypechecked) - fix later */
+
+relsn:                     /* reln or presection */
+    e2 relop e2
+        = { $$ = ap2($2,$1,$3); }|
+    e2 relop
+        = { $$ = ap($2,$1); }|
+    reln relop e2
+        = { word subject;
+            subject = hd[hd[$1]]==AND?tl[tl[$1]]:tl[$1];
+            $$ = ap2(AND,$1,ap2($2,subject,$3));
+          };  /* EFFICIENCY PROBLEM - subject gets re-evaluated (and
+                 retypechecked) - fix later */
+
+arg:
+    { if(!SYNERR)lexstates=NIL,inlex=1; }
+    LEX lexrules ENDIR
+        = { inlex=0; lexdefs=NIL;
+            if(lexstates!=NIL)
+              { word echoed=0;
+                for(;lexstates!=NIL;lexstates=tl[lexstates])
+                { if(!echoed)printf(echoing?"\n":""),echoed=1;
+                  if(!(tl[hd[lexstates]]&1))
+                    printf("warning: lex state %s is never entered\n",
+                           get_id(hd[hd[lexstates]])); else
+                  if(!(tl[hd[lexstates]]&2))
+                    printf("warning: lex state %s has no associated rules\n",
+                           get_id(hd[hd[lexstates]])); }
+              }
+            if($3==NIL)syntax("%lex with no rules\n");
+            else tag[$3]=LEXER;
+            /* result is lex-list, in reverse order, of items of the form
+                 cons(scstuff,cons(matcher,rhs))
+               where scstuff is of the form
+                 cons(0-or-list-of-startconditions,1+newstartcondition)
+            */
+            $$ = $3; }|
+    NAME |
+    CNAME |
+    CONST |
+    READVALSY
+        = { $$ = readvals(0,0); }|
+    SHOWSYM
+        = { $$ = show(0,0); }|
+    DOLLAR2
+        = { $$ = lastexp;
+            if(lastexp==UNDEF)
+            syntax("no previous expression to substitute for $$\n"); }|
+    '[' ']'
+        = { $$ = NIL; }|
+    '[' exp ']'
+        = { $$ = cons($2,NIL); }|
+    '[' exp ',' exp ']'
+        = { $$ = cons($2,cons($4,NIL)); }|
+    '[' exp ',' exp ',' liste ']'
+        = { $$ = cons($2,cons($4,reverse($6))); }|
+    '[' exp DOTDOT exp ']'
+        = { $$ = ap3(STEPUNTIL,big_one,$4,$2); }|
+    '[' exp DOTDOT ']'
+        = { $$ = ap2(STEP,big_one,$2); }|
+    '[' exp ',' exp DOTDOT exp ']'
+        = { $$ = ap3(STEPUNTIL,ap2(MINUS,$4,$2),$6,$2); }|
+    '[' exp ',' exp DOTDOT ']'
+        = { $$ = ap2(STEP,ap2(MINUS,$4,$2),$2); }|
+    '[' exp '|' qualifiers ']'
+        = { $$ = SYNERR?NIL:compzf($2,$4,0);  }|
+    '[' exp DIAG qualifiers ']'
+        = { $$ = SYNERR?NIL:compzf($2,$4,1);  }|
+    '(' op ')'     /* RSB */
+        = { $$ = $2; }|
+    '(' es1 ')'          /* presection or parenthesised e1 */
+        = { $$ = $2; }|
+    '(' diop1 e1 ')'     /* postsection */
+        = { $$ = (tag[$2]==AP&&hd[$2]==C)?ap(tl[$2],$3): /* optimisation */
+                 ap2(C,$2,$3); }|
+    '(' ')'
+        = { $$ = Void; }|  /* the void tuple */
+    '(' exp ',' liste ')'
+        = { if(tl[$4]==NIL)$$=pair($2,hd[$4]);
+            else { $$=pair(hd[tl[$4]],hd[$4]);
+                   $4=tl[tl[$4]];
+                   while($4!=NIL)$$=tcons(hd[$4],$$),$4=tl[$4];
+                   $$ = tcons($2,$$); }
+          /* representation of the tuple (a1,...,an) is
+             tcons(a1,tcons(a2,...pair(a(n-1),an))) */
+          };
+
+lexrules:
+    lexrules lstart here re indent { if(!SYNERR)inlex=2; }
+    ARROW exp lpostfix { if(!SYNERR)inlex=1; } outdent
+        = { if($9<0 && e_re($4))
+              errs=$3,
+              syntax("illegal lex rule - lhs matches empty\n");
+            $$ = cons(cons(cons($2,1+$9),cons($4,label($3,$8))),$1); }|
+    lexdefs
+        = { $$ = NIL; };
+
+lstart:
+    /* empty */
+        = { $$ = 0; }|
+    '<' cnames '>'
+        = { word ns=NIL;
+            for(;$2!=NIL;$2=tl[$2])
+               { word *x = &lexstates,i=1;
+                 while(*x!=NIL&&hd[hd[*x]]!=hd[$2])i++,x = &tl[*x];
+                 if(*x == NIL)*x = cons(cons(hd[$2],2),NIL);
+                 else tl[hd[*x]] |= 2; 
+                 ns = add1(i,ns); }
+            $$ = ns; };
+
+cnames:
+    CNAME 
+        = { $$=cons($1,NIL); }|
+    cnames CNAME
+        = { if(member($1,$2))
+     printf("%ssyntax error: repeated name \"%s\" in start conditions\n",
+                      echoing?"\n":"",get_id($2)),
+              acterror();
+            $$ = cons($2,$1); };
+
+lpostfix:
+        /* empty */
+            = { $$ = -1; }|
+        LBEGIN CNAME
+            = { word *x = &lexstates,i=1;
+                while(*x!=NIL&&hd[hd[*x]]!=$2)i++,x = &tl[*x];
+                if(*x == NIL)*x = cons(cons($2,1),NIL);
+                else tl[hd[*x]] |= 1;
+                $$ = i;
+              }|
+        LBEGIN CONST
+            = { if(!isnat($2)||get_word($2)!=0)
+                   syntax("%begin not followed by IDENTIFIER or 0\n");
+                $$ = 0; };
+
+lexdefs:
+    lexdefs LEXDEF indent '=' re outdent
+        = { lexdefs = cons(cons($2,$5),lexdefs); }|
+    /* empty */ 
+        = { lexdefs = NIL; };
+
+re:   /* regular expression */
+    re1 '|' re
+        { $$ = ap2(LEX_OR,$1,$3); }|
+    re1;
+
+re1:
+    lterm '/' lterm
+        { $$ = ap2(LEX_RCONTEXT,$1,$3); }|
+    lterm '/'
+        { $$ = ap2(LEX_RCONTEXT,$1,0); }|
+    lterm;
+
+lterm:
+    lfac lterm
+        { $$ = ap2(LEX_SEQ,$1,$2); }|
+    lfac;
+
+lfac:
+    lunit '*'
+        { if(e_re($1))
+            syntax("illegal regular expression - arg of * matches empty\n");
+          $$ = ap(LEX_STAR,$1); }|
+    lunit '+'
+        { $$ = ap2(LEX_SEQ,$1,ap(LEX_STAR,$1)); }|
+    lunit '?'
+        { $$ = ap(LEX_OPT,$1); }|
+    lunit;
+
+lunit:
+    '(' re ')'
+        = { $$ = $2; }|
+    CONST
+        = { if(!isstring($1))
+              printf("%ssyntax error - unexpected token \"",
+                        echoing?"\n":""),
+              out(stdout,$1),printf("\" in regular expression\n"),
+              acterror();
+            $$ = $1==NILS?ap(LEX_STRING,NIL):
+                 tl[$1]==NIL?ap(LEX_CHAR,hd[$1]):
+                             ap(LEX_STRING,$1);
+          }|
+    CHARCLASS
+        = { if($1==NIL)
+              syntax("empty character class `` cannot match\n");
+            $$ = tl[$1]==NIL?ap(LEX_CHAR,hd[$1]):ap(LEX_CLASS,$1); }|
+    ANTICHARCLASS
+        = { $$ = ap(LEX_CLASS,cons(ANTICHARCLASS,$1)); }|
+    '.'
+        = { $$ = LEX_DOT; }|
+    name
+        = { word x=lexdefs;
+            while(x!=NIL&&hd[hd[x]]!=$1)x=tl[x];
+            if(x==NIL)
+              printf(
+      "%ssyntax error: undefined lexeme %s in regular expression\n",
+                      echoing?"\n":"",
+                      get_id($1)),
+                  acterror();
+            else $$ = tl[hd[x]]; };
+
+name: NAME|CNAME;
+
+qualifiers:
+    exp
+        = { $$ = cons(cons(GUARD,$1),NIL);  }|
+    generator
+        = { $$ = cons($1,NIL);  }|
+    qualifiers ';' generator
+        = { $$ = cons($3,$1);   }|
+    qualifiers ';' exp
+        = { $$ = cons(cons(GUARD,$3),$1);   };
+
+generator:
+    e1 ',' generator
+        = { /* fix syntax to disallow patlist on lhs of iterate generator */
+            if(hd[$3]==GENERATOR)
+              { word e=tl[tl[$3]];
+                if(tag[e]==AP&&tag[hd[e]]==AP&&
+                    (hd[hd[e]]==ITERATE||hd[hd[e]]==ITERATE1))
+                  syntax("ill-formed generator\n"); }
+            $$ = cons(REPEAT,cons(genlhs($1),$3)); idsused=NIL;  }|
+    generator1;
+
+generator1:
+    e1 LEFTARROW exp
+        = { $$ = cons(GENERATOR,cons(genlhs($1),$3)); idsused=NIL;  }|
+    e1 LEFTARROW exp ',' exp DOTDOT
+        = { word p = genlhs($1); idsused=NIL;
+            $$ = cons(GENERATOR,
+                      cons(p,ap2(irrefutable(p)?ITERATE:ITERATE1,
+                                 lambda(p,$5),$3)));
+          };
+
+defs:
+    def|
+    defs def;
+
+def:
+    v act2 indent '=' here rhs outdent
+        = { word l = $1, r = $6;
+            word f = head(l);
+            if(tag[f]==ID&&!isconstructor(f)) /* fnform defn */
+              while(tag[l]==AP)r=lambda(tl[l],r),l=hd[l];
+            r = label($5,r); /* to help locate type errors */
+            declare(l,r),lastname=l; }|
+
+    spec
+        = { word h=reverse(hd[$1]),hr=hd[tl[$1]],t=tl[tl[$1]];
+            while(h!=NIL&&!SYNERR)specify(hd[h],t,hr),h=tl[h];
+            $$ = cons(nill,NIL); }|
+
+    ABSTYPE here typeforms indent WITH lspecs outdent
+        = { extern word TABSTRS;
+            extern char *dicp,*dicq;
+            word x=reverse($6),ids=NIL,tids=NIL;
+            while(x!=NIL&&!SYNERR)
+                 specify(hd[hd[x]],cons(tl[tl[hd[x]]],NIL),hd[tl[hd[x]]]),
+                  ids=cons(hd[hd[x]],ids),x=tl[x];
+            /* each id in specs has its id_type set to const(t,NIL) as a way
+               of flagging that t is an abstract type */
+            x=reverse($3);
+            while(x!=NIL&&!SYNERR)
+               { word shfn;
+                 decltype(hd[x],abstract_t,undef_t,$2);
+                 tids=cons(head(hd[x]),tids);
+                 /* check for presence of showfunction */
+                 (void)strcpy(dicp,"show");
+                 (void)strcat(dicp,get_id(hd[tids]));
+                 dicq = dicp+strlen(dicp)+1;
+                 shfn=name();
+                 if(member(ids,shfn))
+                   t_showfn(hd[tids])=shfn;
+                 x=tl[x]; }
+            TABSTRS = cons(cons(tids,ids),TABSTRS);
+            $$ = cons(nill,NIL); }|
+
+    typeform indent act1 here EQEQ type act2 outdent
+        = { word x=redtvars(ap($1,$6));
+            decltype(hd[x],synonym_t,tl[x],$4);
+            $$ = cons(nill,NIL); }|
+
+    typeform indent act1 here COLON2EQ construction act2 outdent
+        = { word rhs = $6, r_ids = $6, n=0;
+            while(r_ids!=NIL)r_ids=tl[r_ids],n++;
+            while(rhs!=NIL&&!SYNERR)
+            {  word h=hd[rhs],t=$1,stricts=NIL,i=0;
+               while(tag[h]==AP)
+                    { if(tag[tl[h]]==AP&&hd[tl[h]]==strict_t)
+                        stricts=cons(i,stricts),tl[h]=tl[tl[h]];
+                      t=ap2(arrow_t,tl[h],t),h=hd[h],i++; }
+               if(tag[h]==ID)
+                 declconstr(h,--n,t);
+                 /* warning - type not yet in reduced form */
+               else { stricts=NIL;
+                      if(echoing)putchar('\n');
+                      printf("syntax error: illegal construct \"");
+                      out_type(hd[rhs]);
+                      printf("\" on right of ::=\n");
+                      acterror(); } /* can this still happen? check later */
+               if(stricts!=NIL) /* ! operators were present */
+                 { word k = id_val(h);
+                   while(stricts!=NIL)
+                        k=ap2(MKSTRICT,i-hd[stricts],k),
+                        stricts=tl[stricts];
+                   id_val(h)=k; /* overwrite id_val of original constructor */
+                 }
+               r_ids=cons(h,r_ids);
+               rhs = tl[rhs]; }
+            if(!SYNERR)decltype($1,algebraic_t,r_ids,$4);
+            $$ = cons(nill,NIL); }|
+
+    indent setexp EXPORT parts outdent
+        = { inexplist=0;
+            if(exports!=NIL)
+              errs=$2,
+              syntax("multiple %export statements are illegal\n");
+            else { if($4==NIL&&exportfiles==NIL&&embargoes!=NIL)
+		     exportfiles=cons(PLUS,NIL);
+                   exports=cons($2,$4); } /* cons(hereinfo,identifiers) */
+            $$ = cons(nill,NIL); }|
+
+    FREE here '{' specs '}'
+        = { if(freeids!=NIL)
+              errs=$2,
+              syntax("multiple %free statements are illegal\n"); else
+            { word x=reverse($4);
+              while(x!=NIL&&!SYNERR)
+                 { specify(hd[hd[x]],tl[tl[hd[x]]],hd[tl[hd[x]]]);
+                   freeids=cons(head(hd[hd[x]]),freeids);
+                   if(tl[tl[hd[x]]]==type_t)
+                     t_class(hd[freeids])=free_t;
+                   else id_val(hd[freeids])=FREE; /* conventional value */
+                   x=tl[x]; }
+              fil_share(hd[files])=0; /* parameterised scripts unshareable */
+              freeids=alfasort(freeids); 
+              for(x=freeids;x!=NIL;x=tl[x])
+                 hd[x]=cons(hd[x],cons(datapair(get_id(hd[x]),0),
+                       id_type(hd[x])));
+              /* each element of freeids is of the form
+                 cons(id,cons(original_name,type)) */
+            }
+            $$ = cons(nill,NIL); }|
+
+    INCLUDE bindings modifiers outdent
+    /* fiddle - 'indent' done by yylex() on reading fileid */
+        = { extern char *dicp;
+            extern word CLASHES,BAD_DUMP;
+            includees=cons(cons($1,cons($3,$2)),includees);
+                   /* $1 contains file+hereinfo */
+            $$ = cons(nill,NIL); }|
+
+    here BNF { startbnf(); inbnf=1;} names outdent productions ENDIR
+    /* fiddle - `indent' done by yylex() while processing directive */
+        = { word lhs=NIL,p=$6,subjects,body,startswith=NIL,leftrecs=NIL;
+            ihlist=inbnf=0;
+            nonterminals=UNION(nonterminals,$4);
+            for(;p!=NIL;p=tl[p])
+            if(dval(hd[p])==UNDEF)nonterminals=add1(dlhs(hd[p]),nonterminals);
+             else lhs=add1(dlhs(hd[p]),lhs);
+            nonterminals=setdiff(nonterminals,lhs);
+            if(nonterminals!=NIL)
+              errs=$1,
+              member($4,hd[nonterminals])||findnt(hd[nonterminals]),
+              printf("%sfatal error in grammar, ",echoing?"\n":""),
+              printf("undefined nonterminal%s: ",
+                      tl[nonterminals]==NIL?"":"s"),
+              printlist("",nonterminals),
+              acterror(); else
+            { /* compute list of nonterminals admitting empty prodn */
+            eprodnts=NIL;
+          L:for(p=$6;p!=NIL;p=tl[p])
+               if(!member(eprodnts,dlhs(hd[p]))&&eprod(dval(hd[p])))
+                 { eprodnts=cons(dlhs(hd[p]),eprodnts); goto L; }
+            /* now compute startswith reln between nonterminals
+               (performing binomial transformation en route)
+               and use to detect unremoved left recursion */
+            for(p=$6;p!=NIL;p=tl[p])
+               if(member(lhs=starts(dval(hd[p])),dlhs(hd[p])))
+                 binom(dval(hd[p]),dlhs(hd[p])),
+                 startswith=cons(cons(dlhs(hd[p]),starts(dval(hd[p]))),
+                                 startswith);
+               else startswith=cons(cons(dlhs(hd[p]),lhs),startswith);
+            startswith=tclos(sortrel(startswith));
+            for(;startswith!=NIL;startswith=tl[startswith])
+               if(member(tl[hd[startswith]],hd[hd[startswith]]))
+                 leftrecs=add1(hd[hd[startswith]],leftrecs);
+            if(leftrecs!=NIL)
+              errs=getloc(hd[leftrecs],$6),
+              printf("%sfatal error in grammar, ",echoing?"\n":""),
+              printlist("irremovable left recursion: ",leftrecs),
+              acterror();
+            if($4==NIL) /* implied start symbol */
+              $4=cons(dlhs(hd[lastlink($6)]),NIL);
+            fnts=1; /* fnts is flag indicating %bnf in use */
+            if(tl[$4]==NIL) /* only one start symbol */
+              subjects=getfname(hd[$4]),
+              body=ap2(G_CLOSE,str_conv(get_id(hd[$4])),hd[$4]);
+            else
+            { body=subjects=Void;
+              while($4!=NIL)
+                   subjects=pair(getfname(hd[$4]),subjects),
+                   body=pair(
+                         ap2(G_CLOSE,str_conv(get_id(hd[$4])),hd[$4]),
+                            body),
+                   $4=tl[$4];
+            }
+            declare(subjects,label($1,block($6,body, 0)));
+          }};
+
+setexp:
+    here
+        =  { $$=$1;
+             inexplist=1; };  /* hack to fix lex analyser */
+
+bindings:
+    /* empty */
+        = { $$ = NIL; }|
+    '{' bindingseq '}'
+        = { $$ = $2; };
+
+bindingseq:
+    bindingseq binding
+        = { $$ = cons($2,$1); }|
+    binding
+        = { $$ = cons($1,NIL); };
+
+binding:
+    NAME indent '=' exp outdent
+        =  { $$ = cons($1,$4); }|
+    typeform indent act1 EQEQ type act2 outdent
+        =  { word x=redtvars(ap($1,$5)); 
+             word arity=0,h=hd[x];
+             while(tag[h]==AP)arity++,h=hd[h];
+             $$ = ap(h,make_typ(arity,0,synonym_t,tl[x]));
+           };
+
+modifiers:
+    /* empty */
+        =  { $$ = NIL; }|
+    negmods
+        =  { word a,b,c=0;
+             for(a=$1;a!=NIL;a=tl[a])
+                for(b=tl[a];b!=NIL;b=tl[b])
+                   { if(hd[hd[a]]==hd[hd[b]])c=hd[hd[a]];
+                     if(tl[hd[a]]==tl[hd[b]])c=tl[hd[a]]; 
+                     if(c)break; }
+             if(c)printf(
+                  "%ssyntax error: conflicting aliases (\"%s\")\n",
+                      echoing?"\n":"",
+                      get_id(c)),
+                  acterror();
+           };
+
+negmods:
+    negmods negmod
+        =  { $$ = cons($2,$1); }|
+    negmod
+        =  { $$ = cons($1,NIL); };
+
+negmod:
+    NAME '/' NAME
+        =  { $$ = cons($1,$3); }|
+    CNAME '/' CNAME
+        =  { $$ = cons($1,$3); }|
+    '-' NAME
+        =  { $$ = cons(make_pn(UNDEF),$2); }/*|
+    '-' CNAME */;  /* no - cannot suppress constructors selectively */
+
+here:
+    /* empty */ 
+        =  { extern word line_no;
+             lasth = $$ = fileinfo(get_fil(current_file),line_no);
+             /* (script,line_no) for diagnostics */
+           };
+
+act1:
+    /* empty */
+        = { tvarscope=1; };
+
+act2:
+    /* empty */
+        = { tvarscope=0; idsused= NIL; };
+
+ldefs:
+    ldef
+        = { $$ = cons($1,NIL);
+            dval($1) = tries(dlhs($1),cons(dval($1),NIL));
+            if(!SYNERR&&get_ids(dlhs($1))==NIL)
+              errs=hd[hd[tl[dval($1)]]],
+              syntax("illegal lhs for local definition\n");
+          }|
+    ldefs ldef
+        = { if(dlhs($2)==dlhs(hd[$1]) /*&&dval(hd[$1])!=UNDEF*/)
+              { $$ = $1;
+                if(!fallible(hd[tl[dval(hd[$1])]]))
+                    errs=hd[dval($2)],
+                    printf("%ssyntax error: \
+unreachable case in defn of \"%s\"\n",echoing?"\n":"",get_id(dlhs($2))),
+                    acterror();
+                tl[dval(hd[$1])]=cons(dval($2),tl[dval(hd[$1])]); }
+            else if(!SYNERR)
+                 { word ns=get_ids(dlhs($2)),hr=hd[dval($2)];
+                   if(ns==NIL)
+                     errs=hr,
+                     syntax("illegal lhs for local definition\n");
+                   $$ = cons($2,$1);
+                   dval($2)=tries(dlhs($2),cons(dval($2),NIL));
+                   while(ns!=NIL&&!SYNERR) /* local nameclash check */
+                        { nclashcheck(hd[ns],$1,hr);
+                          ns=tl[ns]; }
+                        /* potentially quadratic - fix later */
+                 }
+          };
+
+ldef:
+    spec
+        = { errs=hd[tl[$1]];
+            syntax("`::' encountered in local defs\n");
+            $$ = cons(nill,NIL); }|
+    typeform here EQEQ
+        = { errs=$2;
+            syntax("`==' encountered in local defs\n");
+            $$ = cons(nill,NIL); }|
+    typeform here COLON2EQ
+        = { errs=$2;
+            syntax("`::=' encountered in local defs\n");
+            $$ = cons(nill,NIL); }|
+    v act2 indent '=' here rhs outdent
+        = { word l = $1, r = $6;
+            word f = head(l);
+            if(tag[f]==ID&&!isconstructor(f)) /* fnform defn */
+              while(tag[l]==AP)r=lambda(tl[l],r),l=hd[l];
+            r = label($5,r); /* to help locate type errors */
+            $$ = defn(l,undef_t,r); };
+
+vlist:
+    v
+        = { $$ = cons($1,NIL); }|
+    vlist ',' v /* left recursive so as not to eat YACC stack */
+        = { $$ = cons($3,$1);  }; /* reverse order, NB */
+
+v:
+    v1 |
+    v1 ':' v
+        = { $$ = cons($1,$3); };
+
+v1:
+    v1 '+' CONST  /* n+k pattern */
+        = { if(!isnat($3))
+              syntax("inappropriate use of \"+\" in pattern\n");
+            $$ = ap2(PLUS,$3,$1); }|
+    '-' CONST
+        = { /* if(tag[$2]==DOUBLE)
+              $$ = cons(CONST,sto_dbl(-get_dbl($2))); else */
+            if(tag[$2]==INT)
+              $$ = cons(CONST,bignegate($2)); else
+            syntax("inappropriate use of \"-\" in pattern\n"); }|
+    v2 INFIXNAME v1
+        = { $$ = ap2($2,$1,$3); }|
+    v2 INFIXCNAME v1
+        = { $$ = ap2($2,$1,$3); }|
+    v2;
+
+v2:
+    v3 |
+    v2 v3
+        = { $$ = ap(hd[$1]==CONST&&tag[tl[$1]]==ID?tl[$1]:$1,$2); };
+        /* repeated name apparatus may have wrapped CONST around leading id
+           - not wanted */
+
+v3:
+    NAME
+        = { if(sreds&&member(gvars,$1))syntax("illegal use of $num symbol\n");
+              /* cannot use grammar variable in a binding position */
+            if(memb(idsused,$1))$$ = cons(CONST,$1);
+                            /* picks up repeated names in a template */
+            else idsused= cons($1,idsused);   } |
+    CNAME |
+    CONST
+        = { if(tag[$1]==DOUBLE)
+	      syntax("use of floating point literal in pattern\n");
+	    $$ = cons(CONST,$1); }|
+    '[' ']'
+        = { $$ = nill; }|
+    '[' vlist ']'
+        = { word x=$2,y=nill;
+            while(x!=NIL)y = cons(hd[x],y), x = tl[x];
+            $$ = y; }|
+    '(' ')'
+        = { $$ = Void; }|
+    '(' v ')'
+        = { $$ = $2; }|
+    '(' v ',' vlist ')'
+        = { if(tl[$4]==NIL)$$=pair($2,hd[$4]);
+            else { $$=pair(hd[tl[$4]],hd[$4]);
+                   $4=tl[tl[$4]];
+                   while($4!=NIL)$$=tcons(hd[$4],$$),$4=tl[$4];
+                   $$ = tcons($2,$$); }
+          /* representation of the tuple (a1,...,an) is
+             tcons(a1,tcons(a2,...pair(a(n-1),an))) */
+          };
+
+type:
+    type1 |
+    type ARROW type
+        = { $$ = ap2(arrow_t,$1,$3); };
+
+type1:
+    type2 INFIXNAME type1
+        = { $$ = ap2($2,$1,$3); }|
+    type2;
+
+type2:
+    /* type2 argtype  /* too permissive - fix later */
+        /* = { $$ = ap($1,$2); }| */
+    tap|
+    argtype;
+
+tap:
+    NAME argtype
+        = { $$ = ap($1,$2); }|
+    tap argtype
+        = { $$ = ap($1,$2); };
+
+argtype:
+    NAME
+        = { $$ = transtypeid($1); }|
+           /* necessary while prelude not meta_tchecked (for prelude)*/
+    typevar
+        = { if(tvarscope&&!memb(idsused,$1))
+            printf("%ssyntax error: unbound type variable ",echoing?"\n":""),
+                 out_type($1),putchar('\n'),acterror();
+            $$ = $1; }|
+    '(' typelist ')'
+        = { $$ = $2; }|
+    '[' type ']'  /* at release one was `typelist' */
+        = { $$ = ap(list_t,$2); }|
+    '[' type ',' typel ']'
+        = { syntax(
+             "tuple-type with missing parentheses (obsolete syntax)\n"); };
+
+typelist:
+    /* empty */
+        = { $$ = void_t; }|  /* voidtype */
+    type |
+    type ',' typel
+        = { word x=$3,y=void_t;
+            while(x!=NIL)y = ap2(comma_t,hd[x],y), x = tl[x];
+            $$ = ap2(comma_t,$1,y); };
+
+typel:
+    type 
+        = { $$ = cons($1,NIL); }|
+    typel ',' type /* left recursive so as not to eat YACC stack */
+        = { $$ = cons($3,$1); };
+
+parts: /* returned in reverse order */
+    parts NAME 
+        = { $$ = add1($2,$1); }|
+    parts '-' NAME
+	= { $$ = $1; embargoes=add1($3,embargoes); }|
+    parts PATHNAME 
+        = { $$ = $1; }| /*the pathnames are placed on exportfiles in yylex*/
+    parts '+'
+        = { $$ = $1;
+            exportfiles=cons(PLUS,exportfiles); }|
+    NAME
+        = { $$ = add1($1,NIL); }|
+    '-' NAME
+	= { $$ = NIL; embargoes=add1($2,embargoes); }|
+    PATHNAME
+        = { $$ = NIL; }|
+    '+'
+        = { $$ = NIL;
+            exportfiles=cons(PLUS,exportfiles); };
+
+specs:  /* returns a list of cons(id,cons(here,type))
+           in reverse order of appearance */
+    specs spec
+        = { word x=$1,h=hd[$2],t=tl[$2];
+            while(h!=NIL)x=cons(cons(hd[h],t),x),h=tl[h];
+            $$ = x; }|
+    spec
+        = { word x=NIL,h=hd[$1],t=tl[$1];
+            while(h!=NIL)x=cons(cons(hd[h],t),x),h=tl[h];
+            $$ = x; };
+
+spec:
+    typeforms indent here COLONCOLON ttype outdent
+        = { $$ = cons($1,cons($3,$5)); };
+            /* hack: `typeforms' includes `namelist' */
+
+lspecs:  /* returns a list of cons(id,cons(here,type))
+           in reverse order of appearance */
+    lspecs lspec
+        = { word x=$1,h=hd[$2],t=tl[$2];
+            while(h!=NIL)x=cons(cons(hd[h],t),x),h=tl[h];
+            $$ = x; }|
+    lspec
+        = { word x=NIL,h=hd[$1],t=tl[$1];
+            while(h!=NIL)x=cons(cons(hd[h],t),x),h=tl[h];
+            $$ = x; };
+
+lspec:
+    namelist indent here {inbnf=0;} COLONCOLON type outdent
+        = { $$ = cons($1,cons($3,$6)); };
+
+namelist:
+    NAME ',' namelist
+        = { $$ = cons($1,$3); }|
+    NAME
+        = { $$ = cons($1,NIL); };
+
+typeforms:
+    typeforms ',' typeform act2 
+        = { $$ = cons($3,$1); }|
+    typeform act2
+        = { $$ = cons($1,NIL); };
+            
+typeform:
+    CNAME typevars
+        = { syntax("upper case identifier out of context\n"); }|
+    NAME typevars   /* warning if typevar is repeated */
+        = { $$ = $1;
+            idsused=$2;
+            while($2!=NIL)
+              $$ = ap($$,hd[$2]),$2 = tl[$2];
+          }|
+    typevar INFIXNAME typevar
+        = { if(eqtvar($1,$3))
+              syntax("repeated type variable in typeform\n");
+            idsused=cons($1,cons($3,NIL));
+            $$ = ap2($2,$1,$3); }|
+    typevar INFIXCNAME typevar
+        = { syntax("upper case identifier cannot be used as typename\n"); };
+
+ttype:
+    type|
+    TYPE
+        =  { $$ = type_t; };
+
+typevar:
+    '*'
+        = { $$ = mktvar(1); }|
+    TYPEVAR;
+
+typevars:
+    /* empty */
+        = { $$ = NIL; }|
+    typevar typevars
+        = { if(memb($2,$1))
+              syntax("repeated type variable on lhs of type def\n");
+            $$ = cons($1,$2); };
+
+construction:
+    constructs
+        = { extern word SGC;  /* keeps track of sui-generis constructors */
+            if( tl[$1]==NIL && tag[hd[$1]]!=ID )
+                            /* 2nd conjunct excludes singularity types */
+              SGC=cons(head(hd[$1]),SGC);
+          };
+
+constructs:
+    construct
+        = { $$ = cons($1,NIL); }|
+    constructs '|' construct
+        = { $$ = cons($3,$1); };
+
+construct:
+    field here INFIXCNAME field
+        = { $$ = ap2($3,$1,$4); 
+            id_who($3)=$2; }|
+    construct1;
+
+construct1:
+    '(' construct ')'
+        = { $$ = $2; }|
+    construct1 field1
+        = { $$ = ap($1,$2); }|
+    here CNAME
+        = { $$ = $2;
+            id_who($2)=$1; };
+
+field:
+    type|
+    argtype '!'
+        = { $$ = ap(strict_t,$1); };
+
+field1:
+    argtype '!'
+        = { $$ = ap(strict_t,$1); }|
+    argtype;
+
+names:          /* used twice - for bnf list, and for inherited attr list */
+    /* empty */
+        = { $$ = NIL; }|
+    names NAME
+        = { if(member($1,$2))
+            printf("%ssyntax error: repeated identifier \"%s\" in %s list\n",
+                      echoing?"\n":"",get_id($2),inbnf?"bnf":"attribute"),
+              acterror();
+            $$ = inbnf?add1($2,$1):cons($2,$1);
+          };
+
+productions:
+    lspec
+        = { word h=reverse(hd[$1]),hr=hd[tl[$1]],t=tl[tl[$1]];
+            inbnf=1;
+            $$=NIL;
+            while(h!=NIL&&!SYNERR)
+                 ntspecmap=cons(cons(hd[h],hr),ntspecmap),
+                 $$=add_prod(defn(hd[h],t,UNDEF),$$,hr),
+                 h=tl[h];
+          }|
+    production
+        = { $$ = cons($1,NIL); }|
+    productions lspec
+        = { word h=reverse(hd[$2]),hr=hd[tl[$2]],t=tl[tl[$2]];
+            inbnf=1;
+            $$=$1;
+            while(h!=NIL&&!SYNERR)
+                 ntspecmap=cons(cons(hd[h],hr),ntspecmap),
+                 $$=add_prod(defn(hd[h],t,UNDEF),$$,hr),
+                 h=tl[h];
+          }|
+    productions production
+        = { $$ = add_prod($2,$1,hd[dval($2)]); };
+
+production:
+    NAME params ':' indent grhs outdent
+    /* found by experiment that indent must follow ':' here */
+        = { $$ = defn($1,undef_t,$5); };
+
+params:   /* places inherited attributes, if any, on ihlist */
+    /* empty */
+        = { ihlist=0; }|
+    { inbnf=0; } '(' names ')'
+        = { inbnf=1;
+            if($3==NIL)syntax("unexpected token ')'\n");
+            ihlist=$3; }
+
+grhs:
+    here phrase
+        = { $$ = label($1,$2); };
+
+phrase:
+    error_term
+        = { $$ = ap2(G_ERROR,G_ZERO,$1); }|
+    phrase1
+        = { $$=hd[$1], $1=tl[$1];
+            while($1!=NIL)
+                 $$=label(hd[$1],$$),$1=tl[$1],
+                 $$=ap2(G_ALT,hd[$1],$$),$1=tl[$1];
+        }|
+    phrase1 '|' error_term
+        = { $$=hd[$1], $1=tl[$1];
+            while($1!=NIL)
+                 $$=label(hd[$1],$$),$1=tl[$1],
+                 $$=ap2(G_ALT,hd[$1],$$),$1=tl[$1];
+            $$ = ap2(G_ERROR,$$,$3); };
+    /* we right rotate G_ALT's to facilitate left factoring (see trans) */
+
+phrase1:
+    term
+        = { $$=cons($1,NIL); }|
+    phrase1 '|' here term
+        = { $$ = cons($4,cons($3,$1)); };
+
+term:
+    count_factors
+        = { word n=0,f=$1,rule=Void;
+                         /* default value of a production is () */
+                         /* rule=mkgvar(sreds); /* formerly last symbol */
+            if(f!=NIL&&hd[f]==G_END)sreds++;
+            if(ihlist)rule=ih_abstr(rule);
+            while(n<sreds)rule=lambda(mkgvar(++n),rule);
+            sreds=0;
+            rule=ap(G_RULE,rule);
+            while(f!=NIL)rule=ap2(G_SEQ,hd[f],rule),f=tl[f];
+            $$ = rule; }|
+    count_factors {inbnf=2;} indent '=' here rhs outdent
+        = { if($1!=NIL&&hd[$1]==G_END)sreds++;
+            if(sreds==1&&can_elide($6))
+              inbnf=1,sreds=0,$$=hd[$1]; /* optimisation */
+            else
+            { word f=$1,rule=label($5,$6),n=0;
+              inbnf=1;
+              if(ihlist)rule=ih_abstr(rule);
+              while(n<sreds)rule=lambda(mkgvar(++n),rule);
+              sreds=0;
+              rule=ap(G_RULE,rule);
+              while(f!=NIL)rule=ap2(G_SEQ,hd[f],rule),f=tl[f];
+              $$ = rule; }
+          };
+
+error_term:
+    ERRORSY
+        = { word rule = ap(K,Void); /* default value of a production is () */
+            if(ihlist)rule=ih_abstr(rule);
+            $$ = rule; }|
+    ERRORSY { inbnf=2,sreds=2; } indent '=' here rhs outdent
+        = { word rule = label($5,$6);
+            if(ihlist)rule=ih_abstr(rule);
+            $$ = lambda(pair(mkgvar(1),mkgvar(2)),rule);
+            inbnf=1,sreds=0; };
+
+count_factors:
+    EMPTYSY
+        = { sreds=0; $$=NIL; }|
+    EMPTYSY factors
+        = { syntax("unexpected token after empty\n");
+            sreds=0; $$=NIL; }|
+    { obrct=0; } factors
+        = { word f=$2;
+            if(obrct)
+              syntax(obrct>0?"unmatched { in grammar rule\n":
+                             "unmatched } in grammar rule\n");
+            for(sreds=0;f!=NIL;f=tl[f])sreds++;
+            if(hd[$2]==G_END)sreds--;
+            $$ = $2; };
+
+factors:
+    factor
+        =  { $$ = cons($1,NIL); }|
+    factors factor
+        =  { if(hd[$1]==G_END)
+               syntax("unexpected token after end\n");
+             $$ = cons($2,$1); };
+
+factor:
+    unit|
+    '{' unit '}'
+        = { $$ = ap(outdent_fn,ap2(indent_fn,getcol_fn(),$2)); }|
+    '{' unit
+        = { obrct++;
+            $$ = ap2(indent_fn,getcol_fn(),$2); }|
+    unit '}'
+        = { if(--obrct<0)syntax("unmatched `}' in grammar rule\n");
+            $$ = ap(outdent_fn,$1); } ;
+
+unit:
+    symbol|
+    symbol '*'
+        = { $$ = ap(G_STAR,$1); }|
+    symbol '+'
+        = { $$ = ap2(G_SEQ,$1,ap2(G_SEQ,ap(G_STAR,$1),ap(G_RULE,ap(C,P)))); }|
+    symbol '?'
+        = { $$ = ap(G_OPT,$1); };
+
+symbol:
+    NAME
+        = { extern word NEW;
+            nonterminals=newadd1($1,nonterminals);
+            if(NEW)ntmap=cons(cons($1,lasth),ntmap); }|
+    ENDSY
+        = { $$ = G_END; }|
+    CONST
+        = { if(!isstring($1))
+              printf("%ssyntax error: illegal terminal ",echoing?"\n":""),
+              out(stdout,$1),printf(" (should be string-const)\n"),
+              acterror();
+            $$ = ap(G_SYMB,$1); }|
+    '^'
+        = { $$=G_STATE; }|
+    {inbnf=0;} '[' exp {inbnf=1;} ']'
+        = { $$ = ap(G_SUCHTHAT,$3); }|
+    '-'
+        = { $$ = G_ANY; };
+
+%%
+/*  end of MIRANDA RULES  */
+