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