/q-7.11/src/qc.y

/* expect 3 shift/reduce, 82 reduce/reduce */

%{

/* qc.y: yacc source of Q parser and Q compiler main program */

/* Special case constructs (unary minus) and dangling else cause a number of
   parsing conflicts which are resolved correctly. */

/*  Q eQuational Programming System
    Copyright (c) 1991-2002 by Albert Graef
    <ag@muwiinfa.geschichte.uni-mainz.de>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 1, or (at your option)
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

*/

#include "qcdefs.h"

int      	nerrs, nwarns;
bool		dflag, hflag, nflag, vflag, Vflag, wflag;
volatile bool   int_sig;
char           *self = "qc", *list = "";

char		signon[] = QC_SIGNON;
char   		usage[] = QC_USAGE;
char		opts[4096];
char		copying[] = COPYING;
char		helpmsg[] = HELPMSG;

DECLARE_YYTEXT

extern int context, dcontext;

static int type, fno_min, fno_max;
static short flags, sflags;
static unsigned long argv;
static int qualtest = 0;

static int isvsym(char *s);

static void start_qualifiers(void), qualifiers(void);
static void add_qualifier(EXPR *x);
static void start_where_clauses(void), end_where_clauses(void),
  add_where_clause(EXPR *l, EXPR *r);

static xvect_t *exprlist(void);
static xvect_t *addexpr(xvect_t *v, EXPR *x);
static xvect_t *groupexpr(xvect_t *v);
static EXPR *tupleexpr(xvect_t *v);
static EXPR *listexpr(xvect_t *v);
static EXPR *streamexpr(xvect_t *v);
%}

%union {
  int ival;
  mpz_t zval;
  double fval;
  char *sval;
  EXPR *xval;
  xvect_t *xvval;
}

/* keywords and multi-character literals: */

%token AS CONST DEF ELSE EXTERN FROM IF IMPORT INCLUDE OTHERWISE
%token PRIVATE PUBLIC SPECIAL THEN TYPE UNDEF VAR VIRTUAL WHERE
%token DOTDOT EQUIV

/* identifiers and constants: */

%token <ival> STR
%token <sval> UID LID QUID QLID ID1 STR1
%token <zval> INT
%token <fval> FLOAT

/* user-defined operators */

%token <ival> OP0 OP1 OP2 OP3 OP4 OP5 OP6 OP7 OP8 OP9

/* special tokens */

%token ERRTOK EOFTOK

/* ccc, xxx: identifiers in special declaration contexts. CAUTION: These must
   only be used in contexts where no lookahead is needed, so that the symbol
   to be handled has not been processed by the lexer already! */
%type <ival> cccnid cccnfid
/* CAUTION: The xxx nonterminals return unnormalized identifiers! */
%type <ival> xxxqid xxxqfid xxxqfvid xxxqfid_or_op xxxqfid_or_op2 xxxqtid

%type <ival> id nid fid nfid vid tid ntid fvid nfvid qvid vid_list
%type <ival> opt_type type_alias id_alias op_alias op_prec
%type <xval> condition
%type <xval> lexpression0 llambda0 lsequence0 lcond0 lrightapp0 lrelation0
%type <xval> expression0 lambda0 sequence0 cond0 rightapp0 relation0
%type <xval> lexpression llambda lsequence lcond lrightapp lrelation laddition
%type <xval> lmultiplication lunary lscript lcomposition lapplication lprimary
%type <xval> expression lambda sequence cond rightapp relation addition
%type <xval> multiplication unary script composition application primary atom
%type <xvval> lexpr_list expr_list lexpr_list1 expr_list1 lexpr_list2 expr_list2
%type <ival> op builtin_op seqop rappop relop0 relop addop mulop unop scriptop compop quoteop
%type <sval> module_id

%start source

%%

/* error recovery is fairly simplistic (panic mode with ';' as stop symbol),
   I should really work out something more sophisticated in the future -AG */

source		: { srcstate(); }
		  program
		;

program		: /* empty */
		| program imports ';'
				{ import(); newdecl(); }
		| program includes ';'
				{ include(); newdecl(); }
		| program named_imports ';'
				{ import(); newdecl(); }
		| program named_includes ';'
				{ include(); newdecl(); }
		| program priority
				{ newdecl(); }
		| program declaration
				{ newdecl(); }
		| program definition
				{ newrule(); }
		| program rule
				{ newrule(); }
		| program EOFTOK { wrapover(); }
		| program error { if (yychar == EOFTOK) wrapover(); }
		  stopsyms
				{ yyerrok; srcstate(); newrule(); newdecl(); clear_imports(); }
		;

stopsyms	: ';' | EOFTOK
		;

imports		: IMPORT import
		| imports ',' import
		;

includes	: INCLUDE import
		| includes ',' import
		;

import		: module_id
				{ add_import($1, NULL); }
		| module_id AS module_id
				{ add_import($1, $3); }
		;

module_id	: ID1
		| STR1
		;

named_imports	: FROM import IMPORT opt_imported_names
		;

named_includes	: FROM import INCLUDE opt_imported_names
		;

opt_imported_names
		: /* empty: create a dummy list */
				{ add_import_name(NULL, NULL); }
		| imported_names
		;

imported_names	: imported_name
		| imported_names ',' imported_name
		;

imported_name	: ID1
				{ add_import_name($1, NULL); }
		| ID1 AS ID1
				{ add_import_name($1, $3); }
		;

priority	: '@' INT
				{ priority($2); mpz_clear($2); }
		| '@' OP3 INT
				{ if ($2 != ADDOP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else {
				    priority($3); mpz_clear($3);
				  }
				}
		| '@' '-' INT
				{ mpz_neg($3,$3);
				  priority($3); mpz_clear($3); }
		;

declaration	: prefix
		   		{ type = 0; }
		  headers ';'
		| TYPE xxxqtid type_alias ';'
				{ if ($2 == NONE)
				    ;
				  else if (!(symtb[$2].flags&DCL)) {
				    yyerror(qcmsg[AS_DCL_ERROR]);
				    YYERROR;
				  } else
				    astype($2, $3, flags); }
		| scope TYPE xxxqtid type_alias ';'
				{ if ($3 == NONE)
				    ;
				  else if (!(symtb[$3].flags&DCL)) {
				    yyerror(qcmsg[AS_DCL_ERROR]);
				    YYERROR;
				  } else
				    astype($3, $4, flags); }
		| TYPE ntid EQUIV tid ';'
				{ if (checktype($4) != NONE &&
				      (symtb[$4].flags&DCL))
				    astype($4, $2, flags); }
		| scope TYPE ntid EQUIV tid ';'
				{ if (checktype($5) != NONE &&
				      (symtb[$5].flags&DCL))
				    astype($5, $3, flags); }
		| TYPE ntid opt_type
		   		{ type = dcltype($2, $3, flags);
				  sflags = flags; fno_min = symtbsz; }
		  opt_header_sects ';'
				{ /* check for enumeration type */
				  int enumtype = 1, i;
				  fno_max = symtbsz-1;
				  for (i = fno_min; i <= fno_max; i++)
				    if (!(symtb[i].flags & CST) ||
					(symtb[i].flags & VIRT) ||
					symtb[i].argc > 0) {
				      enumtype = 0; break;
				    }
				  if (enumtype && type) {
				    symtb[type].fno_min = fno_min;
				    symtb[type].fno_max = fno_max;
				  }
				}
		| scope TYPE ntid opt_type
		   		{ type = dcltype($3, $4, flags);
				  sflags = flags; fno_min = symtbsz; }
		  opt_header_sects ';'
				{ int enumtype = 1, i;
				  fno_max = symtbsz-1;
				  for (i = fno_min; i <= fno_max; i++)
				    if (!(symtb[i].flags & CST) ||
					(symtb[i].flags & VIRT) ||
					symtb[i].argc > 0) {
				      enumtype = 0; break;
				    }
				  if (enumtype && type) {
				    symtb[type].fno_min = fno_min;
				    symtb[type].fno_max = fno_max;
				  }
				}
		| EXTERN TYPE ntid opt_type
		   		{ type = dcltype($3, $4, flags|EXT);
				  sflags = flags; }
		  opt_header_sects ';'
		| scope EXTERN TYPE ntid opt_type
		   		{ type = dcltype($4, $5, flags|EXT);
				  sflags = flags; }
		  opt_header_sects ';'
		;

type_alias	: /* empty */
				{ $$ = 0; }
		| AS ntid
				{ $$ = $2; }
		;

opt_type	: /* empty */
				{ $$ = 0; }
		| ':' tid
				{ $$ = checktype($2); }
		;

opt_header_sects: /* empty */
		| '=' header_sects
		;
		
header_sects	: header_sect
		| header_sects '|' header_sect
		;

header_sect	:		{ flags = sflags; }
		  opt_prefix headers
		;
		
prefix		: scope
		| modifiers
		| scope modifiers
		;
		
opt_prefix	: /* empty */
		| prefix
		;
		
scope		: PRIVATE
				{ flags = PRIV; }
		| PUBLIC
				{ flags = 0; }
		;
		
modifiers	: modifier
		| modifiers modifier
		;

modifier	: CONST
				{ flags |= CST; }
		| SPECIAL
				{ flags |= SPEC; }
		| EXTERN
				{ flags |= EXT; }
		| VAR
				{ flags |= VSYM; }
		| VIRTUAL
				{ flags |= VIRT; }
		;
		
headers		: header
		| headers ',' { argv = 0; } header
		;

header		: nid '='	{ if ($1 == NONE)
				    YYERROR;
				  else if ((symtb[$1].flags & DCL) &&
				      symtb[$1].modno == modno &&
				      (symtb[$1].flags & VSYM) !=
				      (flags & VSYM)) {
				    char msg[MAXSTRLEN];
				    sprintf(msg, qcmsg[MISM_DCL],
					    utf8_to_sys(strsp+symtb[$1].pname));
				    yyerror(msg);
				    YYERROR;
				  } else if (!(flags & VSYM) || type ||
					     (flags & (EXT|SPEC|VIRT))) {
				    yyerror(qcmsg[DCL_ERROR]);
				    YYERROR;
				  } else {
				    int vno = dclfvar($1, flags);
				    init_def(); $<xval>$ = funexpr(vno);
				    debug_info();
				  }
				}
		  expression0
				{ definition($<xval>3, $4); }
		| nid vid_list
				{ if ($1 == NONE)
				    ;
				  else if ((symtb[$1].flags & DCL) &&
				      symtb[$1].modno == modno &&
				      (symtb[$1].flags & VSYM) !=
				      (flags & VSYM)) {
				    char msg[MAXSTRLEN];
				    sprintf(msg, qcmsg[MISM_DCL],
					    utf8_to_sys(strsp+symtb[$1].pname));
				    yyerror(msg);
				    YYERROR;
				  } else if ((flags & VSYM) && ($2 || type) ||
					     (flags & VSYM) &&
					     (flags & (EXT|SPEC|VIRT)) ||
					     (flags & CST) && (flags & EXT) ||
					     type &&
					     (symtb[type].flags & EXT) &&
					     !(flags & VIRT) ||
					     !(flags & VSYM) &&
					     isvsym(strsp+symtb[$1].pname)) {
				    yyerror(qcmsg[DCL_ERROR]);
				    YYERROR;
				  } else if (flags & VSYM)
				    dclfvar($1, flags);
				  else
				    dclfun($1, type, $2, argv, flags, NONE); }
		| '(' cccnfid ')' vid_list op_prec
				{ int prec = $5;
				  if (prec == NONE && $2 != NONE &&
				      symtb[$2].modno == modno)
				    prec = symtb[$2].prec;
				  if (prec == NONE) prec = 2;
				  if ($2 == NONE)
				    ;
				  else if ((flags & VSYM) ||
				      (flags & CST) && (flags & EXT) ||
				      type && (symtb[type].flags & EXT) &&
				      !(flags & VIRT) ||
				      (prec == 5 || prec == 9) && $4 != 1 ||
				      (prec != 5 && prec != 9) && $4 != 2) {
				    yyerror(qcmsg[DCL_ERROR]);
				    YYERROR;
				  } else
				    dclfun($2, type, $4, argv, flags, prec); }
		| xxxqid vid_list id_alias
				{ int sym = $1; $1 = xxxsym($1);
				  if ($1 == NONE)
				    ;
				  else if (!(symtb[$1].flags&DCL)) {
				    yyerror(qcmsg[AS_DCL_ERROR]);
				    YYERROR;
				  } else if ((symtb[$1].flags & DCL) &&
					     (symtb[$1].flags & VSYM) !=
					     (flags & VSYM)) {
				    char msg[MAXSTRLEN];
				    sprintf(msg, qcmsg[MISM_DCL],
					    utf8_to_sys(strsp+symtb[$1].pname));
				    yyerror(msg);
				    YYERROR;
				  } else if ((flags & VSYM) && ($2 || type) ||
					     (flags & VSYM) && (flags & (EXT|SPEC|VIRT)) ||
					     (flags & CST) && (flags & EXT) ||
					     !(flags & VSYM) &&
					     isvsym(strsp+symtb[$1].pname) ||
					     type ||
					     $3 && symtb[$3].modno == modno &&
					     (symtb[$3].flags&DCL)) {
				    yyerror(qcmsg[DCL_ERROR]);
				    YYERROR;
				  } else if (flags & VSYM)
				    asfvar(sym, $3, flags);
				  else
				    asfun(sym, $3, $2, argv, flags, NONE); }
		| '(' xxxqfid_or_op ')' vid_list op_prec op_alias
				{ int sym = $2; $2 = xxxsym($2);
				  int prec = $5;
				  if (prec == NONE && $2 != NONE)
				    prec = symtb[$2].prec;
				  if ($2 == NONE)
				    ;
				  else if (!(symtb[$2].flags&DCL)) {
				    yyerror(qcmsg[AS_DCL_ERROR]);
				    YYERROR;
				  } else if ((flags & VSYM) ||
					     (flags & CST) && (flags & EXT) ||
					     type ||
					     $6 && symtb[$6].modno == modno &&
					     (symtb[$6].flags&DCL) ||
					     prec == NONE ||
					     (prec == 5 || prec == 9) && $4 != 1 ||
					     (prec != 5 && prec != 9) && $4 != 2) {
				    yyerror(qcmsg[DCL_ERROR]);
				    YYERROR;
				  } else
				    asfun(sym, $6, $4, argv, flags, prec); }
		;

vid_list	: /* empty */
				{ $$ = 0; }
		| vid_list UID
				{ if (flags & SPEC)
				    if ($1 < sizeof(unsigned long)*8)
				      argv |= 1<<$1;
				    else {
				      yyerror(qcmsg[DCL_ERROR]);
				      YYERROR;
				    }
				  $$ = $1+1; }
		| vid_list '~' UID
				{ if (!(flags & SPEC)) {
				    yyerror(qcmsg[DCL_ERROR]);
				    YYERROR;
				  }
				  $$ = $1+1; }
		;

op_prec		: /* empty */
			{ $$ = NONE; }
		| '@' INT
			{ $$ = precval($2); }
		| '@' '(' op ')'
			{ int prec = symtb[$3].prec;
			  if (prec >= 0 && prec <= 9 && prec != 8)
			    $$ = prec;
			  else {
			    yyerror(qcmsg[INVALID_PREC]);
			    $$ = NONE;
			  }
			}
		;

id_alias	: /* empty */
			{ $$ = 0; }
		| AS nid
			{ $$ = $2; }
		;

op_alias	: /* empty */
			{ $$ = 0; }
		| AS cccnid
			{ $$ = $2; }
		;

definition	: DEF defs ';'
		| UNDEF undefs ';'
		;

defs		: def
		| defs ',' def
		;

def		: 		{ init_def(); }
		  lexpression0 '='
				{ debug_info(); }
		  expression0
				{ definition($2, $5); }
		;

undefs		: undef
		| undefs ',' undef
		;

undef		: id
				{ if ($1 != NONE) {
				    init_def();
				    if (!(symtb[$1].flags & VSYM))
				      yyerror(qcmsg[INVALID_DEF]);
				    else {
				      symtb[$1].flags |= DCL;
				      debug_info();
				      definition(funexpr($1), NULL);
				    }
				  }
				}
		;

rule		: lexpression0
				{ debug_info(); left_hand_side($1);
				  start_qualifiers(); }
		  body
				{ end_rule(); }
		;

body		: opt_qualifiers '='
				{ begin_rule(); start_qualifiers(); }
		  expression0 qualifiers ';'
				{ qualifiers(); right_hand_side($4);
				  start_qualifiers(); }
		| body		{ qualtest = 1; }
		  opt_qualifiers2 '='
				{ qualtest = 0;
				  begin_rule(); start_qualifiers(); }
		  expression0 qualifiers ';'
				{ qualifiers(); right_hand_side($6);
				  start_qualifiers(); }
		;

opt_qualifiers	: /* empty */
				{ mark(); }
		| lqualifiers ':'
				{ qualifiers(); mark(); }
		;

opt_qualifiers2	: /* empty */
		| lqualifiers ':'
				{ qualifiers(); mark(); }
		;

lqualifiers	: lqualifier
		| lqualifiers lqualifier

lqualifier	: condition
				{ add_qualifier($1); }
		| where
		;

qualifiers	: /* empty */
		| qualifiers condition
				{ add_qualifier($2); }
		| qualifiers where
		;

condition	: IF		{ if (qualtest) qualtest = 0,
				    same_left_hand_side(); }
		  expression
				{ $$ = $3; }
		| OTHERWISE
				{ if (qualtest) qualtest = 0,
				    same_left_hand_side();
				  $$ = NULL; }
		;

where		: WHERE
				{ if (qualtest) qualtest = 0,
				    same_left_hand_side();
				  start_where_clauses(); }
		  where_clauses
				{ end_where_clauses(); }
		;

where_clauses	: where_clause
		| where_clauses ',' where_clause
		;

where_clause	: lexpression0 '=' expression0
				{ add_where_clause($1, $3); }
		;

/* top-level expressions (= operator and if-then-else not permitted here) */

lexpression0	: lsequence0
		| '\\' llambda0	{ $$ = $2; }
		;

llambda0	: lprimary '.' lexpression0
				{ $$ = binexpr(LAMBDAOP, $1, $3); }
		| lprimary llambda0
				{ $$ = binexpr(LAMBDAOP, $1, $2); }
		;

lsequence0	: lcond0
		| lsequence0 seqop lcond0
				{ $$ = binexpr($2, $1, $3); }
		;

lcond0		: lrightapp0
/* Q 7.7: eliminated lhs toplevel if-then-else construct to resolve syntactic
   ambiguity with left-hand guards
		| IF lrightapp THEN lcond0 ELSE lcond0
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::ifelse"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ternexpr(fno, $2, $4, $6); }
		| IF lrightapp THEN lcond0
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::when"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = binexpr(fno, $2, $4); }
*/
		;

lrightapp0	: lrelation0
		| lrelation0 rappop lrightapp0
				{ $$ = binexpr($2, $1, $3); }
		;

lrelation0	: laddition
		| laddition relop0 laddition
				{ $$ = binexpr($2, $1, $3); }
		;

expression0	: sequence0
		| '\\' lambda0	{ $$ = $2; }
		;

lambda0		: primary '.' expression0
				{ $$ = binexpr(LAMBDAOP, $1, $3); }
		| primary lambda0
				{ $$ = binexpr(LAMBDAOP, $1, $2); }
		;

sequence0	: cond0
		| sequence0 seqop cond0
				{ $$ = binexpr($2, $1, $3); }
		;

cond0		: rightapp0
		| IF rightapp THEN cond0 ELSE cond0
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::ifelse"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ternexpr(fno, $2, $4, $6); }
		| IF rightapp THEN cond0
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::when"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = binexpr(fno, $2, $4); }
		;

rightapp0	: relation0
		| relation0 rappop rightapp0
				{ $$ = binexpr($2, $1, $3); }
		;

relation0	: addition
		| addition relop0 addition
				{ $$ = binexpr($2, $1, $3); }
		;

relop0		: EQUIV		{ $$ = IDOP; }
		| OP2
		;

/* These are duplicated from below to keep track of whether we're in the lhs
   of a definition. */

lexpression	: lsequence
		| '\\' llambda	{ $$ = $2; }
		;

llambda		: lprimary '.' lexpression
				{ $$ = binexpr(LAMBDAOP, $1, $3); }
		| lprimary llambda
				{ $$ = binexpr(LAMBDAOP, $1, $2); }
		;

lsequence	: lcond
		| lsequence seqop lcond
				{ $$ = binexpr($2, $1, $3); }
		;

lcond		: lrightapp
		| IF lrightapp THEN lcond ELSE lcond
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::ifelse"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ternexpr(fno, $2, $4, $6); }
		| IF lrightapp THEN lcond
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::when"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = binexpr(fno, $2, $4); }
		;

lrightapp	: lrelation
		| lrelation rappop lrightapp
				{ $$ = binexpr($2, $1, $3); }
		;

lrelation	: laddition
		| laddition relop laddition
				{ $$ = binexpr($2, $1, $3); }
		;

laddition	: lmultiplication
		| laddition addop lmultiplication
				{ $$ = binexpr($2, $1, $3); }
		| laddition '-' lmultiplication
				{ $$ = binexpr(MINOP, $1, $3); }
		;

lmultiplication	: lunary
		| lmultiplication mulop lunary
				{ $$ = binexpr($2, $1, $3); }
		;

/* ! ambiguous rule */

lunary		: lscript
		| '-' INT	{ mpz_neg($2, $2); $$ = intexpr($2); }
		| '-' FLOAT	{ $$ = floatexpr(-$2); }
		| '-' lunary	{ $$ = unexpr(UMINOP, $2); }
		| unop lunary   { $$ = unexpr($1, $2); }

lscript		: lcomposition
		| lcomposition scriptop lscript
				{ $$ = binexpr($2, $1, $3); }
		;

lcomposition	: lapplication
		| lcomposition compop lapplication
				{ $$ = binexpr($2, $1, $3); }
		;

lapplication	: lprimary
		| lapplication lprimary
				{ $$ = appexpr($1, $2); }
		;

expression	: sequence
		| '\\' lambda	{ $$ = $2; }
		;

lambda		: primary '.' expression
				{ $$ = binexpr(LAMBDAOP, $1, $3); }
		| primary lambda
				{ $$ = binexpr(LAMBDAOP, $1, $2); }
		;

sequence	: cond
		| sequence seqop cond
				{ $$ = binexpr($2, $1, $3); }
		;

seqop		: OP0
		;

cond		: rightapp
		| IF rightapp THEN cond ELSE cond
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::ifelse"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ternexpr(fno, $2, $4, $6); }
		| IF rightapp THEN cond
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::when"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = binexpr(fno, $2, $4); }
		;

rightapp	: relation
		| relation rappop rightapp
				{ $$ = binexpr($2, $1, $3); }
		;

rappop		: OP1
		;

relation	: addition
		| addition relop addition
				{ $$ = binexpr($2, $1, $3); }
		;

relop		: '='		{ $$ = EQOP; }
		| EQUIV		{ $$ = IDOP; }
		| OP2
		;

addition	: multiplication
		| addition addop multiplication
				{ $$ = binexpr($2, $1, $3); }
		| addition '-' multiplication
				{ $$ = binexpr(MINOP, $1, $3); }
		;

addop		: OP3 ELSE	{ if ($1 != OROP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ORELSEOP; }
		| OP3
		;

multiplication	: unary
		| multiplication mulop unary
				{ $$ = binexpr($2, $1, $3); }
		;

mulop		: OP4 THEN	{ if ($1 != ANDOP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ANDTHENOP; }
		| OP4
		;

/* ! ambiguous rule */

unary		: script
		| '-' INT	{ mpz_neg($2, $2); $$ = intexpr($2); }
		| '-' FLOAT	{ $$ = floatexpr(-$2); }
		| '-' unary	{ $$ = unexpr(UMINOP, $2); }
		| unop unary    { $$ = unexpr($1, $2); }
		;

unop		: OP5
		;

script		: composition
		| composition scriptop script
				{ $$ = binexpr($2, $1, $3); }
		;

scriptop	: OP6
		;

composition	: application
		| composition compop application
				{ $$ = binexpr($2, $1, $3); }
		;

compop		: '.'		{ $$ = COMPOP; }
		| OP7
		;

application	: primary
		| application primary
				{ $$ = appexpr($1, $2); }
		;

quoteop		: '~'		{ $$ = FORCEOP; }
		| OP9
		;

/* type guards are only permitted in lhs expressions */

lprimary	: atom

		| vid ':' tid	{ checktype($3); vartb[$1].type = $3;
				  $$ = varexpr($1); }

		/* quoted expressions */
		
		| quoteop lprimary
				{ $$ = unexpr($1, $2); }

                /* sections: */

		| '(' lsequence seqop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' seqop lrightapp ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' lrelation rappop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' rappop lrightapp ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' laddition relop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' relop laddition ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' laddition addop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' laddition '-' ')'
				{ $$ = appexpr(funexpr(MINOP), $2); }

		| '(' addop lmultiplication ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' lmultiplication mulop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' mulop lunary ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' lcomposition scriptop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' scriptop lscript ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' lcomposition compop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' compop lapplication ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		/* parenthesized expressions and tuples: */

		| '(' ')'
				{ $$ = funexpr(VOIDOP); }
		| '(' lexpression ')'
				{ $$ = $2; }
		| '(' lexpression ',' ')'
				{ $$ = pairexpr($2, funexpr(VOIDOP)); }
		| '(' lexpression ';' ')'
				{ $$ = pairexpr(pairexpr($2, funexpr(VOIDOP)),
						funexpr(VOIDOP)); }
		| '(' lexpression '|' lexpression ')'
				{ $$ = pairexpr($2, $4); }
		| '(' lexpression DOTDOT lexpression ')'
				{ $$ = appexpr(appexpr(funexpr(TENUMOP),
				  listexpr(addexpr(addexpr(exprlist(), $2),
						   funexpr(NILOP)))),
				  $4); }
		| '(' lexpression DOTDOT ')'
				{ $$ = appexpr(funexpr(TENUM1OP),
				  listexpr(addexpr(addexpr(exprlist(), $2),
						   funexpr(NILOP)))); }
		| '(' lexpression ',' lexpr_list1 ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' lexpression ',' lexpr_list1 ',' ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' lexpression ',' lexpr_list1 ';' ')'
				{ if ($4->m < 0) $4->m = 0;
				  $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' lexpression ',' lexpr_list1 '|' lexpression ')'
				{ $$ = tupleexpr(addexpr($4, $6)); }
		| '(' lexpression ',' lexpr_list1 DOTDOT lexpression ')'
				{ $$ = appexpr(appexpr(funexpr(TENUMOP),
				  listexpr(addexpr($4, funexpr(NILOP)))),
				  $6); }
		| '(' lexpression ',' lexpr_list1 DOTDOT ')'
				{ $$ = appexpr(funexpr(TENUM1OP),
				  listexpr(addexpr($4, funexpr(NILOP)))); }
/* handle the special case of a group of size 1 at the beginning of the
   tuple */
		| '(' lexpression ';' lexpr_list2 ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' lexpression ';' lexpr_list2 ',' ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' lexpression ';' lexpr_list2 ';' ')'
				{ if ($4->m < 0) $4->m = 0;
				  $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' lexpression ';' lexpr_list2 '|' lexpression ')'
				{ $$ = tupleexpr(addexpr($4, $6)); }

		/* lists: */

		| '[' ']'
			{ $$ = funexpr(NILOP); }
		| '[' lexpr_list ']'
				{ $$ = listexpr(
				  addexpr($2, funexpr(NILOP))); }
		| '[' lexpr_list ',' ']'
				{ $$ = listexpr(
				  addexpr($2, funexpr(NILOP))); }
		| '[' lexpr_list ';' ']'
				{ if ($2->m < 0) $2->m = 0;
				  $$ = listexpr(
				  addexpr($2, funexpr(NILOP))); }
		| '[' lexpr_list '|' lexpression ']'
				{ $$ = listexpr(addexpr($2, $4)); }
		| '[' lexpr_list DOTDOT lexpression ']'
				{ $$ = appexpr(appexpr(funexpr(ENUMOP),
				  listexpr(addexpr($2, funexpr(NILOP)))),
				  $4); }
		| '[' lexpr_list DOTDOT ']'
				{ $$ = appexpr(funexpr(ENUM1OP),
				  listexpr(addexpr($2, funexpr(NILOP)))); }

		/* streams: */

		| '{' '}'
			{ $$ = funexpr(SNILOP); }
		| '{' lexpr_list '}'
				{ $$ = streamexpr(
				  addexpr($2, funexpr(SNILOP))); }
		| '{' lexpr_list ',' '}'
				{ $$ = streamexpr(
				  addexpr($2, funexpr(SNILOP))); }
		| '{' lexpr_list ';' '}'
				{ if ($2->m < 0) $2->m = 0;
				  $$ = streamexpr(
				  addexpr($2, funexpr(SNILOP))); }
		| '{' lexpr_list '|' lexpression '}'
				{ $$ = streamexpr(addexpr($2, $4)); }
		| '{' lexpr_list DOTDOT lexpression '}'
				{ $$ = appexpr(appexpr(funexpr(SENUMOP),
				  listexpr(addexpr($2, funexpr(NILOP)))),
				  $4); }
		| '{' lexpr_list DOTDOT '}'
				{ $$ = appexpr(funexpr(SENUM1OP),
				  listexpr(addexpr($2, funexpr(NILOP)))); }

		;

/* inline var declarations and list/stream comprehensions are only permitted
   on the rhs of definitions */

primary		: atom

		/* inline var declaration */

		| VAR nid	{ int vno = $2;
				  if (!(symtb[vno].flags&DCL) ||
				      symtb[vno].modno != modno ||
				      !(symtb[vno].flags&VSYM))
				    vno = dclfvar(vno, PRIV|VSYM);
				  $$ = funexpr(vno); }

		/* quoted expressions */
		
		| quoteop primary
				{ $$ = unexpr($1, $2); }

                /* sections: */

		| '(' sequence seqop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' seqop rightapp ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' relation rappop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' rappop rightapp ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' addition relop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' relop addition ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' addition addop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' addition '-' ')'
				{ $$ = appexpr(funexpr(MINOP), $2); }

		| '(' addop multiplication ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' multiplication mulop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' mulop unary ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' composition scriptop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' scriptop script ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		| '(' composition compop ')'
				{ $$ = appexpr(funexpr($3), $2); }

		| '(' compop application ')'
				{ $$ = appexpr(appexpr(funexpr(FLIPOP),
						       funexpr($2)),
					       $3); }

		/* parenthesized expressions and tuples: */

		| '(' ')'
				{ $$ = funexpr(VOIDOP); }
		| '(' expression ')'
				{ $$ = $2; }
		| '(' expression ',' ')'
				{ $$ = pairexpr($2, funexpr(VOIDOP)); }
		| '(' expression ';' ')'
				{ $$ = pairexpr(pairexpr($2, funexpr(VOIDOP)),
						funexpr(VOIDOP)); }
		| '(' expression '|' expression ')'
				{ $$ = pairexpr($2, $4); }
		| '(' expression DOTDOT expression ')'
				{ $$ = appexpr(appexpr(funexpr(TENUMOP),
				  listexpr(addexpr(addexpr(exprlist(), $2),
						   funexpr(NILOP)))),
				  $4); }
		| '(' expression DOTDOT ')'
				{ $$ = appexpr(funexpr(TENUM1OP),
				  listexpr(addexpr(addexpr(exprlist(), $2),
						   funexpr(NILOP)))); }
		| '(' expression ',' expr_list1 ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' expression ',' expr_list1 ',' ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' expression ',' expr_list1 ';' ')'
				{ if ($4->m < 0) $4->m = 0;
				  $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' expression ',' expr_list1 '|' expression ')'
				{ $$ = tupleexpr(addexpr($4, $6)); }
		| '(' expression ',' expr_list1 DOTDOT expression ')'
				{ $$ = appexpr(appexpr(funexpr(TENUMOP),
				  listexpr(addexpr($4, funexpr(NILOP)))),
				  $6); }
		| '(' expression ',' expr_list1 DOTDOT ')'
				{ $$ = appexpr(funexpr(TENUM1OP),
				  listexpr(addexpr($4, funexpr(NILOP)))); }
		| '(' expression ':'
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::tupleof"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $<ival>$ = fno; }
		  expr_list ')'
				{ $$ = appexpr(appexpr(funexpr($<ival>4), $2),
				  tupleexpr(addexpr($5, funexpr(VOIDOP)))); }
/* handle the special case of a group of size 1 at the beginning of the
   tuple */
		| '(' expression ';' expr_list2 ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' expression ';' expr_list2 ',' ')'
				{ $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' expression ';' expr_list2 ';' ')'
				{ if ($4->m < 0) $4->m = 0;
				  $$ = tupleexpr(addexpr($4, funexpr(VOIDOP))); }
		| '(' expression ';' expr_list2 '|' expression ')'
				{ $$ = tupleexpr(addexpr($4, $6)); }

		/* lists: */

		| '[' ']'
			{ $$ = funexpr(NILOP); }
		| '[' expr_list ']'
				{ $$ = listexpr(
				  addexpr($2, funexpr(NILOP))); }
		| '[' expr_list ',' ']'
				{ $$ = listexpr(
				  addexpr($2, funexpr(NILOP))); }
		| '[' expr_list ';' ']'
				{ if ($2->m < 0) $2->m = 0;
				  $$ = listexpr(
				  addexpr($2, funexpr(NILOP))); }
		| '[' expr_list '|' expression ']'
				{ $$ = listexpr(addexpr($2, $4)); }
		| '[' expr_list DOTDOT expression ']'
				{ $$ = appexpr(appexpr(funexpr(ENUMOP),
				  listexpr(addexpr($2, funexpr(NILOP)))),
				  $4); }
		| '[' expr_list DOTDOT ']'
				{ $$ = appexpr(funexpr(ENUM1OP),
				  listexpr(addexpr($2, funexpr(NILOP)))); }
		| '[' expression ':'
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::listof"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $<ival>$ = fno; }
		  expr_list ']'
				{ $$ = appexpr(appexpr(funexpr($<ival>4), $2),
				  tupleexpr(addexpr($5, funexpr(VOIDOP)))); }

		/* streams: */

		| '{' '}'
			{ $$ = funexpr(SNILOP); }
		| '{' expr_list '}'
				{ $$ = streamexpr(
				  addexpr($2, funexpr(SNILOP))); }
		| '{' expr_list ',' '}'
				{ $$ = streamexpr(
				  addexpr($2, funexpr(SNILOP))); }
		| '{' expr_list ';' '}'
				{ if ($2->m < 0) $2->m = 0;
				  $$ = streamexpr(
				  addexpr($2, funexpr(SNILOP))); }
		| '{' expr_list '|' expression '}'
				{ $$ = streamexpr(addexpr($2, $4)); }
		| '{' expr_list DOTDOT expression '}'
				{ $$ = appexpr(appexpr(funexpr(SENUMOP),
				  listexpr(addexpr($2, funexpr(NILOP)))),
				  $4); }
		| '{' expr_list DOTDOT '}'
				{ $$ = appexpr(funexpr(SENUM1OP),
				  listexpr(addexpr($2, funexpr(NILOP)))); }
		| '{' expression ':'
				{ static char sym[20];
				  int fno = getfun(strcpy(sym, "cond::streamof"));
				  if (fno == NONE) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $<ival>$ = fno; }
		  expr_list '}'
				{ $$ = appexpr(appexpr(funexpr($<ival>4), $2),
				  tupleexpr(addexpr($5, funexpr(VOIDOP)))); }

		;

/* atomic expressions (permitted on either side of a definition) */

atom
		/* constants: */

		: INT		{ $$ = intexpr($1); }
		| FLOAT		{ $$ = floatexpr($1); }
		| STR		{ $$ = strexpr($1); }

		/* variable and function symbols: */

		| '(' op ')'	{ $$ = funexpr($2); }
		| fid		{ $$ = funexpr($1); }
		| qvid		{ $$ = funexpr($1); }
		| vid		{ vartb[$1].type = 0;
				  $$ = varexpr($1); }
		;

lexpr_list1	: lexpression
				{ $$ = addexpr(addexpr(exprlist(), $<xval>-1),
					       $1); }
		| lexpr_list1 ',' lexpression
				{ $$ = addexpr($1, $3); }
		| lexpr_list1 ';' lexpression
				{ $$ = groupexpr(addexpr($1, $3)); }
		;

lexpr_list2	: lexpression
				{ $$ = groupexpr(addexpr(addexpr(exprlist(),
								 $<xval>-1),
							 $1)); }
		| lexpr_list2 ',' lexpression
				{ $$ = addexpr($1, $3); }
		| lexpr_list2 ';' lexpression
				{ $$ = groupexpr(addexpr($1, $3)); }
		;

lexpr_list	: lexpression
				{ $$ = addexpr(exprlist(), $1); }
		| lexpr_list ',' lexpression
				{ $$ = addexpr($1, $3); }
		| lexpr_list ';' lexpression
				{ $$ = groupexpr(addexpr($1, $3)); }
		;

expr_list1	: expression
				{ $$ = addexpr(addexpr(exprlist(), $<xval>-1),
					       $1); }
		| expr_list1 ',' expression
				{ $$ = addexpr($1, $3); }
		| expr_list1 ';' expression
				{ $$ = groupexpr(addexpr($1, $3)); }
		;

expr_list2	: expression
				{ $$ = groupexpr(addexpr(addexpr(exprlist(),
								 $<xval>-1),
							 $1)); }
		| expr_list2 ',' expression
				{ $$ = addexpr($1, $3); }
		| expr_list2 ';' expression
				{ $$ = groupexpr(addexpr($1, $3)); }
		;

expr_list	: expression
				{ $$ = addexpr(exprlist(), $1); }
		| expr_list ',' expression
				{ $$ = addexpr($1, $3); }
		| expr_list ';' expression
				{ $$ = groupexpr(addexpr($1, $3)); }
		;

builtin_op	: '='		{ $$ = EQOP; }
		| EQUIV		{ $$ = IDOP; }
		| '-'		{ $$ = MINOP; }
		| '~'		{ $$ = FORCEOP; }
		| '.'		{ $$ = COMPOP; }
		;

op		: builtin_op
		| OP3 ELSE	{ if ($1 != OROP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ORELSEOP; }
		| OP4 THEN	{ if ($1 != ANDOP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ANDTHENOP; }
		| OP0
		| OP1
		| OP2
		| OP3
		| OP4
		| OP5
		| OP6
		| OP7
		| OP9
		;

id		: fid
		| fvid
		;

nid		: nfid
		| nfvid
		;

fid		: LID
				{ $$ = mkfun($1); }
		| QLID
				{ $$ = mkfun($1); }
		;

nfid		: LID
				{ $$ = mkxfun($1); }
		;

vid		: UID
				{ $$ = mkvar($1); }
		;

fvid		: UID
				{ $$ = mkfvar($1); }
		| QUID
				{ $$ = mkfvar($1); }
		;

nfvid		: UID
				{ $$ = mkxfvar($1); }
		;

qvid		: QUID
				{ $$ = mkfvar($1); }
		;

/* These need a special parsing context (declarations). */

c_on		:		{ context = 1; }
		;

c_off		:		{ context = 0; }
		;

cccnid		: c_on nid c_off
				{ $$ = $2; }
		;

cccnfid		: c_on nfid c_off
				{ $$ = $2; }
		;

tid		: c_on UID c_off
				{ $$ = mktype($2); }
		| c_on LID c_off
				{ $$ = mktype($2); }
		| c_on QUID c_off
				{ $$ = mktype($2); }
		| c_on QLID c_off
				{ $$ = mktype($2); }
		;

ntid		: c_on UID c_off
				{ $$ = mkxtype($2); }
		| c_on LID c_off
				{ $$ = mkxtype($2); }
		;

/* These also need special treatment (qualified symbols in alias
   declarations). CAUTION: These symbols are returned unnormalized! */

xxxqid		: xxxqfid
		| xxxqfvid
		;

xxxqfid		: QLID
				{ $$ = mkxxxfun($1); }
		;

xxxqfvid	: QUID
				{ $$ = mkxxxfvar($1); }
		;

xxxqfid_or_op	: c_on xxxqfid_or_op2 c_off
				{ $$ = $2; }
		;

/* Give the programmer a way to declare (and then) and (or else). */

xxxqfid_or_op2	: xxxqfid ELSE	{ if ($1 != OROP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ORELSEOP; }
		| xxxqfid THEN	{ if ($1 != ANDOP) {
				    yyerror(qcmsg[SYNTAX_ERROR]);
				    YYERROR;
				  } else
				    $$ = ANDTHENOP; }
		| xxxqfid
		;

xxxqtid		: c_on QUID c_off
				{ $$ = mkxxxtype($2); }
		| c_on QLID c_off
				{ $$ = mkxxxtype($2); }
		;
		
%%

extern int      yyleng, yylineno;
extern char     *source;

yyerror(s)
	char           *s;
{
	fprintf(stderr, "Error %s, line %d: %s", source, yylineno, s);
	if (*yytext && (strcmp(s, "parse error") == 0 ||
			strcmp(s, "syntax error") == 0))
	  fprintf(stderr, " at or near symbol `%s'",
		  utf8_to_sys(yytext));
	fprintf(stderr, "\n");
	nerrs++;
}

yywarn(s)
	char           *s;
{
	if (wflag) {
		fprintf(stderr, "Warning %s, line %d: %s\n", source,
			yylineno, s);
		nwarns++;
	}
}

fatal(s)
	char           *s;
{
	if (source && *source)
		fprintf(stderr, "%s: %s: %s -- compilation aborted\n",
			self, source, s);
	else
		fprintf(stderr, "%s: %s -- compilation aborted\n",
			self, s);
	if (codefp) {
		fclose(codefp);
		remove(code);
	}
	exit(1);
}

#define no(n) n, n==1?"":"s"

static
statistics()
{
	int fno, k, n, b, bmax, btotal, n_data;
	for (n = bmax = btotal = k = 0; k < hashtbsz; k++)
		if (hashtb[k] != NONE) {
			n++;
			for (b = -1, fno = hashtb[k]; fno != NONE;
			     b++, fno = symtb[fno].next)
				;
			btotal += b;
			if (b+1>bmax)
				bmax = b+1;
		}
	n_data = strspsz+limbspsz*sizeof(mp_limb_t);
	printf("%d ops in %d module%s, ", codespsz, no(modtbsz));
	printf("%d byte%s data, ", no(n_data));
	printf("%d symbol%s,\n", no(symtbsz));
	printf("%d hash key%s out of %d, %d collision%s, max bucket size = %d\n",
	       no(n), hashtbsz, no(btotal), bmax);
	printf("%d state%s, %d transition%s, %d offset%s\n",
	       no(statetbsz), no(transtbsz), no(roffstbsz));
}

static void *
gmp_allocate (size)
     size_t size;
{
  void *ret;

  ret = malloc (size);
  if (ret == 0) fatal(qcmsg[MEM_OVF]);
  return ret;
}

static void *
gmp_reallocate (oldptr, old_size, new_size)
     void *oldptr;
     size_t old_size;
     size_t new_size;
{
  void *ret;

  ret = realloc (oldptr, new_size);
  if (ret == 0) fatal(qcmsg[MEM_OVF]);
  return ret;
}

static void
gmp_free (blk_ptr, blk_size)
     void *blk_ptr;
     size_t blk_size;
{
  free (blk_ptr);
}

#ifdef HAVE_UNICODE
static inline long
u8decode(char *s)
{
  size_t n;
  unsigned p = 0, q = 0;
  unsigned long c = 0;
  if (s[0] == 0)
    return -1;
  else if (s[1] == 0)
    return (unsigned char)s[0];
  for (n = 0; n == 0 && *s; s++) {
    unsigned char uc = (unsigned char)*s;
    if (q == 0) {
      if (((signed char)*s) < 0) {
	switch (uc & 0xf0) {
	case 0xc0: case 0xd0:
	  q = 1;
	  c = uc & 0x1f;
	  break;
	case 0xe0:
	  q = 2;
	  c = uc & 0xf;
	  break;
	case 0xf0:
	  if ((uc & 0x8) == 0) {
	    q = 3;
	    c = uc & 0x7;
	  } else
	    c = uc;
	  break;
	default:
	  c = uc;
	  break;
	}
      } else
	c = uc;
      p = 0;
      if (q == 0) n++;
    } else if ((uc & 0xc0) == 0x80) {
      /* continuation byte */
      c = c << 6 | (uc & 0x3f);
      if (--q == 0)
	n++;
      else
	p++;
    } else {
      /* malformed char */
      return -1;
    }
  }
  if (n == 1 && *s == 0)
    return c;
  else
    return -1;
}
#endif

static int isvsym(char *s)
{
  if (!*s)
    return 0;
  else {
#ifdef HAVE_UNICODE
    long c = u8decode(s);
    if (c < 0) c = (unsigned char)*s;
    return u_isupper(c);
#else
    return isupper(s[0]);
#endif
  }
}

RETSIGTYPE
break_handler()
/* handle SIGINT and SIGTERM */
{
  /* Since many system functions are unsave to call in a signal
     handler, we simply set a flag here; the corresponding actions
     in response to SIGINT (remove code file, close list file,
     terminate program) will be carried out later in a save
     context. */
  int_sig = 1;
  SIGHANDLER_RETURN(0);
}

checkint()
/* check for pending int_sig */
{
  if (int_sig) fatal("interrupt");
}

newrule()
/* reinitialize for the next rule */
{
  clear(); qualtest = 0; checkint();
}

newdecl()
/* reinitialize for the next declaration */
{
  flags = PRIV; argv = 0; checkint();
}

precval(z)
     mpz_t z;
/* calculate precedence level */
{
  if (my_mpz_fits_slong_p(z)) {
    long prec = mpz_get_si(z);
    if (prec >= 0 && prec <= 9 && prec != 8)
      return prec;
  }
  yyerror(qcmsg[INVALID_PREC]);
  return NONE;
}

priority(z)
     mpz_t z;
/* set a new priority level */
{
  if (my_mpz_fits_slong_p(z))
    prio = mpz_get_si(z);
  else
    yyerror(qcmsg[INVALID_PRIO]);
}

/* qualifier table */

int qual_size, qual_alloc, clause_size, clause_alloc;
static QUAL *qual;
static CLAUSE *clause;

static void start_qualifiers(void)
{
  qual_size = clause_size = 0;
}

static void qualifiers(void)
{
  int i;
  for (i = qual_size-1; i >= 0; i--)
    if (qual[i].x)
      qualifier(qual[i].x);
    else {
      int j;
      for (j = qual[i].start; j < qual[i].end; j++)
	where_clause(clause[j].l, clause[j].r);
    }
}

static void add_qualifier(EXPR *x)
{
  if (!x) return;
  if (qual_size >= qual_alloc)
    if ((qual = arealloc(qual, qual_alloc, 10, sizeof(QUAL))))
      qual_alloc += 10;
    else
      fatal("memory overflow");
  qual[qual_size++].x = x;
}

static void start_where_clauses(void)
{
  if (qual_size >= qual_alloc)
    if ((qual = arealloc(qual, qual_alloc, 10, sizeof(QUAL))))
      qual_alloc += 10;
    else
      fatal("memory overflow");
  qual[qual_size].x = NULL;
  qual[qual_size].start = clause_size;
}

static void end_where_clauses(void)
{
  qual[qual_size++].end = clause_size;
}

static void add_where_clause(EXPR *l, EXPR *r)
{
  if (clause_size >= clause_alloc)
    if ((clause = arealloc(clause, clause_alloc, 10, sizeof(CLAUSE))))
      clause_alloc += 10;
    else
      fatal("memory overflow");
  clause[clause_size].l = l;
  clause[clause_size].r = r;
  clause_size++;
}

/* expression lists */

static xvect_t *exprlist(void)
{
  xvect_t *v = (xvect_t*)malloc(sizeof(xvect_t));
  if (!v) fatal("memory overflow");
  v->a = v->n = 0; v->m = -1;
  v->xv = NULL;
  return v;
}

static xvect_t *addexpr(xvect_t *v, EXPR *x)
{
  if (v->n >= v->a) {
    v->a += 100;
    if (v->xv)
      v->xv = realloc(v->xv, v->a*sizeof(EXPR*));
    else
      v->xv = malloc(v->a*sizeof(EXPR*));
    if (!v->xv) fatal("memory overflow");
  }
  v->xv[v->n++] = x;
  return v;
}

static xvect_t *groupexpr(xvect_t *v)
{
  EXPR *x, *y;
  int n = v->n, m = v->m;
  if (n <= 0) fatal("internal compiler error");
  if (m < 0) m = 0;
  y = v->xv[--n];
  x = funexpr(VOIDOP);
  while (n > m)
    x = pairexpr(v->xv[--n], x);
  v->xv[n++] = x; m = n;
  v->xv[n++] = y;
  v->n = n; v->m = m;
  return v;
}

static EXPR *tupleexpr(xvect_t *v)
{
  EXPR *x;
  int n;
  if (v->m >= 0) groupexpr(v);
  n = v->n;
  if (n <= 0) fatal("internal compiler error");
  x = v->xv[--n];
  while (n > 0)
    x = pairexpr(v->xv[--n], x);
  free(v->xv);
  free(v);
  return x;
}

static EXPR *listexpr(xvect_t *v)
{
  EXPR *x;
  int n;
  if (v->m >= 0) groupexpr(v);
  n = v->n;
  if (n <= 0) fatal("internal compiler error");
  x = v->xv[--n];
  while (n > 0)
    x = consexpr(v->xv[--n], x);
  free(v->xv);
  free(v);
  return x;
}

static EXPR *streamexpr(xvect_t *v)
{
  EXPR *x;
  int n;
  if (v->m >= 0) groupexpr(v);
  n = v->n;
  if (n <= 0) fatal("internal compiler error");
  x = v->xv[--n];
  while (n > 0)
    x = appexpr(appexpr(funexpr(SCONSOP), v->xv[--n]), x);
  free(v->xv);
  free(v);
  return x;
}

static struct option longopts[] = QC_OPTS;
static struct option all_longopts[] = Q_OPTS;

static int
getintarg(char *s, int *i)
{
  char *t = s;
  while (isspace(*t)) t++;
  s = t;
  while (isdigit(*t)) t++;
  if (t == s) return 0;
  while (isspace(*t)) t++;
  if (*t) return 0;
  *i = atoi(s);
  return 1;
}

static void
parse_opts(argc, argv, pass)
     int argc;
     char **argv;
     int pass; /* 0 denotes source, 1 command line pass */
{
  int c, longind;
  optind = 0;
  while ((c = getopt_long(argc, argv,
			  pass?QC_OPTS1:Q_OPTS1,
			  pass?longopts:all_longopts,
			  &longind)) != EOF)
    switch (c) {
    case QC_PEDANTIC:
      wflag = 2;
      break;
    case QC_PARANOID:
      wflag = 3;
      break;
    case QC_NO_PRELUDE:
      prelude = NULL;
      break;
    case QC_PRELUDE:
      prelude = optarg?optarg:prelude;
      break;
    case QC_ENCODING: {
#if defined(HAVE_UNICODE) && defined(HAVE_ICONV)
      if (optarg)
	if (pass) {
	  iconv_t ic = iconv_open("UTF-8", optarg);
	  if (ic == (iconv_t)-1) {
	    char msg[MAXSTRLEN];
	    sprintf(msg, "unknown encoding `%s'", optarg);
	    fatal(msg);
	  } else {
	    iconv_close(ic);
	    default_codeset = optarg;
	  }
	} else /* errors will be caught later by lexer */
	  default_codeset = optarg;
#else
      fprintf(stderr, "%s: warning: --encoding option not supported\n", self);
#endif
      break;
    }
    case 'd':
      if (pass)
	dflag = 1;
      break;
    case 'h':
      hflag = 1;
      break;
    case 'l':
      list = optarg?optarg:list;
      break;
    case 'n':
      nflag = 1;
      break;
    case 'o':
      code = optarg?optarg:code;
      break;
    case 'p':
      if (optarg) {
	change_qpath(optarg);
	if (!qpath) fatal("memory overflow");
      }
      break;
    case 't': {
      int sz;
      if (optarg && getintarg(optarg, &sz) && sz > 0)
	hashtbsz = sz;
      else {
	char msg[MAXSTRLEN];
	sprintf(msg, "invalid size `%s'", optarg?optarg:"");
	fatal(msg);
      }
      break;
    }
    case 'v':
      vflag = 1;
      break;
    case 'w': {
      int level = 1;
      if (optarg && (!getintarg(optarg, &level) || level < 0 || level > 255)) {
	char msg[MAXSTRLEN];
	sprintf(msg, "invalid warning level `%s'", optarg?optarg:"");
	fatal(msg);
      }
      wflag = level;
      break;
    }
    case 'V':
      Vflag = 1;
      break;
    /* interpreter options (ignored): */
    case Q_GNUCLIENT:
    case Q_DEBUG_OPTIONS:
    case Q_BREAK:
    case Q_PROMPT:
    case Q_DEC:
    case Q_HEX:
    case Q_OCT:
    case Q_STD:
    case Q_SCI:
    case Q_FIX:
    case Q_HISTFILE:
    case Q_HISTSIZE:
    case Q_INITRC:
    case Q_NO_INITRC:
    case Q_EXITRC:
    case Q_NO_EXITRC:
    case Q_NO_EDITING:
    case Q_STACKSIZE:
    case Q_MEMSIZE:
    case 'e':
    case 'i':
    case 'q':
    case 'c':
    case 's':
      break;
    default:
      exit(1);
    }
}

static int sargc;
static char **sargv;

static void
get_source_opts(FILE *fp)
{
  char s[MAXSTRLEN];
  int i;

  sargc = 1;
  sargv = aalloc(1, sizeof(char*));
  *sargv = strdup(self);
  while (!feof(fp) && !ferror(fp) &&
	 fgets(s, MAXSTRLEN, fp)) {
    int l = strlen(s);
    if (l > 0 && s[l-1] == '\n') s[l-1] = '\0', l--;
    if (l == 0)
      continue;
    else if (strncmp(s, "#!", 2) == 0)
      if (isspace(s[2])) {
	char *p = s+3;
	while (isspace(*p)) p++;
	sargv = arealloc(sargv, sargc, 1, sizeof(char*));
	sargv[sargc++] = strdup(p);
      } else
	continue;
    else
      break;
  }
  sargv = arealloc(sargv, sargc, 1, sizeof(char*));
  sargv[sargc] = NULL;
}

main(argc, argv)
	int             argc;
	char          **argv;
{
	int c, longind;
	char *s;

#if defined(HAVE_UNICODE) && defined(HAVE_LOCALE_H)
	setlocale(LC_ALL, "");
#endif

#ifdef _WIN32
	InstallSignalHandler();
#endif

	/* get program name: */
	self = argv[0];

	/* get environment settings: */
	if ((s = getenv("QPATH")) != NULL)
	  init_qpath(s);
	else
	  init_qpath(QPATH);
	if (!qpath) fatal("memory overflow");

	if ((s = getenv("QWARN")) != NULL) {
	  int level;
	  if (getintarg(s, &level) && level >= 0 && level <= 255)
	    wflag = level;
	}

	/* scan command line to obtain the first source file name: */
	opterr = 0;
	while ((c = getopt_long(argc, argv, Q_OPTS1,
				longopts, &longind)) != EOF)
	  ;
	opterr = 1;

	/* get options from the main script: */
	if (argc-optind >= 1 && strcmp(argv[optind], "-")) {
	  char fname[MAXSTRLEN], fname2[MAXSTRLEN];
	  FILE *fp;
	  if (chkfile(searchlib(fname, argv[optind])) &&
	      (fp = fopen(fname, "r")) != NULL ||
	      chkfile(searchlib(fname, strcat(strcpy(fname2, argv[optind]),
					      ".q"))) &&
	      (fp = fopen(fname, "r")) != NULL) {
	    get_source_opts(fp);
	    fclose(fp);
	    parse_opts(sargc, sargv, 0);
	  }
	}

	/* get command line options: */
	parse_opts(argc, argv, 1);
	argc -= optind, argv += optind;

	if (Vflag) {
		printf(signon, version, sysinfo, year);
		printf(copying);
		printf(helpmsg, self);
		exit(0);
	}
	if (hflag) {
		printf(usage, self);
		sprintf(opts, QC_OPTMSG, QPATH, HASHTBSZ);
		fputs(opts, stdout);
		exit(0);
	}

	/* install break and term handlers: */
	sigint(break_handler);
	sigterm(break_handler);
	sighup(break_handler);

	/* install gmp memory handlers */
	mp_set_memory_functions(gmp_allocate, gmp_reallocate, gmp_free);

	/* set code file id: */
	sprintf(outid, OUTID, version, sysinfo);

	/* compile: */
	if (*list) {
	  FILE *fp;
	  if (!(fp = fopen(list, "w"))) {
	    fprintf(stderr, "%s: error creating %s\n",
		    self, list);
	    exit(1);
	  } else {
	    fclose(fp);
	    freopen(list, "w", stderr);
	  }
	}
	if (!(codefp = fopen(code, "wb"))) {
	  fprintf(stderr, "%s: error creating %s\n",
		  self, code);
	  exit(1);
	}
	mainno = -1;
	write_header();
	inittables();
	if (!initlex(argc, argv) || yyparse() == 0 && nerrs == 0) {
	  /* generate code: */
	  write_strsp();
	  write_limbsp();
	  write_hashtb();
	  write_symtb();
	  write_TA();
	  write_matchtb();
	  write_inittb();
	  write_modtb();
	  fix_header();
	  checkint();
	  if (nflag) {
	    fclose(codefp);
	    remove(code);
	  } else
	    fclose(codefp);
	  if (list && !nwarns) {
	    fclose(stderr);
	    remove(list);
	  }
	  if (vflag)
	    statistics();
	  exit(0);
	} else {
	  checkint();
	  fclose(codefp);
	  remove(code);
	  if (vflag)
	    putchar('\n');
	  exit(1);
	}
}