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