ghc/compiler/parser/hsparser.y

   1 /**************************************************************************
   2 *   File:               hsparser.y                                        *
   3 *                                                                         *
   4 *                       Author:                 Maria M. Gutierrez        *
   5 *                       Modified by:            Kevin Hammond             *
   6 *                       Last date revised:      December 13 1991. KH.     *
   7 *                       Modification:           Haskell 1.1 Syntax.       *
   8 *                                                                         *
   9 *                                                                         *
  10 *   Description:  This file contains the LALR(1) grammar for Haskell.     *
  11 *                                                                         *
  12 *   Entry Point:  module                                                  *
  13 *                                                                         *
  14 *   Problems:     None known.                                             *
  15 *                                                                         *
  16 *                                                                         *
  17 *                 LALR(1) Syntax for Haskell 1.2                          *
  18 *                                                                         *
  19 **************************************************************************/
  20
  21
  22 %{
  23 #ifdef HSP_DEBUG
  24 # define YYDEBUG 1
  25 #endif
  26
  27 #include <stdio.h>
  28 #include <ctype.h>
  29 #include <string.h>
  30 #include "hspincl.h"
  31 #include "constants.h"
  32 #include "utils.h"
  33
  34 /**********************************************************************
  35 *                                                                     *
  36 *                                                                     *
  37 *     Imported Variables and Functions                                *
  38 *                                                                     *
  39 *                                                                     *
  40 **********************************************************************/
  41
  42 static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
  43
  44 extern BOOLEAN nonstandardFlag;
  45 extern BOOLEAN etags;
  46
  47 extern VOID find_module_on_imports_dirlist PROTO((char *, BOOLEAN, char *));
  48
  49 extern char *input_filename;
  50 static char *the_module_name;
  51 static char *iface_name;
  52 static char iface_filename[FILENAME_SIZE];
  53
  54 static maybe module_exports;            /* Exported entities */
  55 static list prelude_core_import, prelude_imports;
  56                                         /* Entities imported from the Prelude */
  57
  58 extern tree niltree;
  59 extern list Lnil;
  60
  61 extern tree root;
  62
  63 /* For FN, PREVPATT and SAMEFN macros */
  64 extern qid      fns[];
  65 extern BOOLEAN  samefn[];
  66 extern tree     prevpatt[];
  67 extern short    icontexts;
  68
  69 /* Line Numbers */
  70 extern int hsplineno, hspcolno;
  71 extern int modulelineno;
  72 extern int startlineno;
  73 extern int endlineno;
  74
  75 /**********************************************************************
  76 *                                                                     *
  77 *                                                                     *
  78 *      Fixity and Precedence Declarations                             *
  79 *                                                                     *
  80 *                                                                     *
  81 **********************************************************************/
  82
  83 /* OLD 95/08: list fixlist; */
  84 static int Fixity = 0, Precedence = 0;
  85 struct infix;
  86
  87 char *ineg PROTO((char *));
  88
  89 int importlineno = 0;           /* The line number where an import starts */
  90
  91 long    inimport;               /* Info about current import */
  92 id      importmod;
  93 long    importas;
  94 id      asmod;
  95 long    importqual;
  96 long    importspec;
  97 long    importhide;
  98 list    importlist;
  99
 100 extern BOOLEAN inpat;                   /*  True when parsing a pattern */
 101 extern BOOLEAN implicitPrelude;         /*  True when we should read the Prelude if not given */
 102 extern BOOLEAN haskell1_2Flag;          /*  True if we are attempting (proto)Haskell 1.3 */
 103
 104 extern int thisIfacePragmaVersion;
 105 %}
 106
 107 %union {
 108         tree utree;
 109         list ulist;
 110         ttype uttype;
 111         constr uconstr;
 112         binding ubinding;
 113         pbinding upbinding;
 114         entidt uentid;
 115         id uid;
 116         qid uqid;
 117         literal uliteral;
 118         maybe umaybe;
 119         either ueither;
 120         long ulong;
 121         float ufloat;
 122         char *ustring;
 123         hstring uhstring;
 124         hpragma uhpragma;
 125         coresyn ucoresyn;
 126 }
 127
 128
 129 /**********************************************************************
 130 *                                                                     *
 131 *                                                                     *
 132 *     These are lexemes.                                              *
 133 *                                                                     *
 134 *                                                                     *
 135 **********************************************************************/
 136
 137
 138 %token  VARID           CONID           QVARID          QCONID
 139         VARSYM          CONSYM          QVARSYM         QCONSYM
 140
 141 %token  INTEGER         FLOAT           CHAR            STRING
 142         CHARPRIM        STRINGPRIM      INTPRIM         FLOATPRIM
 143         DOUBLEPRIM      CLITLIT
 144
 145
 146
 147 /**********************************************************************
 148 *                                                                     *
 149 *                                                                     *
 150 *      Special Symbols                                                *
 151 *                                                                     *
 152 *                                                                     *
 153 **********************************************************************/
 154
 155 %token  OCURLY          CCURLY          VCCURLY         SEMI
 156 %token  OBRACK          CBRACK          OPAREN          CPAREN
 157 %token  COMMA           BQUOTE
 158
 159
 160 /**********************************************************************
 161 *                                                                     *
 162 *                                                                     *
 163 *     Reserved Operators                                              *
 164 *                                                                     *
 165 *                                                                     *
 166 **********************************************************************/
 167
 168 %token  DOTDOT          DCOLON          EQUAL
 169 %token  LAMBDA          VBAR            RARROW
 170 %token  LARROW          MINUS
 171
 172
 173 /**********************************************************************
 174 *                                                                     *
 175 *                                                                     *
 176 *     Reserved Identifiers                                            *
 177 *                                                                     *
 178 *                                                                     *
 179 **********************************************************************/
 180
 181 %token  CASE            CLASS           DATA
 182 %token  DEFAULT         DERIVING        DO
 183 %token  ELSE            IF              IMPORT
 184 %token  IN              INFIX           INFIXL
 185 %token  INFIXR          INSTANCE        LET
 186 %token  MODULE          NEWTYPE         OF
 187 %token  THEN            TYPE            WHERE
 188
 189 %token  INTERFACE       SCC
 190 %token  CCALL           CCALL_GC        CASM            CASM_GC
 191
 192
 193 /**********************************************************************
 194 *                                                                     *
 195 *                                                                     *
 196 *     Valid symbols/identifiers which need to be recognised           *
 197 *                                                                     *
 198 *                                                                     *
 199 **********************************************************************/
 200
 201 %token  WILDCARD        AT              LAZY            BANG
 202 %token  AS              HIDING          QUALIFIED
 203
 204
 205 /**********************************************************************
 206 *                                                                     *
 207 *                                                                     *
 208 *     Special Symbols for the Lexer                                   *
 209 *                                                                     *
 210 *                                                                     *
 211 **********************************************************************/
 212
 213 %token  LEOF
 214 %token  GHC_PRAGMA END_PRAGMA NO_PRAGMA NOINFO_PRAGMA SPECIALISE_PRAGMA
 215 %token  ARITY_PRAGMA UPDATE_PRAGMA STRICTNESS_PRAGMA KIND_PRAGMA
 216 %token  UNFOLDING_PRAGMA MAGIC_UNFOLDING_PRAGMA DEFOREST_PRAGMA
 217 %token  SPECIALISE_UPRAGMA INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
 218 %token  DEFOREST_UPRAGMA END_UPRAGMA
 219 %token  TYLAMBDA COCON COPRIM COAPP COTYAPP FORALL TYVAR_TEMPLATE_ID
 220 %token  CO_ALG_ALTS CO_PRIM_ALTS CO_NO_DEFAULT CO_LETREC
 221 %token  CO_SDSEL_ID CO_METH_ID CO_DEFM_ID CO_DFUN_ID CO_CONSTM_ID
 222 %token  CO_SPEC_ID CO_WRKR_ID CO_ORIG_NM
 223 %token  UNFOLD_ALWAYS UNFOLD_IF_ARGS
 224 %token  NOREP_INTEGER NOREP_RATIONAL NOREP_STRING
 225 %token  CO_PRELUDE_DICTS_CC CO_ALL_DICTS_CC CO_USER_CC CO_AUTO_CC CO_DICT_CC
 226 %token  CO_CAF_CC CO_DUPD_CC
 227
 228 /**********************************************************************
 229 *                                                                     *
 230 *                                                                     *
 231 *     Precedences of the various tokens                               *
 232 *                                                                     *
 233 *                                                                     *
 234 **********************************************************************/
 235
 236
 237 %left   CASE    LET     IN
 238         IF      ELSE    LAMBDA
 239         SCC     CASM    CCALL   CASM_GC CCALL_GC
 240
 241 %left   VARSYM  CONSYM  QVARSYM QCONSYM
 242         MINUS   BQUOTE  BANG    DARROW
 243
 244 %left   DCOLON
 245
 246 %left   SEMI    COMMA
 247
 248 %left   OCURLY  OBRACK  OPAREN
 249
 250 %left   EQUAL
 251
 252 %right  RARROW
 253
 254 /**********************************************************************
 255 *                                                                     *
 256 *                                                                     *
 257 *      Type Declarations                                              *
 258 *                                                                     *
 259 *                                                                     *
 260 **********************************************************************/
 261
 262
 263 %type <ulist>   caserest alts alt quals
 264                 dorest stmts stmt
 265                 rbinds rpats list_exps
 266                 qvarsk qvars_list
 267                 constrs constr1 fields
 268                 types atypes batypes
 269                 types_and_maybe_ids
 270                 pats context context_list tyvar_list
 271                 export_list enames
 272                 import_list inames
 273                 impdecls maybeimpdecls impdecl
 274                 maybefixes fixes fix ops
 275                 dtyclses dtycls_list
 276                 gdrhs gdpat valrhs
 277                 lampats cexps
 278                 idata_pragma_specs idata_pragma_specslist
 279                 gen_pragma_list type_pragma_pairs
 280                 type_pragma_pairs_maybe name_pragma_pairs
 281                 type_maybes
 282                 core_binders core_tyvars core_tv_templates
 283                 core_types core_type_list
 284                 core_atoms core_atom_list
 285                 core_alg_alts core_prim_alts corec_binds
 286                 core_type_maybes
 287
 288 %type <umaybe>  maybeexports impas maybeimpspec
 289                 type_maybe core_type_maybe
 290
 291
 292 %type <ueither> impspec
 293
 294 %type <uliteral> lit_constant
 295
 296 %type <utree>   exp oexp dexp kexp fexp aexp rbind texps
 297                 expL oexpL kexpL expLno oexpLno dexpLno kexpLno
 298                 qual gd leftexp
 299                 apat bpat pat apatc conpat dpat fpat opat aapat
 300                 dpatk fpatk opatk aapatk rpat
 301
 302
 303 %type <uid>     MINUS DARROW AS LAZY
 304                 VARID CONID VARSYM CONSYM
 305                 TYVAR_TEMPLATE_ID
 306                 var con varop conop op
 307                 vark varid varsym varsym_nominus
 308                 tycon modid impmod ccallid
 309
 310 %type <uqid>    QVARID QCONID QVARSYM QCONSYM
 311                 qvarid qconid qvarsym qconsym
 312                 qvar qcon qvarop qconop qop
 313                 qvark qconk qtycon qtycls
 314                 gcon gconk gtycon qop1 qvarop1
 315                 ename iname
 316
 317 %type <ubinding>  topdecl topdecls letdecls
 318                   typed datad newtd classd instd defaultd
 319                   decl decls valdef instdef instdefs
 320                   maybeifixes iimport iimports maybeiimports
 321                   ityped idatad inewtd iclassd iinstd ivarsd
 322                   itopdecl itopdecls
 323                   maybe_where
 324                   interface dointerface readinterface ibody
 325                   cbody rinst
 326                   type_and_maybe_id
 327
 328 %type <upbinding> valrhs1 altrest
 329
 330 %type <uttype>    simple ctype type atype btype
 331                   gtyconapp ntyconapp ntycon gtyconvars
 332                   bbtype batype btyconapp
 333                   class restrict_inst general_inst tyvar
 334                   core_type
 335
 336 %type <uconstr>   constr field
 337
 338 %type <ustring>   FLOAT INTEGER INTPRIM
 339                   FLOATPRIM DOUBLEPRIM CLITLIT
 340
 341 %type <uhstring>  STRING STRINGPRIM CHAR CHARPRIM
 342
 343 %type <uentid>    export import
 344
 345 %type <uhpragma>  idata_pragma inewt_pragma idata_pragma_spectypes
 346                   iclas_pragma iclasop_pragma
 347                   iinst_pragma gen_pragma ival_pragma arity_pragma
 348                   update_pragma strictness_pragma worker_info
 349                   deforest_pragma
 350                   unfolding_pragma unfolding_guidance type_pragma_pair
 351                   name_pragma_pair
 352
 353 %type <ucoresyn>  core_expr core_case_alts core_id core_binder core_atom
 354                   core_alg_alt core_prim_alt core_default corec_bind
 355                   co_primop co_scc co_caf co_dupd
 356
 357 %type <ulong>     commas impqual
 358
 359 /**********************************************************************
 360 *                                                                     *
 361 *                                                                     *
 362 *      Start Symbol for the Parser                                    *
 363 *                                                                     *
 364 *                                                                     *
 365 **********************************************************************/
 366
 367 %start pmodule
 368
 369
 370 %%
 371
 372 pmodule :       {
 373                   inimport   = 1;
 374                   importmod  = install_literal("Prelude");
 375                   importas   = 0;
 376                   asmod      = NULL;
 377                   importqual = 0;
 378                   importspec = 0;
 379                   importhide = 0;
 380                   importlist = Lnil;
 381                 }
 382            readpreludecore readprelude
 383                 {
 384                   inimport   = 0;
 385                   importmod  = NULL;
 386
 387                   modulelineno = 0;
 388                 }
 389            module
 390         ;
 391
 392 module  :  modulekey modid maybeexports
 393                 {
 394                   the_module_name = $2;
 395                   module_exports = $3;
 396                 }
 397            WHERE body
 398         |       {
 399                   the_module_name = install_literal("Main");
 400                   module_exports = mknothing();
 401                 }
 402            body
 403         ;
 404
 405 body    :  ocurly { setstartlineno(); } orestm
 406         |  vocurly vrestm
 407         ;
 408
 409 orestm  :  maybeimpdecls maybefixes topdecls ccurly
 410                {
 411                  root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,$2,$3,modulelineno);
 412                }
 413         |  impdecls ccurly
 414                {
 415                  root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,Lnil,mknullbind(),modulelineno);
 416                }
 417
 418 vrestm  :  maybeimpdecls maybefixes topdecls vccurly
 419                {
 420                  root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,$2,$3,modulelineno);
 421                }
 422         |  impdecls vccurly
 423                {
 424                  root = mkhmodule(the_module_name,lconc(prelude_imports,$1),module_exports,Lnil,mknullbind(),modulelineno);
 425                }
 426
 427
 428 maybeexports :  /* empty */                     { $$ = mknothing(); }
 429         |  OPAREN export_list CPAREN            { $$ = mkjust($2); }
 430         |  OPAREN export_list COMMA CPAREN      { $$ = mkjust($2); }
 431         ;
 432
 433 export_list:
 434            export                               { $$ = lsing($1); }
 435         |  export_list COMMA export             { $$ = lapp($1, $3); }
 436         ;
 437
 438 export  :  qvar                                 { $$ = mkentid($1); }
 439         |  gtycon                               { $$ = mkenttype($1); }
 440         |  gtycon OPAREN DOTDOT CPAREN          { $$ = mkenttypeall($1); }
 441         |  gtycon OPAREN CPAREN                 { $$ = mkenttypenamed($1,Lnil); }
 442         |  gtycon OPAREN enames CPAREN          { $$ = mkenttypenamed($1,$3); }
 443         |  MODULE modid                         { $$ = mkentmod($2); }
 444         ;
 445
 446 enames  :  ename                                { $$ = lsing($1); }
 447         |  enames COMMA ename                   { $$ = lapp($1,$3); }
 448         ;
 449 ename   :  qvar
 450         |  qcon
 451         ;
 452
 453
 454 maybeimpdecls : /* empty */                     { $$ = Lnil; }
 455         |  impdecls SEMI                        { $$ = $1; }
 456         ;
 457
 458 impdecls:  impdecl                              { $$ = $1; }
 459         |  impdecls SEMI impdecl                { $$ = lconc($1,$3); }
 460         ;
 461
 462
 463 impdecl :  importkey
 464                 {
 465                   inimport = 1;
 466                   importlineno = startlineno;
 467                 }
 468            impqual impmod dointerface impas maybeimpspec
 469                 {
 470                   $$ = lsing(mkimport(iface_name,xstrdup(iface_filename),$5,
 471                                       $4,$3,$6,$7,importlineno));
 472                   inimport   = 0;
 473                   importmod  = NULL;
 474                   importas   = 0;
 475                   asmod      = NULL;
 476                   importqual = 0;
 477                   importspec = 0;
 478                   importhide = 0;
 479                   importlist = Lnil;
 480                 }
 481         ;
 482
 483 impmod  : modid                                 { $$ = importmod = $1; }
 484         ;
 485
 486 impqual :  /* noqual */                         { $$ = importqual = 0; }
 487         |  QUALIFIED                            { $$ = importqual = 1; }
 488         ;
 489
 490 impas   :  /* noas */                           { $$ = mknothing(); importas = 0; asmod = NULL; }
 491         |  AS modid                             { $$ = mkjust($2);  importas = 1; asmod = $2;   }
 492         ;
 493
 494 maybeimpspec :  /* empty */                     { $$ = mknothing(); importspec = 0; }
 495         |  impspec                              { $$ = mkjust($1);  importspec = 1; }
 496         ;
 497
 498 impspec :  OPAREN CPAREN                          { $$ = mkleft(Lnil); importhide = 0; importlist = Lnil; }
 499         |  OPAREN import_list CPAREN              { $$ = mkleft($2);   importhide = 0; importlist = $2; }
 500         |  OPAREN import_list COMMA CPAREN        { $$ = mkleft($2);   importhide = 0; importlist = $2; }
 501         |  HIDING OPAREN import_list CPAREN       { $$ = mkright($3);  importhide = 1; importlist = $3; }
 502         |  HIDING OPAREN import_list COMMA CPAREN { $$ = mkright($3);  importhide = 1; importlist = $3; }
 503         ;
 504
 505 import_list:
 506            import                               { $$ = lsing($1); }
 507         |  import_list COMMA import             { $$ = lapp($1, $3); }
 508         ;
 509
 510 import  :  var                                  { $$ = mkentid(mknoqual($1)); }
 511         |  tycon                                { $$ = mkenttype(mknoqual($1)); }
 512         |  tycon OPAREN DOTDOT CPAREN           { $$ = mkenttypeall(mknoqual($1)); }
 513         |  tycon OPAREN CPAREN                  { $$ = mkenttypenamed(mknoqual($1),Lnil); }
 514         |  tycon OPAREN inames CPAREN           { $$ = mkenttypenamed(mknoqual($1),$3); }
 515         ;
 516
 517 inames  :  iname                                { $$ = lsing($1); }
 518         |  inames COMMA iname                   { $$ = lapp($1,$3); }
 519         ;
 520 iname   :  var                                  { $$ = mknoqual($1); }
 521         |  con                                  { $$ = mknoqual($1); }
 522         ;
 523
 524
 525 /**********************************************************************
 526 *                                                                     *
 527 *                                                                     *
 528 *      Reading interface files                                        *
 529 *                                                                     *
 530 *                                                                     *
 531 **********************************************************************/
 532
 533 dointerface :   { /* filename returned in "iface_filename" */
 534                   char *module_name = id_to_string(importmod);
 535                   if ( ! etags ) {
 536                       find_module_on_imports_dirlist(
 537                         (haskell1_2Flag && strcmp(module_name, "Prelude") == 0)
 538                             ? "Prel12" : module_name,
 539                         FALSE, iface_filename);
 540                   } else {
 541                      find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
 542                   }
 543                   if (strcmp(module_name,"PreludeCore")==0) {
 544                             hsperror("Cannot explicitly import `PreludeCore'");
 545
 546                   } else if (strcmp(module_name,"Prelude")==0) {
 547                     prelude_imports = prelude_core_import; /* unavoidable */
 548                   }
 549                   thisIfacePragmaVersion = 0;
 550                   setyyin(iface_filename);
 551                 }
 552         readinterface
 553                 { $$ = $2; }
 554         ;
 555
 556 readpreludecore:{
 557                   if ( implicitPrelude && !etags ) {
 558                      /* we try to avoid reading interfaces when etagging */
 559                      find_module_on_imports_dirlist(
 560                         (haskell1_2Flag) ? "PrelCore12" : "PreludeCore",
 561                         TRUE,iface_filename);
 562                   } else {
 563                      find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
 564                   }
 565                   thisIfacePragmaVersion = 0;
 566                   setyyin(iface_filename);
 567                 }
 568            readinterface
 569                 {
 570                   binding prelude_core = mkimport(iface_name,xstrdup(iface_filename),$2,
 571                                                   install_literal("PreludeCore"),
 572                                                   0,mknothing(),mknothing(),0);
 573                   prelude_core_import = (! implicitPrelude) ? Lnil : lsing(prelude_core);
 574                 }
 575         ;
 576
 577 readprelude :   {
 578                   if ( implicitPrelude && !etags ) {
 579                      find_module_on_imports_dirlist(
 580                         ( haskell1_2Flag ) ? "Prel12" : "Prelude",
 581                         TRUE,iface_filename);
 582                   } else {
 583                      find_module_on_imports_dirlist("PreludeNull_",TRUE,iface_filename);
 584                   }
 585                   thisIfacePragmaVersion = 0;
 586                   setyyin(iface_filename);
 587                 }
 588            readinterface
 589                 {
 590                   binding prelude = mkimport(iface_name,xstrdup(iface_filename),$2,
 591                                              install_literal("Prelude"),
 592                                              0,mknothing(),mknothing(),0);
 593                   prelude_imports = (! implicitPrelude) ? Lnil
 594                                         : lconc(prelude_core_import,lsing(prelude));
 595                 }
 596         ;
 597
 598 readinterface:
 599            interface LEOF
 600                 {
 601                   $$ = $1;
 602                 }
 603         ;
 604
 605 interface:
 606            INTERFACE modid
 607                 {
 608                   iface_name = $2;
 609                 }
 610            WHERE ibody
 611                 {
 612                   $$ = $5;
 613                 }
 614         ;
 615
 616 ibody   :  ocurly maybeiimports maybeifixes itopdecls ccurly
 617                 {
 618                   $$ = mkabind($2,mkabind($3,$4));
 619                 }
 620         |  ocurly iimports ccurly
 621                 {
 622                   $$ = $2;
 623                 }
 624         |  vocurly maybeiimports maybeifixes itopdecls vccurly
 625                 {
 626                   $$ = mkabind($2,mkabind($3,$4));
 627                 }
 628         |  vocurly iimports vccurly
 629                 {
 630                   $$ = $2;
 631                 }
 632         ;
 633
 634 maybeifixes:  /* empty */                       { $$ = mknullbind(); }
 635         |  fixes SEMI                           { $$ = mkmfbind($1); }
 636         ;
 637
 638 maybeiimports : /* empty */                     { $$ = mknullbind(); }
 639         |  iimports SEMI                        { $$ = $1; }
 640         ;
 641
 642 iimports : iimport                              { $$ = $1; }
 643          | iimports SEMI iimport                { $$ = mkabind($1,$3); }
 644          ;
 645
 646 iimport :  importkey modid OPAREN import_list CPAREN
 647                 { $$ = mkmbind($2,$4,startlineno); }
 648         ;
 649
 650
 651 itopdecls : itopdecl                            { $$ = $1; }
 652         | itopdecls SEMI itopdecl               { $$ = mkabind($1,$3); }
 653         ;
 654
 655 itopdecl:  ityped                               { $$ = $1; }
 656         |  idatad                               { $$ = $1; }
 657         |  inewtd                               { $$ = $1; }
 658         |  iclassd                              { $$ = $1; }
 659         |  iinstd                               { $$ = $1; }
 660         |  ivarsd                               { $$ = $1; }
 661         |  /* empty */                          { $$ = mknullbind(); }
 662         ;
 663
 664 ivarsd  :  qvarsk DCOLON ctype ival_pragma
 665                 { $$ = mksbind($1,$3,startlineno,$4); }
 666         ;
 667
 668 ityped  :  typekey simple EQUAL type
 669                 { $$ = mknbind($2,$4,startlineno); }
 670         ;
 671
 672 idatad  :  datakey simple idata_pragma
 673                 { $$ = mktbind(Lnil,$2,Lnil,mknothing(),startlineno,$3); }
 674         |  datakey simple EQUAL constrs idata_pragma
 675                 { $$ = mktbind(Lnil,$2,$4,mknothing(),startlineno,$5); }
 676         |  datakey context DARROW simple idata_pragma
 677                 { $$ = mktbind($2,$4,Lnil,mknothing(),startlineno,$5); }
 678         |  datakey context DARROW simple EQUAL constrs idata_pragma
 679                 { $$ = mktbind($2,$4,$6,mknothing(),startlineno,$7); }
 680         ;
 681
 682 inewtd  :  newtypekey simple inewt_pragma
 683                 { $$ = mkntbind(Lnil,$2,Lnil,mknothing(),startlineno,$3); }
 684         |  newtypekey simple EQUAL constr1 inewt_pragma
 685                 { $$ = mkntbind(Lnil,$2,$4,mknothing(),startlineno,$5); }
 686         |  newtypekey context DARROW simple inewt_pragma
 687                 { $$ = mkntbind($2,$4,Lnil,mknothing(),startlineno,$5); }
 688         |  newtypekey context DARROW simple EQUAL constr1 inewt_pragma
 689                 { $$ = mkntbind($2,$4,$6,mknothing(),startlineno,$7); }
 690         ;
 691
 692 iclassd :  classkey context DARROW class iclas_pragma cbody
 693                 { $$ = mkcbind($2,$4,$6,startlineno,$5); }
 694         |  classkey class iclas_pragma cbody
 695                 { $$ = mkcbind(Lnil,$2,$4,startlineno,$3); }
 696         ;
 697
 698 iinstd  :  instkey modid context DARROW gtycon general_inst iinst_pragma
 699                 { $$ = mkibind(0/*not source*/,$2,$3,$5,$6,mknullbind(),startlineno,$7); }
 700         |  instkey modid gtycon general_inst iinst_pragma
 701                 { $$ = mkibind(0/*not source*/,$2,Lnil,$3,$4,mknullbind(),startlineno,$5); }
 702         ;
 703
 704
 705 /**********************************************************************
 706 *                                                                     *
 707 *                                                                     *
 708 *     Interface pragma stuff                                          *
 709 *                                                                     *
 710 *                                                                     *
 711 **********************************************************************/
 712
 713 idata_pragma:
 714            GHC_PRAGMA constrs idata_pragma_specs END_PRAGMA
 715                                                 { $$ = mkidata_pragma($2, $3); }
 716         |  GHC_PRAGMA idata_pragma_specs END_PRAGMA
 717                                                 { $$ = mkidata_pragma(Lnil, $2); }
 718         |  /* empty */                          { $$ = mkno_pragma(); }
 719         ;
 720
 721 inewt_pragma:
 722            GHC_PRAGMA constr1 idata_pragma_specs END_PRAGMA
 723                                                 { $$ = mkidata_pragma($2, $3); }
 724         |  GHC_PRAGMA idata_pragma_specs END_PRAGMA
 725                                                 { $$ = mkidata_pragma(Lnil, $2); }
 726         |  /* empty */                          { $$ = mkno_pragma(); }
 727         ;
 728
 729 idata_pragma_specs :
 730            SPECIALISE_PRAGMA idata_pragma_specslist
 731                                                 { $$ = $2; }
 732         |  /* empty */                          { $$ = Lnil; }
 733         ;
 734
 735 idata_pragma_specslist:
 736            idata_pragma_spectypes               { $$ = lsing($1); }
 737         |  idata_pragma_specslist COMMA idata_pragma_spectypes
 738                                                 { $$ = lapp($1, $3); }
 739         ;
 740
 741 idata_pragma_spectypes:
 742            OBRACK type_maybes CBRACK            { $$ = mkidata_pragma_4s($2); }
 743         ;
 744
 745 iclas_pragma:
 746            GHC_PRAGMA gen_pragma_list END_PRAGMA { $$ = mkiclas_pragma($2); }
 747         |  /* empty */                           { $$ = mkno_pragma(); }
 748         ;
 749
 750 iclasop_pragma:
 751            GHC_PRAGMA gen_pragma gen_pragma END_PRAGMA
 752                 { $$ = mkiclasop_pragma($2, $3); }
 753         |  /* empty */
 754                 { $$ = mkno_pragma(); }
 755         ;
 756
 757 iinst_pragma:
 758            GHC_PRAGMA gen_pragma END_PRAGMA
 759                 { $$ = mkiinst_simpl_pragma($2); }
 760
 761         |  GHC_PRAGMA gen_pragma name_pragma_pairs END_PRAGMA
 762                 { $$ = mkiinst_const_pragma($2, $3); }
 763
 764         |  /* empty */
 765                 { $$ = mkno_pragma(); }
 766         ;
 767
 768 ival_pragma:
 769            GHC_PRAGMA gen_pragma END_PRAGMA
 770                 { $$ = $2; }
 771         |  /* empty */
 772                 { $$ = mkno_pragma(); }
 773         ;
 774
 775 gen_pragma:
 776            NOINFO_PRAGMA
 777                 { $$ = mkno_pragma(); }
 778         |  arity_pragma update_pragma deforest_pragma strictness_pragma unfolding_pragma type_pragma_pairs_maybe
 779                 { $$ = mkigen_pragma($1, $2, $3, $4, $5, $6); }
 780         ;
 781
 782 arity_pragma:
 783            NO_PRAGMA                { $$ = mkno_pragma(); }
 784         |  ARITY_PRAGMA INTEGER     { $$ = mkiarity_pragma($2); }
 785         ;
 786
 787 update_pragma:
 788            NO_PRAGMA                { $$ = mkno_pragma(); }
 789         |  UPDATE_PRAGMA INTEGER    { $$ = mkiupdate_pragma($2); }
 790         ;
 791
 792 deforest_pragma:
 793            NO_PRAGMA                { $$ = mkno_pragma(); }
 794         |  DEFOREST_PRAGMA          { $$ = mkideforest_pragma(); }
 795         ;
 796
 797 strictness_pragma:
 798            NO_PRAGMA                { $$ = mkno_pragma(); }
 799         |  STRICTNESS_PRAGMA COCON  { $$ = mkistrictness_pragma(installHstring(1, "B"),
 800                                       /* _!_ = COCON = bottom */ mkno_pragma());
 801                                     }
 802         |  STRICTNESS_PRAGMA STRING worker_info
 803                                     { $$ = mkistrictness_pragma($2, $3); }
 804         ;
 805
 806 worker_info:
 807            OCURLY gen_pragma CCURLY { $$ = $2; }
 808         |  /* empty */              { $$ = mkno_pragma(); }
 809
 810 unfolding_pragma:
 811            NO_PRAGMA                { $$ = mkno_pragma(); }
 812         |  MAGIC_UNFOLDING_PRAGMA vark
 813                                     { $$ = mkimagic_unfolding_pragma($2); }
 814         |  UNFOLDING_PRAGMA unfolding_guidance core_expr
 815                                     { $$ = mkiunfolding_pragma($2, $3); }
 816         ;
 817
 818 unfolding_guidance:
 819            UNFOLD_ALWAYS
 820                                     { $$ = mkiunfold_always(); }
 821         |  UNFOLD_IF_ARGS INTEGER INTEGER CONID INTEGER
 822                                     { $$ = mkiunfold_if_args($2, $3, $4, $5); }
 823         ;
 824
 825 gen_pragma_list:
 826            gen_pragma                           { $$ = lsing($1); }
 827         |  gen_pragma_list COMMA gen_pragma     { $$ = lapp($1, $3); }
 828         ;
 829
 830 type_pragma_pairs_maybe:
 831           NO_PRAGMA                             { $$ = Lnil; }
 832         | SPECIALISE_PRAGMA type_pragma_pairs   { $$ = $2; }
 833         ;
 834
 835 /* 1 S/R conflict at COMMA -> shift */
 836 type_pragma_pairs:
 837            type_pragma_pair                         { $$ = lsing($1); }
 838         |  type_pragma_pairs COMMA type_pragma_pair { $$ = lapp($1, $3); }
 839         ;
 840
 841 type_pragma_pair:
 842            OBRACK type_maybes CBRACK INTEGER worker_info
 843                 { $$ = mkitype_pragma_pr($2, $4, $5); }
 844         ;
 845
 846 type_maybes:
 847            type_maybe                   { $$ = lsing($1); }
 848         |  type_maybes COMMA type_maybe { $$ = lapp($1, $3); }
 849         ;
 850
 851 type_maybe:
 852            NO_PRAGMA                    { $$ = mknothing(); }
 853         |  type                         { $$ = mkjust($1); }
 854         ;
 855
 856 name_pragma_pairs:
 857            name_pragma_pair                         { $$ = lsing($1); }
 858         |  name_pragma_pairs COMMA name_pragma_pair { $$ = lapp($1, $3); }
 859         ;
 860
 861 name_pragma_pair:
 862            /* if the gen_pragma concludes with a *comma*-separated SPECs list,
 863               we get a parse error --- we have to bracket the gen_pragma
 864            */
 865
 866            var EQUAL OCURLY gen_pragma CCURLY
 867                 { $$ = mkiname_pragma_pr($1, $4); }
 868         ;
 869
 870 /**********************************************************************
 871 *                                                                     *
 872 *                                                                     *
 873 *     Core syntax stuff                                               *
 874 *                                                                     *
 875 *                                                                     *
 876 **********************************************************************/
 877
 878 core_expr:
 879            LAMBDA core_binders RARROW core_expr
 880                         { $$ = mkcolam($2, $4); }
 881         |  TYLAMBDA core_tyvars RARROW core_expr
 882                         { $$ = mkcotylam($2, $4); }
 883         |  COCON con core_types core_atoms
 884                         { $$ = mkcocon(mkco_id($2), $3, $4); }
 885         |  COCON CO_ORIG_NM modid con core_types core_atoms
 886                         { $$ = mkcocon(mkco_orig_id($3,$4), $5, $6); }
 887         |  COPRIM co_primop core_types core_atoms
 888                         { $$ = mkcoprim($2, $3, $4); }
 889         |  COAPP core_expr core_atoms
 890                         { $$ = mkcoapp($2, $3); }
 891         |  COTYAPP core_expr OCURLY core_type CCURLY
 892                         { $$ = mkcotyapp($2, $4); }
 893         |  CASE core_expr OF OCURLY core_case_alts CCURLY
 894                         { $$ = mkcocase($2, $5); }
 895         |  LET OCURLY core_binder EQUAL core_expr CCURLY IN core_expr
 896                         { $$ = mkcolet(mkcononrec($3, $5), $8); }
 897         |  CO_LETREC OCURLY corec_binds CCURLY IN core_expr
 898                         { $$ = mkcolet(mkcorec($3), $6); }
 899         |  SCC OCURLY co_scc CCURLY core_expr
 900                         { $$ = mkcoscc($3, $5); }
 901         |  lit_constant { $$ = mkcoliteral($1); }
 902         |  core_id      { $$ = mkcovar($1); }
 903         ;
 904
 905 core_case_alts :
 906            CO_ALG_ALTS  core_alg_alts  core_default
 907                         { $$ = mkcoalg_alts($2, $3); }
 908         |  CO_PRIM_ALTS core_prim_alts core_default
 909                         { $$ = mkcoprim_alts($2, $3); }
 910         ;
 911
 912 core_alg_alts :
 913            /* empty */                  { $$ = Lnil; }
 914         |  core_alg_alts core_alg_alt   { $$ = lapp($1, $2); }
 915         ;
 916
 917 core_alg_alt:
 918            core_id core_binders RARROW core_expr SEMI { $$ = mkcoalg_alt($1, $2, $4); }
 919            /* core_id is really too generous */
 920         ;
 921
 922 core_prim_alts :
 923            /* empty */                  { $$ = Lnil; }
 924         |  core_prim_alts core_prim_alt { $$ = lapp($1, $2); }
 925         ;
 926
 927 core_prim_alt:
 928            lit_constant RARROW core_expr SEMI { $$ = mkcoprim_alt($1, $3); }
 929         ;
 930
 931 core_default:
 932            CO_NO_DEFAULT                { $$ = mkconodeflt(); }
 933         |  core_binder RARROW core_expr { $$ = mkcobinddeflt($1, $3); }
 934         ;
 935
 936 corec_binds:
 937            corec_bind                   { $$ = lsing($1); }
 938         |  corec_binds SEMI corec_bind  { $$ = lapp($1, $3); }
 939         ;
 940
 941 corec_bind:
 942            core_binder EQUAL core_expr  { $$ = mkcorec_pair($1, $3); }
 943         ;
 944
 945 co_scc  :
 946            CO_PRELUDE_DICTS_CC co_dupd           { $$ = mkco_preludedictscc($2); }
 947         |  CO_ALL_DICTS_CC STRING STRING co_dupd { $$ = mkco_alldictscc($2,$3,$4); }
 948         |  CO_USER_CC STRING  STRING STRING co_dupd co_caf
 949                                                 { $$ = mkco_usercc($2,$3,$4,$5,$6); }
 950         |  CO_AUTO_CC core_id STRING STRING co_dupd co_caf
 951                                                 { $$ = mkco_autocc($2,$3,$4,$5,$6); }
 952         |  CO_DICT_CC core_id STRING STRING co_dupd co_caf
 953                                                 { $$ = mkco_dictcc($2,$3,$4,$5,$6); }
 954
 955 co_caf  :  NO_PRAGMA    { $$ = mkco_scc_noncaf(); }
 956         |  CO_CAF_CC    { $$ = mkco_scc_caf(); }
 957
 958 co_dupd :  NO_PRAGMA    { $$ = mkco_scc_nondupd(); }
 959         |  CO_DUPD_CC   { $$ = mkco_scc_dupd(); }
 960
 961 core_id: /* more to come?? */
 962            CO_SDSEL_ID  tycon tycon     { $$ = mkco_sdselid($2, $3); }
 963         |  CO_METH_ID   tycon var       { $$ = mkco_classopid($2, $3); }
 964         |  CO_DEFM_ID   tycon var       { $$ = mkco_defmid($2, $3); }
 965         |  CO_DFUN_ID   tycon OPAREN core_type CPAREN
 966                                         { $$ = mkco_dfunid($2, $4); }
 967         |  CO_CONSTM_ID tycon var OPAREN core_type CPAREN
 968                                         { $$ = mkco_constmid($2, $3, $5); }
 969         |  CO_SPEC_ID   core_id OBRACK core_type_maybes CBRACK
 970                                         { $$ = mkco_specid($2, $4); }
 971         |  CO_WRKR_ID   core_id         { $$ = mkco_wrkrid($2); }
 972         |  CO_ORIG_NM   modid var       { $$ = mkco_orig_id($2, $3); }
 973         |  CO_ORIG_NM   modid con       { $$ = mkco_orig_id($2, $3); }
 974         |  var                          { $$ = mkco_id($1); }
 975         |  con                          { $$ = mkco_id($1); }
 976         ;
 977
 978 co_primop :
 979            OPAREN CCALL ccallid      OCURLY core_types core_type CCURLY CPAREN
 980                                         { $$ = mkco_ccall($3,0,$5,$6); }
 981         |  OPAREN CCALL_GC ccallid   OCURLY core_types core_type CCURLY CPAREN
 982                                         { $$ = mkco_ccall($3,1,$5,$6); }
 983         |  OPAREN CASM  lit_constant OCURLY core_types core_type CCURLY CPAREN
 984                                         { $$ = mkco_casm($3,0,$5,$6); }
 985         |  OPAREN CASM_GC lit_constant OCURLY core_types core_type CCURLY CPAREN
 986                                         { $$ = mkco_casm($3,1,$5,$6); }
 987         |  VARID                        { $$ = mkco_primop($1); }
 988         ;
 989
 990 core_binders :
 991            /* empty */                  { $$ = Lnil; }
 992         |  core_binders core_binder     { $$ = lapp($1, $2); }
 993         ;
 994
 995 core_binder :
 996            OPAREN VARID DCOLON core_type CPAREN { $$ = mkcobinder($2, $4); }
 997
 998 core_atoms :
 999            OBRACK CBRACK                { $$ = Lnil; }
1000         |  OBRACK core_atom_list CBRACK { $$ = $2; }
1001         ;
1002
1003 core_atom_list :
1004            core_atom                        { $$ = lsing($1); }
1005         |  core_atom_list COMMA core_atom   { $$ = lapp($1, $3); }
1006         ;
1007
1008 core_atom :
1009            lit_constant         { $$ = mkcolit($1); }
1010         |  core_id              { $$ = mkcolocal($1); }
1011         ;
1012
1013 core_tyvars :
1014            VARID                { $$ = lsing($1); }
1015         |  core_tyvars VARID    { $$ = lapp($1, $2); }
1016         ;
1017
1018 core_tv_templates :
1019            TYVAR_TEMPLATE_ID                            { $$ = lsing($1); }
1020         |  core_tv_templates COMMA TYVAR_TEMPLATE_ID    { $$ = lapp($1, $3); }
1021         ;
1022
1023 core_types :
1024            OBRACK CBRACK                { $$ = Lnil; }
1025         |  OBRACK core_type_list CBRACK { $$ = $2; }
1026         ;
1027
1028 core_type_list :
1029            core_type                        { $$ = lsing($1); }
1030         |  core_type_list COMMA core_type   { $$ = lapp($1, $3); }
1031         ;
1032
1033 core_type :
1034            type { $$ = $1; }
1035         ;
1036
1037 /*
1038 core_type :
1039            FORALL core_tv_templates DARROW core_type
1040                 { $$ = mkuniforall($2, $4); }
1041         |  OCURLY OCURLY CONID core_type CCURLY CCURLY RARROW core_type
1042                 { $$ = mktfun(mkunidict($3, $4), $8); }
1043         |  OCURLY OCURLY CONID core_type CCURLY CCURLY
1044                 { $$ = mkunidict($3, $4); }
1045         |  OPAREN OCURLY OCURLY CONID core_type CCURLY CCURLY COMMA core_type_list CPAREN RARROW core_type
1046                 { $$ = mktfun(mkttuple(mklcons(mkunidict($4, $5), $9)), $12); }
1047         |  OPAREN OCURLY OCURLY CONID core_type CCURLY CCURLY COMMA core_type_list CPAREN
1048                 { $$ = mkttuple(mklcons(mkunidict($4,$5), $9)); }
1049         |  type { $$ = $1; }
1050         ;
1051 */
1052
1053 core_type_maybes:
1054            core_type_maybe                          { $$ = lsing($1); }
1055         |  core_type_maybes COMMA core_type_maybe   { $$ = lapp($1, $3); }
1056         ;
1057
1058 core_type_maybe:
1059            NO_PRAGMA                    { $$ = mknothing(); }
1060         |  core_type                    { $$ = mkjust($1); }
1061         ;
1062
1063
1064 /**********************************************************************
1065 *                                                                     *
1066 *                                                                     *
1067 *     Fixes and Decls etc                                             *
1068 *                                                                     *
1069 *                                                                     *
1070 **********************************************************************/
1071
1072 maybefixes:  /* empty */                { $$ = Lnil; }
1073         |  fixes SEMI                   { $$ = $1; }
1074         ;
1075
1076 fixes   :  fix                          { $$ = $1; }
1077         |  fixes SEMI fix               { $$ = lconc($1,$3); }
1078         ;
1079
1080 fix     :  INFIXL INTEGER       { Precedence = checkfixity($2); Fixity = INFIXL; }
1081            ops                  { $$ = $4; }
1082         |  INFIXR INTEGER       { Precedence = checkfixity($2); Fixity = INFIXR; }
1083            ops                  { $$ = $4; }
1084         |  INFIX  INTEGER       { Precedence = checkfixity($2); Fixity = INFIX; }
1085            ops                  { $$ = $4; }
1086         |  INFIXL               { Fixity = INFIXL; Precedence = 9; }
1087            ops                  { $$ = $3; }
1088         |  INFIXR               { Fixity = INFIXR; Precedence = 9; }
1089            ops                  { $$ = $3; }
1090         |  INFIX                { Fixity = INFIX; Precedence = 9; }
1091            ops                  { $$ = $3; }
1092         ;
1093
1094 ops     :  op            { makeinfix($1,Fixity,Precedence,the_module_name,
1095                                      inimport,importas,importmod,asmod,importqual,
1096                                      importspec,importhide,importlist);
1097                            $$ = lsing(mkfixop($1,infixint(Fixity),Precedence));
1098                          }
1099         |  ops COMMA op  { makeinfix($3,Fixity,Precedence,the_module_name,
1100                                      inimport,importas,importmod,asmod,importqual,
1101                                      importspec,importhide,importlist);
1102                            $$ = lapp($1,mkfixop($3,infixint(Fixity),Precedence));
1103                          }
1104         ;
1105
1106 topdecls:  topdecl
1107         |  topdecls SEMI topdecl
1108                 {
1109                   if($1 != NULL)
1110                     if($3 != NULL)
1111                       if(SAMEFN)
1112                         {
1113                           extendfn($1,$3);
1114                           $$ = $1;
1115                         }
1116                       else
1117                         $$ = mkabind($1,$3);
1118                     else
1119                       $$ = $1;
1120                   else
1121                     $$ = $3;
1122                   SAMEFN = 0;
1123                 }
1124         ;
1125
1126 topdecl :  typed                                { $$ = $1; }
1127         |  datad                                { $$ = $1; }
1128         |  newtd                                { $$ = $1; }
1129         |  classd                               { $$ = $1; }
1130         |  instd                                { $$ = $1; }
1131         |  defaultd                             { $$ = $1; }
1132         |  decl                                 { $$ = $1; }
1133         ;
1134
1135 typed   :  typekey simple EQUAL type            { $$ = mknbind($2,$4,startlineno); }
1136         ;
1137
1138
1139 datad   :  datakey simple EQUAL constrs
1140                 { $$ = mktbind(Lnil,$2,$4,mknothing(),startlineno,mkno_pragma()); }
1141         |  datakey simple EQUAL constrs DERIVING dtyclses
1142                 { $$ = mktbind(Lnil,$2,$4,mkjust($6),startlineno,mkno_pragma()); }
1143         |  datakey context DARROW simple EQUAL constrs
1144                 { $$ = mktbind($2,$4,$6,mknothing(),startlineno,mkno_pragma()); }
1145         |  datakey context DARROW simple EQUAL constrs DERIVING dtyclses
1146                 { $$ = mktbind($2,$4,$6,mkjust($8),startlineno,mkno_pragma()); }
1147         ;
1148
1149 newtd   :  newtypekey simple EQUAL constr1
1150                 { $$ = mkntbind(Lnil,$2,$4,mknothing(),startlineno,mkno_pragma()); }
1151         |  newtypekey simple EQUAL constr1 DERIVING dtyclses
1152                 { $$ = mkntbind(Lnil,$2,$4,mkjust($6),startlineno,mkno_pragma()); }
1153         |  newtypekey context DARROW simple EQUAL constr1
1154                 { $$ = mkntbind($2,$4,$6,mknothing(),startlineno,mkno_pragma()); }
1155         |  newtypekey context DARROW simple EQUAL constr1 DERIVING dtyclses
1156                 { $$ = mkntbind($2,$4,$6,mkjust($8),startlineno,mkno_pragma()); }
1157         ;
1158
1159 classd  :  classkey context DARROW class cbody  { $$ = mkcbind($2,$4,$5,startlineno,mkno_pragma()); }
1160         |  classkey class cbody                 { $$ = mkcbind(Lnil,$2,$3,startlineno,mkno_pragma()); }
1161         ;
1162
1163 cbody   :  /* empty */                          { $$ = mknullbind(); }
1164         |  WHERE ocurly decls ccurly            { checkorder($3); $$ = $3; }
1165         |  WHERE vocurly decls vccurly          { checkorder($3); $$ = $3; }
1166         ;
1167
1168 instd   :  instkey context DARROW gtycon restrict_inst rinst
1169                 { $$ = mkibind(1/*source*/,the_module_name,$2,$4,$5,$6,startlineno,mkno_pragma()); }
1170         |  instkey gtycon general_inst rinst
1171                 { $$ = mkibind(1/*source*/,the_module_name,Lnil,$2,$3,$4,startlineno,mkno_pragma()); }
1172         ;
1173
1174 rinst   :  /* empty */                          { $$ = mknullbind(); }
1175         |  WHERE ocurly  instdefs ccurly        { $$ = $3; }
1176         |  WHERE vocurly instdefs vccurly       { $$ = $3; }
1177         ;
1178
1179 restrict_inst : gtycon                          { $$ = mktname($1); }
1180         |  OPAREN gtyconvars CPAREN             { $$ = $2; }
1181         |  OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
1182         |  OBRACK tyvar CBRACK                  { $$ = mktllist($2); }
1183         |  OPAREN tyvar RARROW tyvar CPAREN     { $$ = mktfun($2,$4); }
1184         ;
1185
1186 general_inst : gtycon                           { $$ = mktname($1); }
1187         |  OPAREN gtyconapp CPAREN              { $$ = $2; }
1188         |  OPAREN type COMMA types CPAREN       { $$ = mkttuple(mklcons($2,$4)); }
1189         |  OBRACK type CBRACK                   { $$ = mktllist($2); }
1190         |  OPAREN btype RARROW type CPAREN      { $$ = mktfun($2,$4); }
1191         ;
1192
1193 defaultd:  defaultkey OPAREN types CPAREN       { $$ = mkdbind($3,startlineno); }
1194         |  defaultkey OPAREN CPAREN             { $$ = mkdbind(Lnil,startlineno); }
1195         ;
1196
1197 decls   :  decl
1198         |  decls SEMI decl
1199                 {
1200                   if(SAMEFN)
1201                     {
1202                       extendfn($1,$3);
1203                       $$ = $1;
1204                     }
1205                   else
1206                     $$ = mkabind($1,$3);
1207                 }
1208         ;
1209
1210
1211 /*
1212     Note: if there is an iclasop_pragma here, then we must be
1213     doing a class-op in an interface -- unless the user is up
1214     to real mischief (ugly, but likely to work).
1215 */
1216
1217 decl    :  qvarsk DCOLON ctype iclasop_pragma
1218                 { $$ = mksbind($1,$3,startlineno,$4);
1219                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1220                 }
1221         /* User-specified pragmas come in as "signatures"...
1222            They are similar in that they can appear anywhere in the module,
1223            and have to be "joined up" with their related entity.
1224
1225            Have left out the case specialising to an overloaded type.
1226            Let's get real, OK?  (WDP)
1227         */
1228         |  SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
1229                 {
1230                   $$ = mkvspec_uprag($2, $4, startlineno);
1231                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1232                 }
1233
1234         |  SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA
1235                 {
1236                   $$ = mkispec_uprag($3, $4, startlineno);
1237                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1238                 }
1239
1240         |  SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
1241                 {
1242                   $$ = mkdspec_uprag($3, $4, startlineno);
1243                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1244                 }
1245
1246         |  INLINE_UPRAGMA qvark END_UPRAGMA
1247                 {
1248                   $$ = mkinline_uprag($2, startlineno);
1249                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1250                 }
1251
1252         |  MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
1253                 {
1254                   $$ = mkmagicuf_uprag($2, $3, startlineno);
1255                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1256                 }
1257
1258         |  DEFOREST_UPRAGMA qvark END_UPRAGMA
1259                 {
1260                   $$ = mkdeforest_uprag($2, startlineno);
1261                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1262                 }
1263
1264         /* end of user-specified pragmas */
1265
1266         |  valdef
1267         |  /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
1268         ;
1269
1270 qvarsk  :  qvark COMMA qvars_list               { $$ = mklcons($1,$3); }
1271         |  qvark                                { $$ = lsing($1); }
1272         ;
1273
1274 qvars_list: qvar                                { $$ = lsing($1); }
1275         |   qvars_list COMMA qvar               { $$ = lapp($1,$3); }
1276         ;
1277
1278 types_and_maybe_ids :
1279            type_and_maybe_id                            { $$ = lsing($1); }
1280         |  types_and_maybe_ids COMMA type_and_maybe_id  { $$ = lapp($1,$3); }
1281         ;
1282
1283 type_and_maybe_id :
1284            type                                 { $$ = mkvspec_ty_and_id($1,mknothing()); }
1285         |  type EQUAL qvark                     { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
1286
1287
1288 /**********************************************************************
1289 *                                                                     *
1290 *                                                                     *
1291 *     Types etc                                                       *
1292 *                                                                     *
1293 *                                                                     *
1294 **********************************************************************/
1295
1296 /*  "DCOLON context => type" vs "DCOLON type" is a problem,
1297     because you can't distinguish between
1298
1299         foo :: (Baz a, Baz a)
1300         bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
1301
1302     with one token of lookahead.  The HACK is to have "DCOLON ttype"
1303     [tuple type] in the first case, then check that it has the right
1304     form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
1305     context.  Blaach!
1306 */
1307
1308         /* 1 S/R conflict at DARROW -> shift */
1309 ctype   : type DARROW type                      { $$ = mkcontext(type2context($1),$3); }
1310         | type
1311         ;
1312
1313         /* 1 S/R conflict at RARROW -> shift */
1314 type    :  btype                                { $$ = $1; }
1315         |  btype RARROW type                    { $$ = mktfun($1,$3); }
1316
1317         |  FORALL core_tv_templates DARROW type { $$ = mkuniforall($2, $4); }
1318         ;
1319
1320 /* btype is split so we can parse gtyconapp without S/R conflicts */
1321 btype   :  gtyconapp                            { $$ = $1; }
1322         |  ntyconapp                            { $$ = $1; }
1323         ;
1324
1325 ntyconapp: ntycon                               { $$ = $1; }
1326         |  ntyconapp atype                      { $$ = mktapp($1,$2); }
1327         ;
1328
1329 gtyconapp: gtycon                               { $$ = mktname($1); }
1330         |  gtyconapp atype                      { $$ = mktapp($1,$2); }
1331         ;
1332
1333
1334 atype   :  gtycon                               { $$ = mktname($1); }
1335         |  ntycon                               { $$ = $1; }
1336         ;
1337
1338 ntycon  :  tyvar                                { $$ = $1; }
1339         |  OPAREN type COMMA types CPAREN       { $$ = mkttuple(mklcons($2,$4)); }
1340         |  OBRACK type CBRACK                   { $$ = mktllist($2); }
1341         |  OPAREN type CPAREN                   { $$ = $2; }
1342
1343         |  OCURLY OCURLY gtycon type CCURLY CCURLY { $$ = mkunidict($3, $4); }
1344         |  TYVAR_TEMPLATE_ID                    { $$ = mkunityvartemplate($1); }
1345         ;
1346
1347 gtycon  :  qtycon
1348         |  OPAREN RARROW CPAREN                 { $$ = creategid(-2); }
1349         |  OBRACK CBRACK                        { $$ = creategid(-1); }
1350         |  OPAREN CPAREN                        { $$ = creategid(0); }
1351         |  OPAREN commas CPAREN                 { $$ = creategid($2); }
1352         ;
1353
1354 atypes  :  atype                                { $$ = lsing($1); }
1355         |  atypes atype                         { $$ = lapp($1,$2); }
1356         ;
1357
1358 types   :  type                                 { $$ = lsing($1); }
1359         |  types COMMA type                     { $$ = lapp($1,$3); }
1360         ;
1361
1362 commas  : COMMA                                 { $$ = 1; }
1363         | commas COMMA                          { $$ = $1 + 1; }
1364         ;
1365
1366 /**********************************************************************
1367 *                                                                     *
1368 *                                                                     *
1369 *     Declaration stuff                                               *
1370 *                                                                     *
1371 *                                                                     *
1372 **********************************************************************/
1373
1374 simple  :  gtycon                               { $$ = mktname($1); }
1375         |  gtyconvars                           { $$ = $1; }
1376         ;
1377
1378 gtyconvars: gtycon tyvar                        { $$ = mktapp(mktname($1),$2); }
1379         |  gtyconvars tyvar                     { $$ = mktapp($1,$2); }
1380         ;
1381
1382 context :  OPAREN context_list CPAREN           { $$ = $2; }
1383         |  class                                { $$ = lsing($1); }
1384         ;
1385
1386 context_list:  class                            { $$ = lsing($1); }
1387         |  context_list COMMA class             { $$ = lapp($1,$3); }
1388         ;
1389
1390 class   :  gtycon tyvar                         { $$ = mktapp(mktname($1),$2); }
1391         ;
1392
1393 constrs :  constr                               { $$ = lsing($1); }
1394         |  constrs VBAR constr                  { $$ = lapp($1,$3); }
1395         ;
1396
1397 constr  :  btyconapp                            { qid tyc; list tys;
1398                                                   splittyconapp($1, &tyc, &tys);
1399                                                   $$ = mkconstrpre(tyc,tys,hsplineno); }
1400         |  OPAREN qconsym CPAREN                { $$ = mkconstrpre($2,Lnil,hsplineno); }
1401         |  OPAREN qconsym CPAREN batypes        { $$ = mkconstrpre($2,$4,hsplineno); }
1402         |  btyconapp qconop bbtype              { checknobangs($1);
1403                                                   $$ = mkconstrinf($1,$2,$3,hsplineno); }
1404         |  ntyconapp qconop bbtype              { $$ = mkconstrinf($1,$2,$3,hsplineno); }
1405         |  BANG atype qconop bbtype             { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
1406
1407         /* 1 S/R conflict on OCURLY -> shift */
1408         |  gtycon OCURLY fields CCURLY          { $$ = mkconstrrec($1,$3,hsplineno); }
1409         ;
1410
1411 btyconapp: gtycon                               { $$ = mktname($1); }
1412         |  btyconapp batype                     { $$ = mktapp($1,$2); }
1413         ;
1414
1415 bbtype  :  btype                                { $$ = $1; }
1416         |  BANG atype                           { $$ = mktbang($2); }
1417         ;
1418
1419 batype  :  atype                                { $$ = $1; }
1420         |  BANG atype                           { $$ = mktbang($2); }
1421         ;
1422
1423 batypes :  batype                               { $$ = lsing($1); }
1424         |  batypes batype                       { $$ = lapp($1,$2); }
1425         ;
1426
1427
1428 fields  : field                                 { $$ = lsing($1); }
1429         | fields COMMA field                    { $$ = lapp($1,$3); }
1430         ;
1431
1432 field   :  qvars_list DCOLON type               { $$ = mkfield($1,$3); }
1433         |  qvars_list DCOLON BANG atype         { $$ = mkfield($1,mktbang($4)); }
1434         ;
1435
1436 constr1 :  gtycon atype                         { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
1437         ;
1438
1439
1440 dtyclses:  OPAREN dtycls_list CPAREN            { $$ = $2; }
1441         |  OPAREN CPAREN                        { $$ = Lnil; }
1442         |  qtycls                               { $$ = lsing($1); }
1443         ;
1444
1445 dtycls_list:  qtycls                            { $$ = lsing($1); }
1446         |  dtycls_list COMMA qtycls             { $$ = lapp($1,$3); }
1447         ;
1448
1449 instdefs : /* empty */                          { $$ = mknullbind(); }
1450          | instdef                              { $$ = $1; }
1451          | instdefs SEMI instdef
1452                 {
1453                   if(SAMEFN)
1454                     {
1455                       extendfn($1,$3);
1456                       $$ = $1;
1457                     }
1458                   else
1459                     $$ = mkabind($1,$3);
1460                 }
1461         ;
1462
1463 /* instdef: same as valdef, except certain user-pragmas may appear */
1464 instdef :
1465            SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
1466                 {
1467                   $$ = mkvspec_uprag($2, $4, startlineno);
1468                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1469                 }
1470
1471         |  INLINE_UPRAGMA qvark END_UPRAGMA
1472                 {
1473                   $$ = mkinline_uprag($2, startlineno);
1474                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1475                 }
1476
1477         |  MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
1478                 {
1479                   $$ = mkmagicuf_uprag($2, $3, startlineno);
1480                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
1481                 }
1482
1483         |  valdef
1484         ;
1485
1486
1487 valdef  :  opatk
1488                 {
1489                   tree fn = function($1);
1490                   PREVPATT = $1;
1491
1492                   if(ttree(fn) == ident)
1493                     {
1494                       qid fun_id = gident((struct Sident *) fn);
1495                       checksamefn(fun_id);
1496                       FN = fun_id;
1497                     }
1498
1499                   else if (ttree(fn) == infixap)
1500                     {
1501                       qid fun_id = ginffun((struct Sinfixap *) fn);
1502                       checksamefn(fun_id);
1503                       FN = fun_id;
1504                     }
1505
1506                   else if(etags)
1507 #if 1/*etags*/
1508                     printf("%u\n",startlineno);
1509 #else
1510                     fprintf(stderr,"%u\tvaldef\n",startlineno);
1511 #endif
1512                 }
1513            valrhs
1514                 {
1515                   if ( lhs_is_patt($1) )
1516                     {
1517                       $$ = mkpbind($3, startlineno);
1518                       FN = NULL;
1519                       SAMEFN = 0;
1520                     }
1521                   else /* lhs is function */
1522                     $$ = mkfbind($3,startlineno);
1523
1524                   PREVPATT = NULL;
1525                 }
1526         ;
1527
1528 valrhs  :  valrhs1 maybe_where                  { $$ = lsing(createpat($1, $2)); }
1529         ;
1530
1531 valrhs1 :  gdrhs                                { $$ = mkpguards($1); }
1532         |  EQUAL exp                            { $$ = mkpnoguards($2); }
1533         ;
1534
1535 gdrhs   :  gd EQUAL exp                         { $$ = lsing(mkpgdexp($1,$3)); }
1536         |  gd EQUAL exp gdrhs                   { $$ = mklcons(mkpgdexp($1,$3),$4); }
1537         ;
1538
1539 maybe_where:
1540            WHERE ocurly decls ccurly            { $$ = $3; }
1541         |  WHERE vocurly decls vccurly          { $$ = $3; }
1542         |  /* empty */                          { $$ = mknullbind(); }
1543         ;
1544
1545 gd      :  VBAR oexp                            { $$ = $2; }
1546         ;
1547
1548
1549 /**********************************************************************
1550 *                                                                     *
1551 *                                                                     *
1552 *     Expressions                                                     *
1553 *                                                                     *
1554 *                                                                     *
1555 **********************************************************************/
1556
1557 exp     :  oexp DCOLON ctype                    { $$ = mkrestr($1,$3); }
1558         |  oexp
1559         ;
1560
1561 /*
1562   Operators must be left-associative at the same precedence for
1563   precedence parsing to work.
1564 */
1565         /* 9 S/R conflicts on qop -> shift */
1566 oexp    :  oexp qop oexp %prec MINUS            { $$ = mkinfixap($2,$1,$3); precparse($$); }
1567         |  dexp
1568         ;
1569
1570 /*
1571   This comes here because of the funny precedence rules concerning
1572   prefix minus.
1573 */
1574 dexp    :  MINUS kexp                           { $$ = mknegate($2,NULL,NULL); }
1575         |  kexp
1576         ;
1577
1578 /*
1579   We need to factor out a leading let expression so we can set
1580   inpat=TRUE when parsing (non let) expressions inside stmts and quals
1581 */
1582 expLno  :  oexpLno DCOLON ctype                 { $$ = mkrestr($1,$3); }
1583         |  oexpLno
1584         ;
1585 oexpLno :  oexpLno qop oexp %prec MINUS         { $$ = mkinfixap($2,$1,$3); precparse($$); }
1586         |  dexpLno
1587         ;
1588 dexpLno :  MINUS kexp                           { $$ = mknegate($2,NULL,NULL); }
1589         |  kexpLno
1590         ;
1591
1592 expL    :  oexpL DCOLON ctype                   { $$ = mkrestr($1,$3); }
1593         |  oexpL
1594         ;
1595 oexpL   :  oexpL qop oexp %prec MINUS           { $$ = mkinfixap($2,$1,$3); precparse($$); }
1596         |  kexpL
1597         ;
1598
1599 /*
1600   let/if/lambda/case have higher precedence than infix operators.
1601 */
1602
1603 kexp    :  kexpL
1604         |  kexpLno
1605         ;
1606
1607 kexpL   :  letdecls IN exp                      { $$ = mklet($1,$3); }
1608         ;
1609
1610 kexpLno :  LAMBDA
1611                 { hsincindent();        /* push new context for FN = NULL;        */
1612                   FN = NULL;            /* not actually concerned about indenting */
1613                   $<ulong>$ = hsplineno; /* remember current line number           */
1614                 }
1615            lampats
1616                 { hsendindent();
1617                 }
1618            RARROW exp                   /* lambda abstraction */
1619                 {
1620                   $$ = mklambda($3, $6, $<ulong>2);
1621                 }
1622
1623         /* If Expression */
1624         |  IF {$<ulong>$ = hsplineno;}
1625            exp THEN exp ELSE exp                { $$ = mkife($3,$5,$7,$<ulong>2); }
1626
1627         /* Case Expression */
1628         |  CASE {$<ulong>$ = hsplineno;}
1629            exp OF caserest                      { $$ = mkcasee($3,$5,$<ulong>2); }
1630
1631         /* Do Expression */
1632         |  DO {$<ulong>$ = hsplineno;}
1633            dorest                               { $$ = mkdoe($3,$<ulong>2); }
1634
1635         /* CCALL/CASM Expression */
1636         |  CCALL ccallid cexps                  { $$ = mkccall($2,install_literal("n"),$3); }
1637         |  CCALL ccallid                        { $$ = mkccall($2,install_literal("n"),Lnil); }
1638         |  CCALL_GC ccallid cexps               { $$ = mkccall($2,install_literal("p"),$3); }
1639         |  CCALL_GC ccallid                     { $$ = mkccall($2,install_literal("p"),Lnil); }
1640         |  CASM CLITLIT cexps                   { $$ = mkccall($2,install_literal("N"),$3); }
1641         |  CASM CLITLIT                         { $$ = mkccall($2,install_literal("N"),Lnil); }
1642         |  CASM_GC CLITLIT cexps                { $$ = mkccall($2,install_literal("P"),$3); }
1643         |  CASM_GC CLITLIT                      { $$ = mkccall($2,install_literal("P"),Lnil); }
1644
1645         /* SCC Expression */
1646         |  SCC STRING exp
1647                 { if (ignoreSCC) {
1648                     $$ = $3;
1649                   } else {
1650                     $$ = mkscc($2, $3);
1651                   }
1652                 }
1653         |  fexp
1654         ;
1655
1656 fexp    :  fexp aexp                            { $$ = mkap($1,$2); }
1657         |  aexp
1658         ;
1659
1660         /* simple expressions */
1661 aexp    :  qvar                                 { $$ = mkident($1); }
1662         |  gcon                                 { $$ = mkident($1); }
1663         |  lit_constant                         { $$ = mklit($1); }
1664         |  OPAREN exp CPAREN                    { $$ = mkpar($2); }       /* mkpar: stop infix parsing at ()'s */
1665         |  qcon OCURLY rbinds CCURLY            { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
1666         |  OBRACK list_exps CBRACK              { $$ = mkllist($2); }
1667         |  OPAREN exp COMMA texps CPAREN        { if (ttree($4) == tuple)
1668                                                      $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1669                                                   else
1670                                                      $$ = mktuple(ldub($2, $4)); }
1671
1672         /* only in expressions ... */
1673         |  aexp OCURLY rbinds CCURLY            { $$ = mkrupdate($1,$3); }
1674         |  OBRACK exp VBAR quals CBRACK         { $$ = mkcomprh($2,$4); }
1675         |  OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1676         |  OBRACK exp COMMA exp DOTDOT CBRACK   { $$ = mkeenum($2,mkjust($4),mknothing()); }
1677         |  OBRACK exp DOTDOT exp CBRACK         { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1678         |  OBRACK exp DOTDOT CBRACK             { $$ = mkeenum($2,mknothing(),mknothing()); }
1679         |  OPAREN oexp qop CPAREN               { $$ = mklsection($2,$3); }
1680         |  OPAREN qop1 oexp CPAREN              { $$ = mkrsection($2,$3); }
1681
1682         /* only in patterns ... */
1683         /* these add 2 S/R conflict with with  aexp . OCURLY rbinds CCURLY */
1684         |  qvar AT aexp                         { checkinpat(); $$ = mkas($1,$3); }
1685         |  LAZY aexp                            { checkinpat(); $$ = mklazyp($2); }
1686         |  WILDCARD                             { checkinpat(); $$ = mkwildp();   }
1687         ;
1688
1689         /* ccall arguments */
1690 cexps   :  cexps aexp                           { $$ = lapp($1,$2); }
1691         |  aexp                                 { $$ = lsing($1); }
1692         ;
1693
1694 caserest:  ocurly alts ccurly                   { $$ = $2; }
1695         |  vocurly alts vccurly                 { $$ = $2; }
1696
1697 dorest  :  ocurly stmts ccurly                  { checkdostmts($2); $$ = $2; }
1698         |  vocurly stmts vccurly                { checkdostmts($2); $$ = $2; }
1699         ;
1700
1701 rbinds  :  rbind                                { $$ = lsing($1); }
1702         |  rbinds COMMA rbind                   { $$ = lapp($1,$3); }
1703         ;
1704
1705 rbind   :  qvar                                 { $$ = mkrbind($1,mknothing()); }
1706         |  qvar EQUAL exp                       { $$ = mkrbind($1,mkjust($3)); }
1707         ;
1708
1709 texps   :  exp  { $$ = mkpar($1); }     /* mkpar: so we don't flatten last element in tuple */
1710         |  exp COMMA texps
1711                 { if (ttree($3) == tuple)
1712                     $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1713                   else
1714                     $$ = mktuple(ldub($1, $3));
1715                 }
1716         /* right recursion? WDP */
1717         ;
1718
1719
1720 list_exps :
1721            exp                                  { $$ = lsing($1); }
1722         |  exp COMMA list_exps          { $$ = mklcons($1, $3); }
1723         /* right recursion? (WDP)
1724
1725            It has to be this way, though, otherwise you
1726            may do the wrong thing to distinguish between...
1727
1728            [ e1 , e2 .. ]       -- an enumeration ...
1729            [ e1 , e2 , e3 ]     -- a list
1730
1731            (In fact, if you change the grammar and throw yacc/bison
1732            at it, it *will* do the wrong thing [WDP 94/06])
1733         */
1734         ;
1735
1736 letdecls:  LET ocurly decls ccurly              { $$ = $3 }
1737         |  LET vocurly decls vccurly            { $$ = $3 }
1738         ;
1739
1740 quals   :  qual                                 { $$ = lsing($1); }
1741         |  quals COMMA qual                     { $$ = lapp($1,$3); }
1742         ;
1743
1744 qual    :  letdecls                             { $$ = mkseqlet($1); }
1745         |  expL                                 { $$ = $1; }
1746         |  {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
1747                 { if ($4 == NULL) {
1748                       expORpat(LEGIT_EXPR,$2);
1749                       $$ = mkguard($2);
1750                   } else {
1751                       expORpat(LEGIT_PATT,$2);
1752                       $$ = mkqual($2,$4);
1753                   }
1754                 }
1755         ;
1756
1757 alts    :  alt                                  { $$ = $1; }
1758         |  alts SEMI alt                        { $$ = lconc($1,$3); }
1759         ;
1760
1761 alt     :  pat { PREVPATT = $1; } altrest       { $$ = lsing($3); PREVPATT = NULL; }
1762         |  /* empty */                          { $$ = Lnil; }
1763         ;
1764
1765 altrest :  gdpat maybe_where                    { $$ = createpat(mkpguards($1), $2); }
1766         |  RARROW exp maybe_where               { $$ = createpat(mkpnoguards($2),$3); }
1767         ;
1768
1769 gdpat   :  gd RARROW exp                        { $$ = lsing(mkpgdexp($1,$3)); }
1770         |  gd RARROW exp gdpat                  { $$ = mklcons(mkpgdexp($1,$3),$4);  }
1771         ;
1772
1773 stmts   :  stmt                                 { $$ = $1; }
1774         |  stmts SEMI stmt                      { $$ = lconc($1,$3); }
1775         ;
1776
1777 stmt    :  /* empty */                          { $$ = Lnil; }
1778         |  letdecls                             { $$ = lsing(mkseqlet($1)); }
1779         |  expL                                 { $$ = lsing($1); }
1780         |  {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
1781                 { if ($4 == NULL) {
1782                       expORpat(LEGIT_EXPR,$2);
1783                       $$ = lsing(mkdoexp($2,endlineno));
1784                   } else {
1785                       expORpat(LEGIT_PATT,$2);
1786                       $$ = lsing(mkdobind($2,$4,endlineno));
1787                   }
1788                 }
1789         ;
1790
1791 leftexp :  LARROW exp                           { $$ = $2; }
1792         |  /* empty */                          { $$ = NULL; }
1793         ;
1794
1795 /**********************************************************************
1796 *                                                                     *
1797 *                                                                     *
1798 *     Patterns                                                        *
1799 *                                                                     *
1800 *                                                                     *
1801 **********************************************************************/
1802
1803 /*
1804         The xpatk business is to do with accurately recording
1805         the starting line for definitions.
1806 */
1807
1808 opatk   :  dpatk
1809         |  opatk qop opat %prec MINUS
1810                 {
1811                   $$ = mkinfixap($2,$1,$3);
1812
1813                   if (isconstr(qid_to_string($2)))
1814                     precparse($$);
1815                   else
1816                     {
1817                       checkprec($1,$2,FALSE);   /* Check the precedence of the left pattern */
1818                       checkprec($3,$2,TRUE);    /* then check the right pattern */
1819                     }
1820                 }
1821         ;
1822
1823 opat    :  dpat
1824         |  opat qop opat %prec MINUS
1825                 {
1826                   $$ = mkinfixap($2,$1,$3);
1827
1828                   if(isconstr(qid_to_string($2)))
1829                     precparse($$);
1830                   else
1831                     {
1832                       checkprec($1,$2,FALSE);   /* Check the precedence of the left pattern */
1833                       checkprec($3,$2,TRUE);    /* then check the right pattern */
1834                     }
1835                 }
1836         ;
1837
1838 /*
1839   This comes here because of the funny precedence rules concerning
1840   prefix minus.
1841 */
1842
1843
1844 dpat    :  MINUS fpat                           { $$ = mknegate($2,NULL,NULL); }
1845         |  fpat
1846         ;
1847
1848         /* Function application */
1849 fpat    :  fpat aapat                           { $$ = mkap($1,$2); }
1850         |  aapat
1851         ;
1852
1853 dpatk   :  minuskey fpat                        { $$ = mknegate($2,NULL,NULL); }
1854         |  fpatk
1855         ;
1856
1857         /* Function application */
1858 fpatk   :  fpatk aapat                          { $$ = mkap($1,$2); }
1859         |  aapatk
1860         ;
1861
1862 aapat   :  qvar                                 { $$ = mkident($1); }
1863         |  qvar AT apat                         { $$ = mkas($1,$3); }
1864         |  gcon                                 { $$ = mkident($1); }
1865         |  qcon OCURLY rpats CCURLY             { $$ = mkrecord($1,$3); }
1866         |  lit_constant                         { $$ = mklit($1); }
1867         |  WILDCARD                             { $$ = mkwildp(); }
1868         |  OPAREN opat CPAREN                   { $$ = mkpar($2); }
1869         |  OPAREN opat COMMA pats CPAREN        { $$ = mktuple(mklcons($2,$4)); }
1870         |  OBRACK pats CBRACK                   { $$ = mkllist($2); }
1871         |  LAZY apat                            { $$ = mklazyp($2); }
1872         ;
1873
1874
1875 aapatk  :  qvark                                { $$ = mkident($1); }
1876         |  qvark AT apat                        { $$ = mkas($1,$3); }
1877         |  gconk                                { $$ = mkident($1); }
1878         |  qconk OCURLY rpats CCURLY            { $$ = mkrecord($1,$3); }
1879         |  lit_constant                         { $$ = mklit($1); setstartlineno(); }
1880         |  WILDCARD                             { $$ = mkwildp(); setstartlineno(); }
1881         |  oparenkey opat CPAREN                { $$ = mkpar($2); }
1882         |  oparenkey opat COMMA pats CPAREN     { $$ = mktuple(mklcons($2,$4)); }
1883         |  obrackkey pats CBRACK                { $$ = mkllist($2); }
1884         |  lazykey apat                         { $$ = mklazyp($2); }
1885         ;
1886
1887 gcon    :  qcon
1888         |  OBRACK CBRACK                        { $$ = creategid(-1); }
1889         |  OPAREN CPAREN                        { $$ = creategid(0); }
1890         |  OPAREN commas CPAREN                 { $$ = creategid($2); }
1891         ;
1892
1893 gconk   :  qconk
1894         |  obrackkey CBRACK                     { $$ = creategid(-1); }
1895         |  oparenkey CPAREN                     { $$ = creategid(0); }
1896         |  oparenkey commas CPAREN              { $$ = creategid($2); }
1897         ;
1898
1899 lampats :  apat lampats                         { $$ = mklcons($1,$2); }
1900         |  apat                                 { $$ = lsing($1); }
1901         /* right recursion? (WDP) */
1902         ;
1903
1904 pats    :  pat COMMA pats                       { $$ = mklcons($1, $3); }
1905         |  pat                                  { $$ = lsing($1); }
1906         /* right recursion? (WDP) */
1907         ;
1908
1909 pat     :  pat qconop bpat                      { $$ = mkinfixap($2,$1,$3); precparse($$); }
1910         |  bpat
1911         ;
1912
1913 bpat    :  apatc
1914         |  conpat
1915         |  qcon OCURLY rpats CCURLY             { $$ = mkrecord($1,$3); }
1916         |  MINUS INTEGER                        { $$ = mklit(mkinteger(ineg($2))); }
1917         |  MINUS FLOAT                          { $$ = mklit(mkfloatr(ineg($2))); }
1918         ;
1919
1920 conpat  :  gcon                                 { $$ = mkident($1); }
1921         |  conpat apat                          { $$ = mkap($1,$2); }
1922         ;
1923
1924 apat    :  gcon                                 { $$ = mkident($1); }
1925         |  qcon OCURLY rpats CCURLY             { $$ = mkrecord($1,$3); }
1926         |  apatc
1927         ;
1928
1929 apatc   :  qvar                                 { $$ = mkident($1); }
1930         |  qvar AT apat                         { $$ = mkas($1,$3); }
1931         |  lit_constant                         { $$ = mklit($1); }
1932         |  WILDCARD                             { $$ = mkwildp(); }
1933         |  OPAREN pat CPAREN                    { $$ = mkpar($2); }
1934         |  OPAREN pat COMMA pats CPAREN         { $$ = mktuple(mklcons($2,$4)); }
1935         |  OBRACK pats CBRACK                   { $$ = mkllist($2); }
1936         |  LAZY apat                            { $$ = mklazyp($2); }
1937         ;
1938
1939 lit_constant:
1940            INTEGER                              { $$ = mkinteger($1); }
1941         |  FLOAT                                { $$ = mkfloatr($1); }
1942         |  CHAR                                 { $$ = mkcharr($1); }
1943         |  STRING                               { $$ = mkstring($1); }
1944         |  CHARPRIM                             { $$ = mkcharprim($1); }
1945         |  STRINGPRIM                           { $$ = mkstringprim($1); }
1946         |  INTPRIM                              { $$ = mkintprim($1); }
1947         |  FLOATPRIM                            { $$ = mkfloatprim($1); }
1948         |  DOUBLEPRIM                           { $$ = mkdoubleprim($1); }
1949         |  CLITLIT /* yurble yurble */          { $$ = mkclitlit($1, ""); }
1950         |  CLITLIT KIND_PRAGMA CONID            { $$ = mkclitlit($1, $3); }
1951         |  NOREP_INTEGER  INTEGER               { $$ = mknorepi($2); }
1952         |  NOREP_RATIONAL INTEGER INTEGER       { $$ = mknorepr($2, $3); }
1953         |  NOREP_STRING   STRING                { $$ = mknoreps($2); }
1954         ;
1955
1956 rpats   : rpat                                  { $$ = lsing($1); }
1957         | rpats COMMA rpat                      { $$ = lapp($1,$3); }
1958         ;
1959
1960 rpat    :  qvar                                 { $$ = mkrbind($1,mknothing()); }
1961         |  qvar EQUAL pat                       { $$ = mkrbind($1,mkjust($3)); }
1962         ;
1963
1964
1965 /**********************************************************************
1966 *                                                                     *
1967 *                                                                     *
1968 *     Keywords which record the line start                            *
1969 *                                                                     *
1970 *                                                                     *
1971 **********************************************************************/
1972
1973 importkey:  IMPORT      { setstartlineno(); }
1974         ;
1975
1976 datakey :   DATA        { setstartlineno();
1977                           if(etags)
1978 #if 1/*etags*/
1979                             printf("%u\n",startlineno);
1980 #else
1981                             fprintf(stderr,"%u\tdata\n",startlineno);
1982 #endif
1983                         }
1984         ;
1985
1986 typekey :   TYPE        { setstartlineno();
1987                           if(etags)
1988 #if 1/*etags*/
1989                             printf("%u\n",startlineno);
1990 #else
1991                             fprintf(stderr,"%u\ttype\n",startlineno);
1992 #endif
1993                         }
1994         ;
1995
1996 newtypekey : NEWTYPE    { setstartlineno();
1997                           if(etags)
1998 #if 1/*etags*/
1999                             printf("%u\n",startlineno);
2000 #else
2001                             fprintf(stderr,"%u\tnewtype\n",startlineno);
2002 #endif
2003                         }
2004         ;
2005
2006 instkey :   INSTANCE    { setstartlineno();
2007 #if 1/*etags*/
2008 /* OUT:                   if(etags)
2009                             printf("%u\n",startlineno);
2010 */
2011 #else
2012                             fprintf(stderr,"%u\tinstance\n",startlineno);
2013 #endif
2014                         }
2015         ;
2016
2017 defaultkey: DEFAULT     { setstartlineno(); }
2018         ;
2019
2020 classkey:   CLASS       { setstartlineno();
2021                           if(etags)
2022 #if 1/*etags*/
2023                             printf("%u\n",startlineno);
2024 #else
2025                             fprintf(stderr,"%u\tclass\n",startlineno);
2026 #endif
2027                         }
2028         ;
2029
2030 minuskey:   MINUS       { setstartlineno(); }
2031         ;
2032
2033 modulekey:  MODULE      { setstartlineno();
2034                           if(etags)
2035 #if 1/*etags*/
2036                             printf("%u\n",startlineno);
2037 #else
2038                             fprintf(stderr,"%u\tmodule\n",startlineno);
2039 #endif
2040                         }
2041         ;
2042
2043 oparenkey:  OPAREN      { setstartlineno(); }
2044         ;
2045
2046 obrackkey:  OBRACK      { setstartlineno(); }
2047         ;
2048
2049 lazykey :   LAZY        { setstartlineno(); }
2050         ;
2051
2052
2053 /**********************************************************************
2054 *                                                                     *
2055 *                                                                     *
2056 *     Basic qualified/unqualified ids/ops                             *
2057 *                                                                     *
2058 *                                                                     *
2059 **********************************************************************/
2060
2061 qvar    :  qvarid
2062         |  OPAREN qvarsym CPAREN        { $$ = $2; }
2063         ;
2064 qcon    :  qconid
2065         |  OPAREN qconsym CPAREN        { $$ = $2; }
2066         ;
2067 qvarop  :  qvarsym
2068         |  BQUOTE qvarid BQUOTE         { $$ = $2; }
2069         ;
2070 qconop  :  qconsym
2071         |  BQUOTE qconid BQUOTE         { $$ = $2; }
2072         ;
2073 qop     :  qconop
2074         |  qvarop
2075         ;
2076
2077 /* Non "-" op, used in right sections */
2078 qop1    :  qconop
2079         |  qvarop1
2080         ;
2081
2082 /* Non "-" varop, used in right sections */
2083 qvarop1 :  QVARSYM
2084         |  varsym_nominus               { $$ = mknoqual($1); }
2085         |  BQUOTE qvarid BQUOTE         { $$ = $2; }
2086         ;
2087
2088
2089 var     :  varid
2090         |  OPAREN varsym CPAREN         { $$ = $2; }
2091         ;
2092 con     :  tycon                        /* using tycon removes conflicts */
2093         |  OPAREN CONSYM CPAREN         { $$ = $2; }
2094         ;
2095 varop   :  varsym
2096         |  BQUOTE varid BQUOTE          { $$ = $2; }
2097         ;
2098 conop   :  CONSYM
2099         |  BQUOTE CONID BQUOTE          { $$ = $2; }
2100         ;
2101 op      :  conop
2102         |  varop
2103         ;
2104
2105 qvark   :  qvarid                       { setstartlineno(); $$ = $1; }
2106         |  oparenkey qvarsym CPAREN     { $$ = $2; }
2107         ;
2108 qconk   :  qconid                       { setstartlineno(); $$ = $1; }
2109         |  oparenkey qconsym CPAREN     { $$ = $2; }
2110         ;
2111 vark    :  varid                        { setstartlineno(); $$ = $1; }
2112         |  oparenkey varsym CPAREN      { $$ = $2; }
2113         ;
2114
2115 qvarid  :  QVARID
2116         |  varid                        { $$ = mknoqual($1); }
2117         ;
2118 qvarsym :  QVARSYM
2119         |  varsym                       { $$ = mknoqual($1); }
2120         ;
2121 qconid  :  QCONID
2122         |  tycon                        { $$ = mknoqual($1); } /* using tycon removes conflicts */
2123         ;
2124 qconsym :  QCONSYM
2125         |  CONSYM                       { $$ = mknoqual($1); }
2126         ;
2127 qtycon  :  QCONID
2128         |  tycon                        { $$ = mknoqual($1); } /* using tycon removes conflicts */
2129         ;
2130 qtycls  :  QCONID
2131         |  tycon                        { $$ = mknoqual($1); } /* using tycon removes conflicts */
2132         ;
2133
2134 varsym  :  varsym_nominus
2135         |  MINUS                        { $$ = install_literal("-"); }
2136         ;
2137
2138 /* AS HIDING QUALIFIED are valid varids */
2139 varid   :  VARID
2140         |  AS                           { $$ = install_literal("as"); }
2141         |  HIDING                       { $$ = install_literal("hiding"); }
2142         |  QUALIFIED                    { $$ = install_literal("qualified"); }
2143         |  INTERFACE                    { $$ = install_literal("interface"); }
2144         ;
2145
2146 /* DARROW BANG are valid varsyms */
2147 varsym_nominus : VARSYM
2148         |  DARROW                       { $$ = install_literal("=>"); }
2149         |  BANG                         { $$ = install_literal("!"); }
2150         ;
2151
2152 ccallid :  VARID
2153         |  CONID
2154         ;
2155
2156 tyvar   :  varid                        { $$ = mknamedtvar($1); }
2157         ;
2158 tycon   :  CONID
2159         ;
2160 modid   :  CONID
2161         ;
2162
2163 tyvar_list: tyvar                       { $$ = lsing($1); }
2164         |  tyvar_list COMMA tyvar       { $$ = lapp($1,$3); }
2165         ;
2166
2167 /**********************************************************************
2168 *                                                                     *
2169 *                                                                     *
2170 *     Stuff to do with layout                                         *
2171 *                                                                     *
2172 *                                                                     *
2173 **********************************************************************/
2174
2175 ocurly  : layout OCURLY                         { hsincindent(); }
2176
2177 vocurly : layout                                { hssetindent(); }
2178         ;
2179
2180 layout  :                                       { hsindentoff(); }
2181         ;
2182
2183 ccurly  :
2184          CCURLY
2185                 {
2186                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2187                   hsendindent();
2188                 }
2189         ;
2190
2191 vccurly :  { expect_ccurly = 1; }  vccurly1  { expect_ccurly = 0; }
2192         ;
2193
2194 vccurly1:
2195          VCCURLY
2196                 {
2197                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2198                   hsendindent();
2199                 }
2200         | error
2201                 {
2202                   yyerrok;
2203                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2204                   hsendindent();
2205                 }
2206         ;
2207
2208 %%
2209
2210 /**********************************************************************
2211 *                                                                     *
2212 *      Error Processing and Reporting                                 *
2213 *                                                                     *
2214 *  (This stuff is here in case we want to use Yacc macros and such.)  *
2215 *                                                                     *
2216 **********************************************************************/
2217
2218 /* The parser calls "hsperror" when it sees a
2219    `report this and die' error.  It sets the stage
2220    and calls "yyerror".
2221
2222    There should be no direct calls in the parser to
2223    "yyerror", except for the one from "hsperror".  Thus,
2224    the only other calls will be from the error productions
2225    introduced by yacc/bison/whatever.
2226
2227    We need to be able to recognise the from-error-production
2228    case, because we sometimes want to say, "Oh, never mind",
2229    because the layout rule kicks into action and may save
2230    the day.  [WDP]
2231 */
2232
2233 static BOOLEAN error_and_I_mean_it = FALSE;
2234
2235 void
2236 hsperror(s)
2237   char *s;
2238 {
2239     error_and_I_mean_it = TRUE;
2240     yyerror(s);
2241 }
2242
2243 extern char *yytext;
2244 extern int yyleng;
2245
2246 void
2247 yyerror(s)
2248   char *s;
2249 {
2250     /* We want to be able to distinguish 'error'-raised yyerrors
2251        from yyerrors explicitly coded by the parser hacker.
2252     */
2253     if (expect_ccurly && ! error_and_I_mean_it ) {
2254         /*NOTHING*/;
2255
2256     } else {
2257         fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
2258           input_filename, hsplineno, hspcolno + 1, s);
2259
2260         if (yyleng == 1 && *yytext == '\0')
2261             fprintf(stderr, "<EOF>");
2262
2263         else {
2264             fputc('"', stderr);
2265             format_string(stderr, (unsigned char *) yytext, yyleng);
2266             fputc('"', stderr);
2267         }
2268         fputc('\n', stderr);
2269
2270         /* a common problem */
2271         if (strcmp(yytext, "#") == 0)
2272             fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
2273
2274         exit(1);
2275     }
2276 }
2277
2278 void
2279 format_string(fp, s, len)
2280   FILE *fp;
2281   unsigned char *s;
2282   int len;
2283 {
2284     while (len-- > 0) {
2285         switch (*s) {
2286         case '\0':    fputs("\\NUL", fp);   break;
2287         case '\007':  fputs("\\a", fp);     break;
2288         case '\010':  fputs("\\b", fp);     break;
2289         case '\011':  fputs("\\t", fp);     break;
2290         case '\012':  fputs("\\n", fp);     break;
2291         case '\013':  fputs("\\v", fp);     break;
2292         case '\014':  fputs("\\f", fp);     break;
2293         case '\015':  fputs("\\r", fp);     break;
2294         case '\033':  fputs("\\ESC", fp);   break;
2295         case '\034':  fputs("\\FS", fp);    break;
2296         case '\035':  fputs("\\GS", fp);    break;
2297         case '\036':  fputs("\\RS", fp);    break;
2298         case '\037':  fputs("\\US", fp);    break;
2299         case '\177':  fputs("\\DEL", fp);   break;
2300         default:
2301             if (*s >= ' ')
2302                 fputc(*s, fp);
2303             else
2304                 fprintf(fp, "\\^%c", *s + '@');
2305             break;
2306         }
2307         s++;
2308     }
2309 }