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
 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                 { /* OLD 95/08: 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                 { if (ignoreSCC) {
1509                     if (warnSCC)
1510                         fprintf(stderr,
1511                                 "\"%s\", line %d: _scc_ (`set [profiling] cost centre') ignored\n",
1512                                 input_filename, hsplineno);
1513                     $$ = $3;
1514                   } else {
1515                     $$ = mkscc($2, $3);
1516                   }
1517                 }
1518         |  fexp
1519         ;
1520
1521
1522         /* Function application */
1523 fexp    :  fexp aexp                            { $$ = mkap($1,$2); }
1524         |  aexp
1525         ;
1526
1527 cexp    :  cexp aexp                            { $$ = lapp($1,$2); }
1528         |  aexp                                 { $$ = lsing($1); }
1529         ;
1530
1531 /*
1532    The mkpars are so that infix parsing doesn't get confused.
1533
1534    KH.
1535 */
1536
1537         /* Simple Expressions */
1538 aexp    :  var                                  { $$ = mkident($1); }
1539         |  con                                  { $$ = mkident($1); }
1540         |  lit_constant                         { $$ = mklit($1); }
1541         |  OPAREN exp CPAREN                    { $$ = mkpar($2); }
1542         |  OPAREN oexp op CPAREN                { checkprec($2,$3,FALSE); $$ = mklsection($2,$3); }
1543         |  OPAREN op1 oexp CPAREN               { checkprec($3,$2,TRUE);  $$ = mkrsection($2,$3); }
1544
1545         /* structures */
1546         |  tuple
1547         |  list                                 { $$ = mkpar($1); }
1548         |  sequence                             { $$ = mkpar($1); }
1549         |  comprehension                        { $$ = mkpar($1); }
1550
1551         /* These only occur in patterns */
1552         |  var AT aexp                          { checkinpat();  $$ = mkas($1,$3); }
1553         |  WILDCARD                             { checkinpat();  $$ = mkwildp();   }
1554         |  LAZY aexp                            { checkinpat();  $$ = mklazyp($2); }
1555         ;
1556
1557
1558 /*
1559         LHS patterns are parsed in a similar way to
1560         expressions.  This avoids the horrible non-LRness
1561         which occurs with the 1.1 syntax.
1562
1563         The xpatk business is to do with accurately recording
1564         the starting line for definitions.
1565 */
1566
1567 opatk   :  dpatk
1568         |  opatk op opat %prec PLUS
1569                 {
1570                   $$ = mkinfixop($2,$1,$3);
1571
1572                   if(isconstr(id_to_string($2)))
1573                     precparse($$);
1574                   else
1575                     {
1576                       checkprec($1,$2,FALSE);   /* Check the precedence of the left pattern */
1577                       checkprec($3,$2,TRUE);    /* then check the right pattern */
1578                     }
1579                 }
1580         ;
1581
1582 opat    :  dpat
1583         |  opat op opat %prec PLUS
1584                 {
1585                   $$ = mkinfixop($2,$1,$3);
1586
1587                   if(isconstr(id_to_string($2)))
1588                     precparse($$);
1589                   else
1590                     {
1591                       checkprec($1,$2,FALSE);   /* Check the precedence of the left pattern */
1592                       checkprec($3,$2,TRUE);    /* then check the right pattern */
1593                     }
1594                 }
1595         ;
1596
1597 /*
1598   This comes here because of the funny precedence rules concerning
1599   prefix minus.
1600 */
1601
1602
1603 dpat    :  MINUS fpat                                   { $$ = mknegate($2); }
1604         |  fpat
1605         ;
1606
1607         /* Function application */
1608 fpat    :  fpat aapat                                   { $$ = mkap($1,$2); }
1609         |  aapat
1610         ;
1611
1612 dpatk   :  minuskey fpat                                { $$ = mknegate($2); }
1613         |  fpatk
1614         ;
1615
1616         /* Function application */
1617 fpatk   :  fpatk aapat                                  { $$ = mkap($1,$2); }
1618         |  aapatk
1619         ;
1620
1621 aapat   :  con                                          { $$ = mkident($1); }
1622         |  var                                          { $$ = mkident($1); }
1623         |  var AT apat                                  { $$ = mkas($1,$3); }
1624         |  lit_constant                                 { $$ = mklit($1); }
1625         |  WILDCARD                                     { $$ = mkwildp(); }
1626         |  OPAREN CPAREN                                { $$ = mktuple(Lnil); }
1627         |  OPAREN var PLUS INTEGER CPAREN               { $$ = mkplusp(mkident($2),mkinteger($4)); }
1628 /* GHC cannot do these anyway. WDP 93/11/15
1629         |  OPAREN WILDCARD PLUS INTEGER CPAREN          { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1630 */
1631         |  OPAREN opat CPAREN                           { $$ = mkpar($2); }
1632         |  OPAREN opat COMMA pats CPAREN                { $$ = mktuple(mklcons($2,$4)); }
1633         |  OBRACK pats CBRACK                           { $$ = mkllist($2); }
1634         |  OBRACK CBRACK                                { $$ = mkllist(Lnil); }
1635         |  LAZY apat                                    { $$ = mklazyp($2); }
1636         ;
1637
1638 aapatk  :  conk                                         { $$ = mkident($1); }
1639         |  vark                                         { $$ = mkident($1); }
1640         |  vark AT apat                                 { $$ = mkas($1,$3); }
1641         |  lit_constant                                 { $$ = mklit($1); setstartlineno(); }
1642         |  WILDCARD                                     { $$ = mkwildp(); setstartlineno(); }
1643         |  oparenkey CPAREN                             { $$ = mktuple(Lnil); }
1644         |  oparenkey var PLUS INTEGER CPAREN            { $$ = mkplusp(mkident($2),mkinteger($4)); }
1645 /* GHC no cannae do (WDP 95/05)
1646         |  oparenkey WILDCARD PLUS INTEGER CPAREN       { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1647 */
1648         |  oparenkey opat CPAREN                        { $$ = mkpar($2); }
1649         |  oparenkey opat COMMA pats CPAREN             { $$ = mktuple(mklcons($2,$4)); }
1650         |  obrackkey pats CBRACK                        { $$ = mkllist($2); }
1651         |  obrackkey CBRACK                             { $$ = mkllist(Lnil); }
1652         |  lazykey apat                                 { $$ = mklazyp($2); }
1653         ;
1654
1655
1656 tuple   :  OPAREN exp COMMA texps CPAREN
1657                 { if (ttree($4) == tuple)
1658                     $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1659                 else
1660                   $$ = mktuple(ldub($2, $4));
1661                 }
1662         |  OPAREN CPAREN
1663                 { $$ = mktuple(Lnil); }
1664         ;
1665
1666 /*
1667    The mkpar is so that infix parsing doesn't get confused.
1668
1669    KH.
1670 */
1671 texps   :  exp  { $$ = mkpar($1); }
1672         |  exp COMMA texps
1673                 { if (ttree($3) == tuple)
1674                     $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1675                 else
1676                   $$ = mktuple(ldub($1, $3));
1677                 }
1678         /* right recursion? WDP */
1679         ;
1680
1681
1682 list    :  OBRACK CBRACK                        { $$ = mkllist(Lnil); }
1683         |  OBRACK list_exps CBRACK              { $$ = mkllist($2); }
1684         ;
1685
1686 list_exps :
1687            exp                                  { $$ = lsing($1); }
1688         |  exp COMMA list_exps                  { $$ = mklcons($1, $3); }
1689         /* right recursion? (WDP)
1690
1691            It has to be this way, though, otherwise you
1692            may do the wrong thing to distinguish between...
1693
1694            [ e1 , e2 .. ]       -- an enumeration ...
1695            [ e1 , e2 , e3 ]     -- a list
1696
1697            (In fact, if you change the grammar and throw yacc/bison
1698            at it, it *will* do the wrong thing [WDP 94/06])
1699         */
1700         ;
1701
1702
1703 sequence:  OBRACK exp COMMA exp DOTDOT upto CBRACK      {$$ = mkeenum($2,lsing($4),$6);}
1704         |  OBRACK exp DOTDOT upto CBRACK        { $$ = mkeenum($2,Lnil,$4); }
1705         ;
1706
1707 comprehension:  OBRACK exp VBAR quals CBRACK    { $$ = mkcomprh($2,$4); }
1708         ;
1709
1710 quals   :  qual                                 { $$ = lsing($1); }
1711         |  quals COMMA qual                     { $$ = lapp($1,$3); }
1712         ;
1713
1714 qual    :       { inpat = TRUE; } exp { inpat = FALSE; } qualrest
1715                 { if ($4 == NULL) {
1716                     patternOrExpr(/*wanted:*/ LEGIT_EXPR,$2);
1717                     $$ = mkguard($2);
1718                   } else {
1719                     patternOrExpr(/*wanted:*/ LEGIT_PATT,$2);
1720                     $$ = mkqual($2,$4);
1721 /* OLD: WDP 95/08
1722                       if(ttree($4)==def)
1723                         {
1724                           tree prevpatt_save = PREVPATT;
1725                           PREVPATT = $2;
1726                           $$ = mkdef((tree) mkpbind(lsing(createpat(lsing(mktruecase(ggdef((struct Sdef *) $4))),mknullbind())),hsplineno));
1727                           PREVPATT = prevpatt_save;
1728                         }
1729                       else
1730 */
1731                   }
1732                 }
1733         ;
1734
1735 qualrest:  LARROW exp                           { $$ = $2; }
1736         |  /* empty */                          { $$ = NULL; }
1737         ;
1738
1739 alts    :  alt                                  { $$ = $1; }
1740         |  alts SEMI alt                        { $$ = lconc($1,$3); }
1741         ;
1742
1743 alt     :  pat
1744                 { PREVPATT = $1; }
1745            altrest
1746                 { $$ = $3;
1747                   PREVPATT = NULL;
1748                 }
1749         |  /* empty */                          { $$ = Lnil; }
1750         ;
1751
1752 altrest :  gdpat maybe_where                    { $$ = lsing(createpat($1, $2)); }
1753         |  RARROW exp maybe_where               { $$ = lsing(createpat(lsing(mktruecase($2)), $3)); }
1754         ;
1755
1756 gdpat   :  gd RARROW exp gdpat                  { $$ = mklcons(ldub($1,$3),$4);  }
1757         |  gd RARROW exp                        { $$ = lsing(ldub($1,$3)); }
1758         ;
1759
1760 upto    :  /* empty */                          { $$ = Lnil; }
1761         |  exp                                  { $$ = lsing($1); }
1762         ;
1763
1764 pats    :  pat COMMA pats                       { $$ = mklcons($1, $3); }
1765         |  pat                                  { $$ = lsing($1); }
1766         /* right recursion? (WDP) */
1767         ;
1768
1769 pat     :  bpat
1770         |  pat conop bpat                       { $$ = mkinfixop($2,$1,$3); precparse($$); }
1771         ;
1772
1773 bpat    :  apatc
1774         |  conpat
1775         |  MINUS INTEGER                        { $$ = mklit(mkinteger(ineg($2))); }
1776         |  MINUS FLOAT                          { $$ = mklit(mkfloatr(ineg($2))); }
1777         ;
1778
1779 conpat  :  con                                  { $$ = mkident($1); }
1780         |  conpat apat                          { $$ = mkap($1,$2); }
1781         ;
1782
1783 apat    :  con                                  { $$ = mkident($1); }
1784         |  apatc
1785         ;
1786
1787 apatc   :  var                                  { $$ = mkident($1); }
1788         |  var AT apat                          { $$ = mkas($1,$3); }
1789         |  lit_constant                         { $$ = mklit($1); }
1790         |  WILDCARD                             { $$ = mkwildp(); }
1791         |  OPAREN CPAREN                        { $$ = mktuple(Lnil); }
1792         |  OPAREN var PLUS INTEGER CPAREN       { $$ = mkplusp(mkident($2),mkinteger($4)); }
1793 /* GHC no cannae do (WDP 95/05)
1794         |  OPAREN WILDCARD PLUS INTEGER CPAREN  { $$ = mkplusp(mkwildp(),mkinteger($4)); }
1795 */
1796         |  OPAREN pat CPAREN                    { $$ = mkpar($2); }
1797         |  OPAREN pat COMMA pats CPAREN         { $$ = mktuple(mklcons($2,$4)); }
1798         |  OBRACK pats CBRACK                   { $$ = mkllist($2); }
1799         |  OBRACK CBRACK                        { $$ = mkllist(Lnil); }
1800         |  LAZY apat                            { $$ = mklazyp($2); }
1801         ;
1802
1803 lit_constant:
1804            INTEGER                              { $$ = mkinteger($1); }
1805         |  FLOAT                                { $$ = mkfloatr($1); }
1806         |  CHAR                                 { $$ = mkcharr($1); }
1807         |  STRING                               { $$ = mkstring($1); }
1808         |  CHARPRIM                             { $$ = mkcharprim($1); }
1809         |  STRINGPRIM                           { $$ = mkstringprim($1); }
1810         |  INTPRIM                              { $$ = mkintprim($1); }
1811         |  FLOATPRIM                            { $$ = mkfloatprim($1); }
1812         |  DOUBLEPRIM                           { $$ = mkdoubleprim($1); }
1813         |  CLITLIT /* yurble yurble */          { $$ = mkclitlit($1, ""); }
1814         |  CLITLIT KIND_PRAGMA CONID            { $$ = mkclitlit($1, $3); }
1815         |  NOREP_INTEGER  INTEGER               { $$ = mknorepi($2); }
1816         |  NOREP_RATIONAL INTEGER INTEGER       { $$ = mknorepr($2, $3); }
1817         |  NOREP_STRING   STRING                { $$ = mknoreps($2); }
1818         ;
1819
1820
1821 /* Keywords which record the line start */
1822
1823 importkey:  IMPORT      { setstartlineno(); }
1824         ;
1825
1826 datakey :   DATA        { setstartlineno();
1827                           if(etags)
1828 #if 1/*etags*/
1829                             printf("%u\n",startlineno);
1830 #else
1831                             fprintf(stderr,"%u\tdata\n",startlineno);
1832 #endif
1833                         }
1834         ;
1835
1836 typekey :   TYPE        { setstartlineno();
1837                           if(etags)
1838 #if 1/*etags*/
1839                             printf("%u\n",startlineno);
1840 #else
1841                             fprintf(stderr,"%u\ttype\n",startlineno);
1842 #endif
1843                         }
1844         ;
1845
1846 instkey :   INSTANCE    { setstartlineno();
1847 #if 1/*etags*/
1848 /* OUT:                   if(etags)
1849                             printf("%u\n",startlineno);
1850 */
1851 #else
1852                             fprintf(stderr,"%u\tinstance\n",startlineno);
1853 #endif
1854                         }
1855         ;
1856
1857 defaultkey: DEFAULT     { setstartlineno(); }
1858         ;
1859
1860 classkey:   CLASS       { setstartlineno();
1861                           if(etags)
1862 #if 1/*etags*/
1863                             printf("%u\n",startlineno);
1864 #else
1865                             fprintf(stderr,"%u\tclass\n",startlineno);
1866 #endif
1867                         }
1868         ;
1869
1870 minuskey:   MINUS       { setstartlineno(); }
1871         ;
1872
1873 modulekey:  MODULE      { setstartlineno();
1874                           if(etags)
1875 #if 1/*etags*/
1876                             printf("%u\n",startlineno);
1877 #else
1878                             fprintf(stderr,"%u\tmodule\n",startlineno);
1879 #endif
1880                         }
1881         ;
1882
1883 oparenkey:  OPAREN      { setstartlineno(); }
1884         ;
1885
1886 obrackkey:  OBRACK      { setstartlineno(); }
1887         ;
1888
1889 lazykey :   LAZY        { setstartlineno(); }
1890         ;
1891
1892
1893
1894 /* Non "-" op, used in right sections -- KH */
1895 op1     :  conop
1896         |  varop1
1897         ;
1898
1899 op      :  conop
1900         |  varop
1901         ;
1902
1903 varop   :  varsym
1904         |  BQUOTE VARID BQUOTE          { $$ = $2; }
1905         ;
1906
1907 /*      Non-minus varop, used in right sections */
1908 varop1  :  VARSYM
1909         |  plus
1910         |  BQUOTE VARID BQUOTE          { $$ = $2; }
1911         ;
1912
1913 conop   :  CONSYM
1914         |  BQUOTE CONID BQUOTE          { $$ = $2; }
1915         ;
1916
1917 varsym  :  VARSYM
1918         |  plus
1919         |  minus
1920         ;
1921
1922 minus   :  MINUS                        { $$ = install_literal("-"); }
1923         ;
1924
1925 plus    :  PLUS                         { $$ = install_literal("+"); }
1926         ;
1927
1928 var     :  VARID
1929         |  OPAREN varsym CPAREN         { $$ = $2; }
1930         ;
1931
1932 vark    :  VARID                        { setstartlineno(); $$ = $1; }
1933         |  oparenkey varsym CPAREN      { $$ = $2; }
1934         ;
1935
1936 /* tycon used here to eliminate 11 spurious R/R errors -- KH */
1937 con     :  tycon
1938         |  OPAREN CONSYM CPAREN         { $$ = $2; }
1939         ;
1940
1941 conk    :  tycon                        { setstartlineno(); $$ = $1; }
1942         |  oparenkey CONSYM CPAREN      { $$ = $2; }
1943         ;
1944
1945 ccallid :  VARID
1946         |  CONID
1947         ;
1948
1949 /* partain: "atype_list" must be at least 2 elements long (defn of "inst") */
1950 atype_list: atype COMMA atype                   { $$ = mklcons($1,lsing($3)); }
1951         |  atype COMMA atype_list               { $$ = mklcons($1,$3); }
1952         /* right recursion? WDP */
1953         ;
1954
1955 tyvars  :  tyvar                                { $$ = lsing($1); }
1956         |  tyvars tyvar                         { $$ = lapp($1, $2); }
1957         ;
1958
1959 tyvar   :  VARID                                { $$ = mknamedtvar($1); }
1960         ;
1961
1962 tycls   :  tycon
1963                 /* partain: "aconid"->"tycon" got rid of a r/r conflict
1964                     (and introduced >= 2 s/r's ...)
1965                  */
1966         ;
1967
1968 tycon   :  CONID
1969         ;
1970
1971 modid   :  CONID
1972         ;
1973
1974
1975 ocurly  : layout OCURLY                         { hsincindent(); }
1976
1977 vocurly : layout                                { hssetindent(); }
1978         ;
1979
1980 layout  :                                       { hsindentoff(); }
1981         ;
1982
1983 ccurly  :
1984          CCURLY
1985                 {
1986                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1987                   hsendindent();
1988                 }
1989         ;
1990
1991 vccurly :  { expect_ccurly = 1; }  vccurly1  { expect_ccurly = 0; }
1992         ;
1993
1994 vccurly1:
1995          VCCURLY
1996                 {
1997                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1998                   hsendindent();
1999                 }
2000         | error
2001                 {
2002                   yyerrok;
2003                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
2004                   hsendindent();
2005                 }
2006         ;
2007
2008 %%
2009
2010 /**********************************************************************
2011 *                                                                     *
2012 *      Error Processing and Reporting                                 *
2013 *                                                                     *
2014 *  (This stuff is here in case we want to use Yacc macros and such.)  *
2015 *                                                                     *
2016 **********************************************************************/
2017
2018 /* The parser calls "hsperror" when it sees a
2019    `report this and die' error.  It sets the stage
2020    and calls "yyerror".
2021
2022    There should be no direct calls in the parser to
2023    "yyerror", except for the one from "hsperror".  Thus,
2024    the only other calls will be from the error productions
2025    introduced by yacc/bison/whatever.
2026
2027    We need to be able to recognise the from-error-production
2028    case, because we sometimes want to say, "Oh, never mind",
2029    because the layout rule kicks into action and may save
2030    the day.  [WDP]
2031 */
2032
2033 static BOOLEAN error_and_I_mean_it = FALSE;
2034
2035 void
2036 hsperror(s)
2037   char *s;
2038 {
2039     error_and_I_mean_it = TRUE;
2040     yyerror(s);
2041 }
2042
2043 extern char *yytext;
2044 extern int yyleng;
2045
2046 void
2047 yyerror(s)
2048   char *s;
2049 {
2050     /* We want to be able to distinguish 'error'-raised yyerrors
2051        from yyerrors explicitly coded by the parser hacker.
2052     */
2053     if (expect_ccurly && ! error_and_I_mean_it ) {
2054         /*NOTHING*/;
2055
2056     } else {
2057         fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
2058           input_filename, hsplineno, hspcolno + 1, s);
2059
2060         if (yyleng == 1 && *yytext == '\0')
2061             fprintf(stderr, "<EOF>");
2062
2063         else {
2064             fputc('"', stderr);
2065             format_string(stderr, (unsigned char *) yytext, yyleng);
2066             fputc('"', stderr);
2067         }
2068         fputc('\n', stderr);
2069
2070         /* a common problem */
2071         if (strcmp(yytext, "#") == 0)
2072             fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
2073
2074         exit(1);
2075     }
2076 }
2077
2078 void
2079 format_string(fp, s, len)
2080   FILE *fp;
2081   unsigned char *s;
2082   int len;
2083 {
2084     while (len-- > 0) {
2085         switch (*s) {
2086         case '\0':    fputs("\\NUL", fp);   break;
2087         case '\007':  fputs("\\a", fp);     break;
2088         case '\010':  fputs("\\b", fp);     break;
2089         case '\011':  fputs("\\t", fp);     break;
2090         case '\012':  fputs("\\n", fp);     break;
2091         case '\013':  fputs("\\v", fp);     break;
2092         case '\014':  fputs("\\f", fp);     break;
2093         case '\015':  fputs("\\r", fp);     break;
2094         case '\033':  fputs("\\ESC", fp);   break;
2095         case '\034':  fputs("\\FS", fp);    break;
2096         case '\035':  fputs("\\GS", fp);    break;
2097         case '\036':  fputs("\\RS", fp);    break;
2098         case '\037':  fputs("\\US", fp);    break;
2099         case '\177':  fputs("\\DEL", fp);   break;
2100         default:
2101             if (*s >= ' ')
2102                 fputc(*s, fp);
2103             else
2104                 fprintf(fp, "\\^%c", *s + '@');
2105             break;
2106         }
2107         s++;
2108     }
2109 }