ghc/compiler/parser/hsparser.y

   1 /**************************************************************************
   2 *   File:               hsparser.y                                        *
   3 *                                                                         *
   4 *                       Author:                 Maria M. Gutierrez        *
   5 *                       Modified by:            Kevin Hammond             *
   6 *                       Last date revised:      December 13 1991. KH.     *
   7 *                       Modification:           Haskell 1.1 Syntax.       *
   8 *                                                                         *
   9 *                                                                         *
  10 *   Description:  This file contains the LALR(1) grammar for Haskell.     *
  11 *                                                                         *
  12 *   Entry Point:  module                                                  *
  13 *                                                                         *
  14 *   Problems:     None known.                                             *
  15 *                                                                         *
  16 *                                                                         *
  17 *                 LALR(1) Syntax for Haskell 1.2                          *
  18 *                                                                         *
  19 **************************************************************************/
  20
  21
  22 %{
  23 #ifdef HSP_DEBUG
  24 # define YYDEBUG 1
  25 #endif
  26
  27 #include <stdio.h>
  28 #include <ctype.h>
  29 #include <string.h>
  30 #include "hspincl.h"
  31 #include "constants.h"
  32 #include "utils.h"
  33
  34 /**********************************************************************
  35 *                                                                     *
  36 *                                                                     *
  37 *     Imported Variables and Functions                                *
  38 *                                                                     *
  39 *                                                                     *
  40 **********************************************************************/
  41
  42 static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
  43 extern BOOLEAN etags;
  44
  45 extern char *input_filename;
  46 static char *the_module_name;
  47 static maybe module_exports;
  48
  49 extern list Lnil;
  50 extern tree root;
  51
  52 /* For FN, PREVPATT and SAMEFN macros */
  53 extern qid      fns[];
  54 extern BOOLEAN  samefn[];
  55 extern tree     prevpatt[];
  56 extern short    icontexts;
  57
  58 /* Line Numbers */
  59 extern int hsplineno, hspcolno;
  60 extern int modulelineno;
  61 extern int startlineno;
  62 extern int endlineno;
  63
  64 /**********************************************************************
  65 *                                                                     *
  66 *                                                                     *
  67 *      Fixity and Precedence Declarations                             *
  68 *                                                                     *
  69 *                                                                     *
  70 **********************************************************************/
  71
  72 static int Fixity = 0, Precedence = 0;
  73
  74 char *ineg PROTO((char *));
  75
  76 long    source_version = 0;
  77
  78 BOOLEAN inpat;
  79 %}
  80
  81 %union {
  82         tree utree;
  83         list ulist;
  84         ttype uttype;
  85         constr uconstr;
  86         binding ubinding;
  87         pbinding upbinding;
  88         entidt uentid;
  89         id uid;
  90         qid uqid;
  91         literal uliteral;
  92         maybe umaybe;
  93         either ueither;
  94         long ulong;
  95         float ufloat;
  96         char *ustring;
  97         hstring uhstring;
  98 }
  99
 100
 101 /**********************************************************************
 102 *                                                                     *
 103 *                                                                     *
 104 *     These are lexemes.                                              *
 105 *                                                                     *
 106 *                                                                     *
 107 **********************************************************************/
 108
 109
 110 %token  VARID           CONID           QVARID          QCONID
 111         VARSYM          CONSYM          QVARSYM         QCONSYM
 112
 113 %token  INTEGER         FLOAT           CHAR            STRING
 114         CHARPRIM        STRINGPRIM      INTPRIM         FLOATPRIM
 115         DOUBLEPRIM      CLITLIT
 116
 117
 118
 119 /**********************************************************************
 120 *                                                                     *
 121 *                                                                     *
 122 *      Special Symbols                                                *
 123 *                                                                     *
 124 *                                                                     *
 125 **********************************************************************/
 126
 127 %token  OCURLY          CCURLY          VCCURLY         SEMI
 128 %token  OBRACK          CBRACK          OPAREN          CPAREN
 129 %token  COMMA           BQUOTE
 130
 131
 132 /**********************************************************************
 133 *                                                                     *
 134 *                                                                     *
 135 *     Reserved Operators                                              *
 136 *                                                                     *
 137 *                                                                     *
 138 **********************************************************************/
 139
 140 %token  DOTDOT          DCOLON          EQUAL
 141 %token  LAMBDA          VBAR            RARROW
 142 %token  LARROW          MINUS
 143
 144
 145 /**********************************************************************
 146 *                                                                     *
 147 *                                                                     *
 148 *     Reserved Identifiers                                            *
 149 *                                                                     *
 150 *                                                                     *
 151 **********************************************************************/
 152
 153 %token  CASE            CLASS           DATA
 154 %token  DEFAULT         DERIVING        DO
 155 %token  ELSE            IF              IMPORT
 156 %token  IN              INFIX           INFIXL
 157 %token  INFIXR          INSTANCE        LET
 158 %token  MODULE          NEWTYPE         OF
 159 %token  THEN            TYPE            WHERE
 160
 161 %token  SCC
 162 %token  CCALL           CCALL_GC        CASM            CASM_GC
 163
 164
 165 /**********************************************************************
 166 *                                                                     *
 167 *                                                                     *
 168 *     Valid symbols/identifiers which need to be recognised           *
 169 *                                                                     *
 170 *                                                                     *
 171 **********************************************************************/
 172
 173 %token  WILDCARD        AT              LAZY            BANG
 174 %token  AS              HIDING          QUALIFIED
 175
 176
 177 /**********************************************************************
 178 *                                                                     *
 179 *                                                                     *
 180 *     Special Symbols for the Lexer                                   *
 181 *                                                                     *
 182 *                                                                     *
 183 **********************************************************************/
 184
 185 %token  INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
 186 %token  INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
 187 %token  DEFOREST_UPRAGMA END_UPRAGMA
 188
 189 /**********************************************************************
 190 *                                                                     *
 191 *                                                                     *
 192 *     Precedences of the various tokens                               *
 193 *                                                                     *
 194 *                                                                     *
 195 **********************************************************************/
 196
 197
 198 %left   CASE    LET     IN
 199         IF      ELSE    LAMBDA
 200         SCC     CASM    CCALL   CASM_GC CCALL_GC
 201
 202 %left   VARSYM  CONSYM  QVARSYM QCONSYM
 203         MINUS   BQUOTE  BANG    DARROW
 204
 205 %left   DCOLON
 206
 207 %left   SEMI    COMMA
 208
 209 %left   OCURLY  OBRACK  OPAREN
 210
 211 %left   EQUAL
 212
 213 %right  RARROW
 214
 215 /**********************************************************************
 216 *                                                                     *
 217 *                                                                     *
 218 *      Type Declarations                                              *
 219 *                                                                     *
 220 *                                                                     *
 221 **********************************************************************/
 222
 223
 224 %type <ulist>   caserest alts alt quals
 225                 dorest stmts stmt
 226                 rbinds rpats list_exps
 227                 qvarsk qvars_list
 228                 constrs constr1 fields
 229                 types atypes batypes
 230                 types_and_maybe_ids
 231                 pats context context_list tyvar_list
 232                 export_list enames
 233                 import_list inames
 234                 impdecls maybeimpdecls impdecl
 235                 maybefixes fixes fix ops
 236                 dtyclses dtycls_list
 237                 gdrhs gdpat valrhs
 238                 lampats cexps
 239
 240 %type <umaybe>  maybeexports impspec deriving
 241
 242 %type <uliteral> lit_constant
 243
 244 %type <utree>   exp oexp dexp kexp fexp aexp rbind texps
 245                 expL oexpL kexpL expLno oexpLno dexpLno kexpLno
 246                 vallhs funlhs qual gd leftexp
 247                 pat bpat apat apatc conpat rpat
 248                 patk bpatk apatck conpatk
 249
 250
 251 %type <uid>     MINUS DARROW AS LAZY
 252                 VARID CONID VARSYM CONSYM
 253                 var con varop conop op
 254                 vark varid varsym varsym_nominus
 255                 tycon modid ccallid
 256
 257 %type <uqid>    QVARID QCONID QVARSYM QCONSYM
 258                 qvarid qconid qvarsym qconsym
 259                 qvar qcon qvarop qconop qop
 260                 qvark qconk qtycon qtycls
 261                 gcon gconk gtycon qop1 qvarop1
 262                 ename iname
 263
 264 %type <ubinding>  topdecl topdecls letdecls
 265                   typed datad newtd classd instd defaultd
 266                   decl decls valdef instdef instdefs
 267                   maybe_where cbody rinst type_and_maybe_id
 268
 269 %type <upbinding> valrhs1 altrest
 270
 271 %type <uttype>    simple ctype type atype btype
 272                   gtyconapp ntyconapp ntycon gtyconvars
 273                   bbtype batype btyconapp
 274                   class restrict_inst general_inst tyvar
 275
 276 %type <uconstr>   constr field
 277
 278 %type <ustring>   FLOAT INTEGER INTPRIM
 279                   FLOATPRIM DOUBLEPRIM CLITLIT
 280
 281 %type <uhstring>  STRING STRINGPRIM CHAR CHARPRIM
 282
 283 %type <uentid>    export import
 284
 285 %type <ulong>     commas
 286
 287 /**********************************************************************
 288 *                                                                     *
 289 *                                                                     *
 290 *      Start Symbol for the Parser                                    *
 291 *                                                                     *
 292 *                                                                     *
 293 **********************************************************************/
 294
 295 %start module
 296
 297 %%
 298 module  :  modulekey modid maybeexports
 299                 {
 300                   modulelineno = startlineno;
 301                   the_module_name = $2;
 302                   module_exports = $3;
 303                 }
 304            WHERE body
 305         |       {
 306                   modulelineno = 0;
 307                   the_module_name = install_literal("Main");
 308                   module_exports = mknothing();
 309                 }
 310            body
 311         ;
 312
 313 body    :  ocurly { setstartlineno(); } interface_pragma orestm
 314         |  vocurly interface_pragma vrestm
 315         ;
 316
 317 interface_pragma : /* empty */
 318         | INTERFACE_UPRAGMA INTEGER END_UPRAGMA SEMI
 319                {
 320                  source_version = atoi($2);
 321                }
 322         ;
 323
 324 orestm  :  maybeimpdecls maybefixes topdecls ccurly
 325                {
 326                  root = mkhmodule(the_module_name,$1,module_exports,
 327                                   $2,$3,source_version,modulelineno);
 328                }
 329         |  impdecls ccurly
 330                {
 331                  root = mkhmodule(the_module_name,$1,module_exports,
 332                                   Lnil,mknullbind(),source_version,modulelineno);
 333                }
 334
 335 vrestm  :  maybeimpdecls maybefixes topdecls vccurly
 336                {
 337                  root = mkhmodule(the_module_name,$1,module_exports,
 338                                   $2,$3,source_version,modulelineno);
 339                }
 340         |  impdecls vccurly
 341                {
 342                  root = mkhmodule(the_module_name,$1,module_exports,
 343                                   Lnil,mknullbind(),source_version,modulelineno);
 344                }
 345
 346 maybeexports :  /* empty */                     { $$ = mknothing(); }
 347         |  OPAREN export_list CPAREN            { $$ = mkjust($2); }
 348         |  OPAREN export_list COMMA CPAREN      { $$ = mkjust($2); }
 349         ;
 350
 351 export_list:
 352            export                               { $$ = lsing($1); }
 353         |  export_list COMMA export             { $$ = lapp($1, $3); }
 354         ;
 355
 356 export  :  qvar                                 { $$ = mkentid($1); }
 357         |  gtycon                               { $$ = mkenttype($1); }
 358         |  gtycon OPAREN DOTDOT CPAREN          { $$ = mkenttypeall($1); }
 359         |  gtycon OPAREN CPAREN                 { $$ = mkenttypenamed($1,Lnil); }
 360         |  gtycon OPAREN enames CPAREN          { $$ = mkenttypenamed($1,$3); }
 361         |  MODULE modid                         { $$ = mkentmod($2); }
 362         ;
 363
 364 enames  :  ename                                { $$ = lsing($1); }
 365         |  enames COMMA ename                   { $$ = lapp($1,$3); }
 366         ;
 367 ename   :  qvar
 368         |  qcon
 369         ;
 370
 371
 372 maybeimpdecls : /* empty */                     { $$ = Lnil; }
 373         |  impdecls SEMI                        { $$ = $1; }
 374         ;
 375
 376 impdecls:  impdecl                              { $$ = $1; }
 377         |  impdecls SEMI impdecl                { $$ = lconc($1,$3); }
 378         ;
 379
 380
 381 impdecl :  importkey modid impspec
 382                 { $$ = lsing(mkimport($2,0,mknothing(),$3,startlineno)); }
 383         |  importkey QUALIFIED modid impspec
 384                 { $$ = lsing(mkimport($3,1,mknothing(),$4,startlineno)); }
 385         |  importkey QUALIFIED modid AS modid impspec
 386                 { $$ = lsing(mkimport($3,1,mkjust($5),$6,startlineno)); }
 387         ;
 388
 389 impspec :  /* empty */                            { $$ = mknothing(); }
 390         |  OPAREN CPAREN                          { $$ = mkjust(mkleft(Lnil)); }
 391         |  OPAREN import_list CPAREN              { $$ = mkjust(mkleft($2));   }
 392         |  OPAREN import_list COMMA CPAREN        { $$ = mkjust(mkleft($2));   }
 393         |  HIDING OPAREN import_list CPAREN       { $$ = mkjust(mkright($3));  }
 394         |  HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3));  }
 395         ;
 396
 397 import_list:
 398            import                               { $$ = lsing($1); }
 399         |  import_list COMMA import             { $$ = lapp($1, $3); }
 400         ;
 401
 402 import  :  var                                  { $$ = mkentid(mknoqual($1)); }
 403         |  tycon                                { $$ = mkenttype(mknoqual($1)); }
 404         |  tycon OPAREN DOTDOT CPAREN           { $$ = mkenttypeall(mknoqual($1)); }
 405         |  tycon OPAREN CPAREN                  { $$ = mkenttypenamed(mknoqual($1),Lnil); }
 406         |  tycon OPAREN inames CPAREN           { $$ = mkenttypenamed(mknoqual($1),$3); }
 407         ;
 408
 409 inames  :  iname                                { $$ = lsing($1); }
 410         |  inames COMMA iname                   { $$ = lapp($1,$3); }
 411         ;
 412 iname   :  var                                  { $$ = mknoqual($1); }
 413         |  con                                  { $$ = mknoqual($1); }
 414         ;
 415
 416 /**********************************************************************
 417 *                                                                     *
 418 *                                                                     *
 419 *     Fixes and Decls etc                                             *
 420 *                                                                     *
 421 *                                                                     *
 422 **********************************************************************/
 423
 424 maybefixes:  /* empty */                { $$ = Lnil; }
 425         |  fixes SEMI                   { $$ = $1; }
 426         ;
 427
 428 fixes   :  fix                          { $$ = $1; }
 429         |  fixes SEMI fix               { $$ = lconc($1,$3); }
 430         ;
 431
 432 fix     :  INFIXL INTEGER       { Precedence = checkfixity($2); Fixity = INFIXL; }
 433            ops                  { $$ = $4; }
 434         |  INFIXR INTEGER       { Precedence = checkfixity($2); Fixity = INFIXR; }
 435            ops                  { $$ = $4; }
 436         |  INFIX  INTEGER       { Precedence = checkfixity($2); Fixity = INFIX; }
 437            ops                  { $$ = $4; }
 438         |  INFIXL               { Fixity = INFIXL; Precedence = 9; }
 439            ops                  { $$ = $3; }
 440         |  INFIXR               { Fixity = INFIXR; Precedence = 9; }
 441            ops                  { $$ = $3; }
 442         |  INFIX                { Fixity = INFIX; Precedence = 9; }
 443            ops                  { $$ = $3; }
 444         ;
 445
 446 ops     :  op            { $$ = lsing(mkfixop(mknoqual($1),infixint(Fixity),Precedence)); }
 447         |  ops COMMA op  { $$ = lapp($1,mkfixop(mknoqual($3),infixint(Fixity),Precedence)); }
 448         ;
 449
 450 topdecls:  topdecl
 451         |  topdecls SEMI topdecl
 452                 {
 453                   if($1 != NULL)
 454                     if($3 != NULL)
 455                       if(SAMEFN)
 456                         {
 457                           extendfn($1,$3);
 458                           $$ = $1;
 459                         }
 460                       else
 461                         $$ = mkabind($1,$3);
 462                     else
 463                       $$ = $1;
 464                   else
 465                     $$ = $3;
 466                   SAMEFN = 0;
 467                 }
 468         ;
 469
 470 topdecl :  typed                                { $$ = $1; }
 471         |  datad                                { $$ = $1; }
 472         |  newtd                                { $$ = $1; }
 473         |  classd                               { $$ = $1; }
 474         |  instd                                { $$ = $1; }
 475         |  defaultd                             { $$ = $1; }
 476         |  decl                                 { $$ = $1; }
 477         ;
 478
 479 typed   :  typekey simple EQUAL type            { $$ = mknbind($2,$4,startlineno); }
 480         ;
 481
 482
 483 datad   :  datakey simple EQUAL constrs deriving
 484                 { $$ = mktbind(Lnil,$2,$4,$5,startlineno); }
 485         |  datakey context DARROW simple EQUAL constrs deriving
 486                 { $$ = mktbind($2,$4,$6,$7,startlineno); }
 487         ;
 488
 489 newtd   :  newtypekey simple EQUAL constr1 deriving
 490                 { $$ = mkntbind(Lnil,$2,$4,$5,startlineno); }
 491         |  newtypekey context DARROW simple EQUAL constr1 deriving
 492                 { $$ = mkntbind($2,$4,$6,$7,startlineno); }
 493         ;
 494
 495 deriving: /* empty */                           { $$ = mknothing(); }
 496         | DERIVING dtyclses                     { $$ = mkjust($2); }
 497         ;
 498
 499 classd  :  classkey context DARROW class cbody
 500                 { $$ = mkcbind($2,$4,$5,startlineno); }
 501         |  classkey class cbody
 502                 { $$ = mkcbind(Lnil,$2,$3,startlineno); }
 503         ;
 504
 505 cbody   :  /* empty */                          { $$ = mknullbind(); }
 506         |  WHERE ocurly decls ccurly            { checkorder($3); $$ = $3; }
 507         |  WHERE vocurly decls vccurly          { checkorder($3); $$ = $3; }
 508         ;
 509
 510 instd   :  instkey context DARROW gtycon restrict_inst rinst
 511                 { $$ = mkibind($2,$4,$5,$6,startlineno); }
 512         |  instkey gtycon general_inst rinst
 513                 { $$ = mkibind(Lnil,$2,$3,$4,startlineno); }
 514         ;
 515
 516 rinst   :  /* empty */                                          { $$ = mknullbind(); }
 517         |  WHERE ocurly  instdefs ccurly                        { $$ = $3; }
 518         |  WHERE vocurly instdefs vccurly                       { $$ = $3; }
 519         ;
 520
 521 restrict_inst : gtycon                          { $$ = mktname($1); }
 522         |  OPAREN gtyconvars CPAREN             { $$ = $2; }
 523         |  OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
 524         |  OBRACK tyvar CBRACK                  { $$ = mktllist($2); }
 525         |  OPAREN tyvar RARROW tyvar CPAREN     { $$ = mktfun($2,$4); }
 526         ;
 527
 528 general_inst : gtycon                           { $$ = mktname($1); }
 529         |  OPAREN gtyconapp CPAREN              { $$ = $2; }
 530         |  OPAREN type COMMA types CPAREN       { $$ = mkttuple(mklcons($2,$4)); }
 531         |  OBRACK type CBRACK                   { $$ = mktllist($2); }
 532         |  OPAREN btype RARROW type CPAREN      { $$ = mktfun($2,$4); }
 533         ;
 534
 535 defaultd:  defaultkey OPAREN types CPAREN       { $$ = mkdbind($3,startlineno); }
 536         |  defaultkey OPAREN CPAREN             { $$ = mkdbind(Lnil,startlineno); }
 537         ;
 538
 539 decls   : decl
 540         | decls SEMI decl
 541                 {
 542                   if(SAMEFN)
 543                     {
 544                       extendfn($1,$3);
 545                       $$ = $1;
 546                     }
 547                   else
 548                     $$ = mkabind($1,$3);
 549                 }
 550         ;
 551
 552 /*
 553     Note: if there is an iclasop_pragma here, then we must be
 554     doing a class-op in an interface -- unless the user is up
 555     to real mischief (ugly, but likely to work).
 556 */
 557
 558 decl    : qvarsk DCOLON ctype
 559                 { $$ = mksbind($1,$3,startlineno);
 560                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 561                 }
 562
 563         /* User-specified pragmas come in as "signatures"...
 564            They are similar in that they can appear anywhere in the module,
 565            and have to be "joined up" with their related entity.
 566
 567            Have left out the case specialising to an overloaded type.
 568            Let's get real, OK?  (WDP)
 569         */
 570         |  SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
 571                 {
 572                   $$ = mkvspec_uprag($2, $4, startlineno);
 573                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 574                 }
 575
 576         |  SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA
 577                 {
 578                   $$ = mkispec_uprag($3, $4, startlineno);
 579                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 580                 }
 581
 582         |  SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
 583                 {
 584                   $$ = mkdspec_uprag($3, $4, startlineno);
 585                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 586                 }
 587
 588         |  INLINE_UPRAGMA qvark END_UPRAGMA
 589                 {
 590                   $$ = mkinline_uprag($2, startlineno);
 591                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 592                 }
 593
 594         |  MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
 595                 {
 596                   $$ = mkmagicuf_uprag($2, $3, startlineno);
 597                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 598                 }
 599
 600         |  DEFOREST_UPRAGMA qvark END_UPRAGMA
 601                 {
 602                   $$ = mkdeforest_uprag($2, startlineno);
 603                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 604                 }
 605
 606         /* end of user-specified pragmas */
 607
 608         |  valdef
 609         |  /* empty */ { $$ = mknullbind(); PREVPATT = NULL; FN = NULL; SAMEFN = 0; }
 610         ;
 611
 612 qvarsk  :  qvark COMMA qvars_list               { $$ = mklcons($1,$3); }
 613         |  qvark                                { $$ = lsing($1); }
 614         ;
 615
 616 qvars_list: qvar                                { $$ = lsing($1); }
 617         |   qvars_list COMMA qvar               { $$ = lapp($1,$3); }
 618         ;
 619
 620 types_and_maybe_ids :
 621            type_and_maybe_id                            { $$ = lsing($1); }
 622         |  types_and_maybe_ids COMMA type_and_maybe_id  { $$ = lapp($1,$3); }
 623         ;
 624
 625 type_and_maybe_id :
 626            type                                 { $$ = mkvspec_ty_and_id($1,mknothing()); }
 627         |  type EQUAL qvark                     { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
 628
 629
 630 /**********************************************************************
 631 *                                                                     *
 632 *                                                                     *
 633 *     Types etc                                                       *
 634 *                                                                     *
 635 *                                                                     *
 636 **********************************************************************/
 637
 638 /*  "DCOLON context => type" vs "DCOLON type" is a problem,
 639     because you can't distinguish between
 640
 641         foo :: (Baz a, Baz a)
 642         bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
 643
 644     with one token of lookahead.  The HACK is to have "DCOLON ttype"
 645     [tuple type] in the first case, then check that it has the right
 646     form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
 647     context.  Blaach!
 648 */
 649
 650         /* 1 S/R conflict at DARROW -> shift */
 651 ctype   : type DARROW type                      { $$ = mkcontext(type2context($1),$3); }
 652         | type
 653         ;
 654
 655         /* 1 S/R conflict at RARROW -> shift */
 656 type    :  btype                                { $$ = $1; }
 657         |  btype RARROW type                    { $$ = mktfun($1,$3); }
 658         ;
 659
 660 /* btype is split so we can parse gtyconapp without S/R conflicts */
 661 btype   :  gtyconapp                            { $$ = $1; }
 662         |  ntyconapp                            { $$ = $1; }
 663         ;
 664
 665 ntyconapp: ntycon                               { $$ = $1; }
 666         |  ntyconapp atype                      { $$ = mktapp($1,$2); }
 667         ;
 668
 669 gtyconapp: gtycon                               { $$ = mktname($1); }
 670         |  gtyconapp atype                      { $$ = mktapp($1,$2); }
 671         ;
 672
 673
 674 atype   :  gtycon                               { $$ = mktname($1); }
 675         |  ntycon                               { $$ = $1; }
 676         ;
 677
 678 ntycon  :  tyvar                                { $$ = $1; }
 679         |  OPAREN type COMMA types CPAREN       { $$ = mkttuple(mklcons($2,$4)); }
 680         |  OBRACK type CBRACK                   { $$ = mktllist($2); }
 681         |  OPAREN type CPAREN                   { $$ = $2; }
 682         ;
 683
 684 gtycon  :  qtycon
 685         |  OPAREN RARROW CPAREN                 { $$ = creategid(-2); }
 686         |  OBRACK CBRACK                        { $$ = creategid(-1); }
 687         |  OPAREN CPAREN                        { $$ = creategid(0); }
 688         |  OPAREN commas CPAREN                 { $$ = creategid($2); }
 689         ;
 690
 691 atypes  :  atype                                { $$ = lsing($1); }
 692         |  atypes atype                         { $$ = lapp($1,$2); }
 693         ;
 694
 695 types   :  type                                 { $$ = lsing($1); }
 696         |  types COMMA type                     { $$ = lapp($1,$3); }
 697         ;
 698
 699 commas  : COMMA                                 { $$ = 1; }
 700         | commas COMMA                          { $$ = $1 + 1; }
 701         ;
 702
 703 /**********************************************************************
 704 *                                                                     *
 705 *                                                                     *
 706 *     Declaration stuff                                               *
 707 *                                                                     *
 708 *                                                                     *
 709 **********************************************************************/
 710
 711 simple  :  gtycon                               { $$ = mktname($1); }
 712         |  gtyconvars                           { $$ = $1; }
 713         ;
 714
 715 gtyconvars: gtycon tyvar                        { $$ = mktapp(mktname($1),$2); }
 716         |  gtyconvars tyvar                     { $$ = mktapp($1,$2); }
 717         ;
 718
 719 context :  OPAREN context_list CPAREN           { $$ = $2; }
 720         |  class                                { $$ = lsing($1); }
 721         ;
 722
 723 context_list:  class                            { $$ = lsing($1); }
 724         |  context_list COMMA class             { $$ = lapp($1,$3); }
 725         ;
 726
 727 class   :  gtycon tyvar                         { $$ = mktapp(mktname($1),$2); }
 728         ;
 729
 730 constrs :  constr                               { $$ = lsing($1); }
 731         |  constrs VBAR constr                  { $$ = lapp($1,$3); }
 732         ;
 733
 734 constr  :  btyconapp                            { qid tyc; list tys;
 735                                                   splittyconapp($1, &tyc, &tys);
 736                                                   $$ = mkconstrpre(tyc,tys,hsplineno); }
 737         |  OPAREN qconsym CPAREN                { $$ = mkconstrpre($2,Lnil,hsplineno); }
 738         |  OPAREN qconsym CPAREN batypes        { $$ = mkconstrpre($2,$4,hsplineno); }
 739         |  btyconapp qconop bbtype              { checknobangs($1);
 740                                                   $$ = mkconstrinf($1,$2,$3,hsplineno); }
 741         |  ntyconapp qconop bbtype              { $$ = mkconstrinf($1,$2,$3,hsplineno); }
 742         |  BANG atype qconop bbtype             { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
 743
 744         /* 1 S/R conflict on OCURLY -> shift */
 745         |  gtycon OCURLY fields CCURLY          { $$ = mkconstrrec($1,$3,hsplineno); }
 746         ;
 747
 748 btyconapp: gtycon                               { $$ = mktname($1); }
 749         |  btyconapp batype                     { $$ = mktapp($1,$2); }
 750         ;
 751
 752 bbtype  :  btype                                { $$ = $1; }
 753         |  BANG atype                           { $$ = mktbang($2); }
 754         ;
 755
 756 batype  :  atype                                { $$ = $1; }
 757         |  BANG atype                           { $$ = mktbang($2); }
 758         ;
 759
 760 batypes :  batype                               { $$ = lsing($1); }
 761         |  batypes batype                       { $$ = lapp($1,$2); }
 762         ;
 763
 764
 765 fields  : field                                 { $$ = lsing($1); }
 766         | fields COMMA field                    { $$ = lapp($1,$3); }
 767         ;
 768
 769 field   :  qvars_list DCOLON type               { $$ = mkfield($1,$3); }
 770         |  qvars_list DCOLON BANG atype         { $$ = mkfield($1,mktbang($4)); }
 771         ;
 772
 773 constr1 :  gtycon atype                         { $$ = lsing(mkconstrnew($1,$2,hsplineno)); }
 774         ;
 775
 776
 777 dtyclses:  OPAREN dtycls_list CPAREN            { $$ = $2; }
 778         |  OPAREN CPAREN                        { $$ = Lnil; }
 779         |  qtycls                               { $$ = lsing($1); }
 780         ;
 781
 782 dtycls_list:  qtycls                            { $$ = lsing($1); }
 783         |  dtycls_list COMMA qtycls             { $$ = lapp($1,$3); }
 784         ;
 785
 786 instdefs : /* empty */                          { $$ = mknullbind(); }
 787          | instdef                              { $$ = $1; }
 788          | instdefs SEMI instdef
 789                 {
 790                   if(SAMEFN)
 791                     {
 792                       extendfn($1,$3);
 793                       $$ = $1;
 794                     }
 795                   else
 796                     $$ = mkabind($1,$3);
 797                 }
 798         ;
 799
 800 /* instdef: same as valdef, except certain user-pragmas may appear */
 801 instdef :
 802            SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
 803                 {
 804                   $$ = mkvspec_uprag($2, $4, startlineno);
 805                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 806                 }
 807
 808         |  INLINE_UPRAGMA qvark END_UPRAGMA
 809                 {
 810                   $$ = mkinline_uprag($2, startlineno);
 811                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 812                 }
 813
 814         |  MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
 815                 {
 816                   $$ = mkmagicuf_uprag($2, $3, startlineno);
 817                   PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 818                 }
 819
 820         |  valdef
 821         ;
 822
 823
 824 valdef  :  vallhs
 825                 {
 826                   tree fn = function($1);
 827                   PREVPATT = $1;
 828
 829                   if(ttree(fn) == ident)
 830                     {
 831                       qid fun_id = gident((struct Sident *) fn);
 832                       checksamefn(fun_id);
 833                       FN = fun_id;
 834                     }
 835
 836                   else if (ttree(fn) == infixap)
 837                     {
 838                       qid fun_id = ginffun((struct Sinfixap *) fn);
 839                       checksamefn(fun_id);
 840                       FN = fun_id;
 841                     }
 842
 843                   else if(etags)
 844 #if 1/*etags*/
 845                     printf("%u\n",startlineno);
 846 #else
 847                     fprintf(stderr,"%u\tvaldef\n",startlineno);
 848 #endif
 849                 }
 850            valrhs
 851                 {
 852                   if ( lhs_is_patt($1) )
 853                     {
 854                       $$ = mkpbind($3, startlineno);
 855                       FN = NULL;
 856                       SAMEFN = 0;
 857                     }
 858                   else
 859                     $$ = mkfbind($3,startlineno);
 860
 861                   PREVPATT = NULL;
 862                 }
 863         ;
 864
 865 vallhs  : patk                                  { $$ = $1; }
 866         | patk qvarop pat                       { $$ = mkinfixap($2,$1,$3); }
 867         | funlhs                                { $$ = $1; }
 868         ;
 869
 870 funlhs  :  qvark apat                           { $$ = mkap(mkident($1),$2); }
 871         |  funlhs apat                          { $$ = mkap($1,$2); }
 872         ;
 873
 874
 875 valrhs  :  valrhs1 maybe_where                  { $$ = lsing(createpat($1, $2)); }
 876         ;
 877
 878 valrhs1 :  gdrhs                                { $$ = mkpguards($1); }
 879         |  EQUAL exp                            { $$ = mkpnoguards($2); }
 880         ;
 881
 882 gdrhs   :  gd EQUAL exp                         { $$ = lsing(mkpgdexp($1,$3)); }
 883         |  gd EQUAL exp gdrhs                   { $$ = mklcons(mkpgdexp($1,$3),$4); }
 884         ;
 885
 886 maybe_where:
 887            WHERE ocurly decls ccurly            { $$ = $3; }
 888         |  WHERE vocurly decls vccurly          { $$ = $3; }
 889         |  /* empty */                          { $$ = mknullbind(); }
 890         ;
 891
 892 gd      :  VBAR oexp                            { $$ = $2; }
 893         ;
 894
 895
 896 /**********************************************************************
 897 *                                                                     *
 898 *                                                                     *
 899 *     Expressions                                                     *
 900 *                                                                     *
 901 *                                                                     *
 902 **********************************************************************/
 903
 904 exp     :  oexp DCOLON ctype                    { $$ = mkrestr($1,$3); }
 905         |  oexp
 906         ;
 907
 908 /*
 909   Operators must be left-associative at the same precedence for
 910   precedence parsing to work.
 911 */
 912         /* 9 S/R conflicts on qop -> shift */
 913 oexp    :  oexp qop oexp %prec MINUS            { $$ = mkinfixap($2,$1,$3); }
 914         |  dexp
 915         ;
 916
 917 /*
 918   This comes here because of the funny precedence rules concerning
 919   prefix minus.
 920 */
 921 dexp    :  MINUS kexp                           { $$ = mknegate($2); }
 922         |  kexp
 923         ;
 924
 925 /*
 926   We need to factor out a leading let expression so we can set
 927   inpat=TRUE when parsing (non let) expressions inside stmts and quals
 928 */
 929 expLno  :  oexpLno DCOLON ctype                 { $$ = mkrestr($1,$3); }
 930         |  oexpLno
 931         ;
 932 oexpLno :  oexpLno qop oexp %prec MINUS         { $$ = mkinfixap($2,$1,$3); }
 933         |  dexpLno
 934         ;
 935 dexpLno :  MINUS kexp                           { $$ = mknegate($2); }
 936         |  kexpLno
 937         ;
 938
 939 expL    :  oexpL DCOLON ctype                   { $$ = mkrestr($1,$3); }
 940         |  oexpL
 941         ;
 942 oexpL   :  oexpL qop oexp %prec MINUS           { $$ = mkinfixap($2,$1,$3); }
 943         |  kexpL
 944         ;
 945
 946 /*
 947   let/if/lambda/case have higher precedence than infix operators.
 948 */
 949
 950 kexp    :  kexpL
 951         |  kexpLno
 952         ;
 953
 954 kexpL   :  letdecls IN exp                      { $$ = mklet($1,$3); }
 955         ;
 956
 957 kexpLno :  LAMBDA
 958                 { hsincindent();        /* push new context for FN = NULL;        */
 959                   FN = NULL;            /* not actually concerned about indenting */
 960                   $<ulong>$ = hsplineno; /* remember current line number           */
 961                 }
 962            lampats
 963                 { hsendindent();
 964                 }
 965            RARROW exp                   /* lambda abstraction */
 966                 {
 967                   $$ = mklambda($3, $6, $<ulong>2);
 968                 }
 969
 970         /* If Expression */
 971         |  IF {$<ulong>$ = hsplineno;}
 972            exp THEN exp ELSE exp                { $$ = mkife($3,$5,$7,$<ulong>2); }
 973
 974         /* Case Expression */
 975         |  CASE {$<ulong>$ = hsplineno;}
 976            exp OF caserest                      { $$ = mkcasee($3,$5,$<ulong>2); }
 977
 978         /* Do Expression */
 979         |  DO {$<ulong>$ = hsplineno;}
 980            dorest                               { $$ = mkdoe($3,$<ulong>2); }
 981
 982         /* CCALL/CASM Expression */
 983         |  CCALL ccallid cexps                  { $$ = mkccall($2,install_literal("n"),$3); }
 984         |  CCALL ccallid                        { $$ = mkccall($2,install_literal("n"),Lnil); }
 985         |  CCALL_GC ccallid cexps               { $$ = mkccall($2,install_literal("p"),$3); }
 986         |  CCALL_GC ccallid                     { $$ = mkccall($2,install_literal("p"),Lnil); }
 987         |  CASM CLITLIT cexps                   { $$ = mkccall($2,install_literal("N"),$3); }
 988         |  CASM CLITLIT                         { $$ = mkccall($2,install_literal("N"),Lnil); }
 989         |  CASM_GC CLITLIT cexps                { $$ = mkccall($2,install_literal("P"),$3); }
 990         |  CASM_GC CLITLIT                      { $$ = mkccall($2,install_literal("P"),Lnil); }
 991
 992         /* SCC Expression */
 993         |  SCC STRING exp
 994                 { if (ignoreSCC) {
 995                     $$ = $3;
 996                   } else {
 997                     $$ = mkscc($2, $3);
 998                   }
 999                 }
1000         |  fexp
1001         ;
1002
1003 fexp    :  fexp aexp                            { $$ = mkap($1,$2); }
1004         |  aexp
1005         ;
1006
1007         /* simple expressions */
1008 aexp    :  qvar                                 { $$ = mkident($1); }
1009         |  gcon                                 { $$ = mkident($1); }
1010         |  lit_constant                         { $$ = mklit($1); }
1011         |  OPAREN exp CPAREN                    { $$ = mkpar($2); }         /* mkpar: stop infix parsing at ()'s */
1012         |  qcon OCURLY CCURLY                   { $$ = mkrecord($1,Lnil); }
1013         |  qcon OCURLY rbinds CCURLY            { $$ = mkrecord($1,$3); }   /* 1 S/R conflict on OCURLY -> shift */
1014         |  OBRACK list_exps CBRACK              { $$ = mkllist($2); }
1015         |  OPAREN exp COMMA texps CPAREN        { if (ttree($4) == tuple)
1016                                                      $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4)));
1017                                                   else
1018                                                      $$ = mktuple(ldub($2, $4)); }
1019
1020         /* only in expressions ... */
1021         |  aexp OCURLY rbinds CCURLY            { $$ = mkrupdate($1,$3); }
1022         |  OBRACK exp VBAR quals CBRACK         { $$ = mkcomprh($2,$4); }
1023         |  OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1024         |  OBRACK exp COMMA exp DOTDOT CBRACK   { $$ = mkeenum($2,mkjust($4),mknothing()); }
1025         |  OBRACK exp DOTDOT exp CBRACK         { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1026         |  OBRACK exp DOTDOT CBRACK             { $$ = mkeenum($2,mknothing(),mknothing()); }
1027         |  OPAREN oexp qop CPAREN               { $$ = mklsection($2,$3); }
1028         |  OPAREN qop1 oexp CPAREN              { $$ = mkrsection($2,$3); }
1029
1030         /* only in patterns ... */
1031         /* these add 2 S/R conflict with with  aexp . OCURLY rbinds CCURLY */
1032         |  qvar AT aexp                         { checkinpat(); $$ = mkas($1,$3); }
1033         |  LAZY aexp                            { checkinpat(); $$ = mklazyp($2); }
1034         |  WILDCARD                             { checkinpat(); $$ = mkwildp();   }
1035         ;
1036
1037         /* ccall arguments */
1038 cexps   :  cexps aexp                           { $$ = lapp($1,$2); }
1039         |  aexp                                 { $$ = lsing($1); }
1040         ;
1041
1042 caserest:  ocurly alts ccurly                   { $$ = $2; }
1043         |  vocurly alts vccurly                 { $$ = $2; }
1044
1045 dorest  :  ocurly stmts ccurly                  { checkdostmts($2); $$ = $2; }
1046         |  vocurly stmts vccurly                { checkdostmts($2); $$ = $2; }
1047         ;
1048
1049 rbinds  :  rbind                                { $$ = lsing($1); }
1050         |  rbinds COMMA rbind                   { $$ = lapp($1,$3); }
1051         ;
1052
1053 rbind   :  qvar                                 { $$ = mkrbind($1,mknothing()); }
1054         |  qvar EQUAL exp                       { $$ = mkrbind($1,mkjust($3)); }
1055         ;
1056
1057 texps   :  exp  { $$ = mkpar($1); }     /* mkpar: so we don't flatten last element in tuple */
1058         |  exp COMMA texps
1059                 { if (ttree($3) == tuple)
1060                     $$ = mktuple(mklcons($1, gtuplelist((struct Stuple *) $3)));
1061                   else if (ttree($3) == par)
1062                     $$ = mktuple(ldub($1, gpare((struct Spar *) $3)));
1063                   else
1064                     hsperror("hsparser:texps: panic");
1065                 }
1066         /* right recursion? WDP */
1067         ;
1068
1069
1070 list_exps :
1071            exp                                  { $$ = lsing($1); }
1072         |  exp COMMA list_exps          { $$ = mklcons($1, $3); }
1073         /* right recursion? (WDP)
1074
1075            It has to be this way, though, otherwise you
1076            may do the wrong thing to distinguish between...
1077
1078            [ e1 , e2 .. ]       -- an enumeration ...
1079            [ e1 , e2 , e3 ]     -- a list
1080
1081            (In fact, if you change the grammar and throw yacc/bison
1082            at it, it *will* do the wrong thing [WDP 94/06])
1083         */
1084         ;
1085
1086 letdecls:  LET ocurly decls ccurly              { $$ = $3 }
1087         |  LET vocurly decls vccurly            { $$ = $3 }
1088         ;
1089
1090 quals   :  qual                                 { $$ = lsing($1); }
1091         |  quals COMMA qual                     { $$ = lapp($1,$3); }
1092         ;
1093
1094 qual    :  letdecls                             { $$ = mkseqlet($1); }
1095         |  expL                                 { $$ = $1; }
1096         |  {inpat=TRUE;} expLno {inpat=FALSE;}leftexp
1097                 { if ($4 == NULL) {
1098                       expORpat(LEGIT_EXPR,$2);
1099                       $$ = mkguard($2);
1100                   } else {
1101                       expORpat(LEGIT_PATT,$2);
1102                       $$ = mkqual($2,$4);
1103                   }
1104                 }
1105         ;
1106
1107 alts    :  alt                                  { $$ = $1; }
1108         |  alts SEMI alt                        { $$ = lconc($1,$3); }
1109         ;
1110
1111 alt     :  pat { PREVPATT = $1; } altrest       { $$ = lsing($3); PREVPATT = NULL; }
1112         |  /* empty */                          { $$ = Lnil; }
1113         ;
1114
1115 altrest :  gdpat maybe_where                    { $$ = createpat(mkpguards($1), $2); }
1116         |  RARROW exp maybe_where               { $$ = createpat(mkpnoguards($2),$3); }
1117         ;
1118
1119 gdpat   :  gd RARROW exp                        { $$ = lsing(mkpgdexp($1,$3)); }
1120         |  gd RARROW exp gdpat                  { $$ = mklcons(mkpgdexp($1,$3),$4);  }
1121         ;
1122
1123 stmts   :  stmt                                 { $$ = $1; }
1124         |  stmts SEMI stmt                      { $$ = lconc($1,$3); }
1125         ;
1126
1127 stmt    :  /* empty */                          { $$ = Lnil; }
1128         |  letdecls                             { $$ = lsing(mkseqlet($1)); }
1129         |  expL                                 { $$ = lsing($1); }
1130         |  {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
1131                 { if ($4 == NULL) {
1132                       expORpat(LEGIT_EXPR,$2);
1133                       $$ = lsing(mkdoexp($2,endlineno));
1134                   } else {
1135                       expORpat(LEGIT_PATT,$2);
1136                       $$ = lsing(mkdobind($2,$4,endlineno));
1137                   }
1138                 }
1139         ;
1140
1141 leftexp :  LARROW exp                           { $$ = $2; }
1142         |  /* empty */                          { $$ = NULL; }
1143         ;
1144
1145 /**********************************************************************
1146 *                                                                     *
1147 *                                                                     *
1148 *     Patterns                                                        *
1149 *                                                                     *
1150 *                                                                     *
1151 **********************************************************************/
1152
1153 pat     :  pat qconop bpat                      { $$ = mkinfixap($2,$1,$3); }
1154         |  bpat
1155         ;
1156
1157 bpat    :  apatc
1158         |  conpat
1159         |  qcon OCURLY rpats CCURLY             { $$ = mkrecord($1,$3); }
1160         |  MINUS INTEGER                        { $$ = mknegate(mklit(mkinteger($2))); }
1161         |  MINUS FLOAT                          { $$ = mknegate(mklit(mkfloatr($2))); }
1162         ;
1163
1164 conpat  :  gcon                                 { $$ = mkident($1); }
1165         |  conpat apat                          { $$ = mkap($1,$2); }
1166         ;
1167
1168 apat    :  gcon                                 { $$ = mkident($1); }
1169         |  qcon OCURLY rpats CCURLY             { $$ = mkrecord($1,$3); }
1170         |  apatc
1171         ;
1172
1173 apatc   :  qvar                                 { $$ = mkident($1); }
1174         |  qvar AT apat                         { $$ = mkas($1,$3); }
1175         |  lit_constant                         { $$ = mklit($1); }
1176         |  WILDCARD                             { $$ = mkwildp(); }
1177         |  OPAREN pat CPAREN                    { $$ = mkpar($2); }
1178         |  OPAREN pat COMMA pats CPAREN         { $$ = mktuple(mklcons($2,$4)); }
1179         |  OBRACK pats CBRACK                   { $$ = mkllist($2); }
1180         |  LAZY apat                            { $$ = mklazyp($2); }
1181         ;
1182
1183 lit_constant:
1184            INTEGER                              { $$ = mkinteger($1); }
1185         |  FLOAT                                { $$ = mkfloatr($1); }
1186         |  CHAR                                 { $$ = mkcharr($1); }
1187         |  STRING                               { $$ = mkstring($1); }
1188         |  CHARPRIM                             { $$ = mkcharprim($1); }
1189         |  STRINGPRIM                           { $$ = mkstringprim($1); }
1190         |  INTPRIM                              { $$ = mkintprim($1); }
1191         |  FLOATPRIM                            { $$ = mkfloatprim($1); }
1192         |  DOUBLEPRIM                           { $$ = mkdoubleprim($1); }
1193         |  CLITLIT /* yurble yurble */          { $$ = mkclitlit($1); }
1194         ;
1195
1196 lampats :  apat lampats                         { $$ = mklcons($1,$2); }
1197         |  apat                                 { $$ = lsing($1); }
1198         /* right recursion? (WDP) */
1199         ;
1200
1201 pats    :  pat COMMA pats                       { $$ = mklcons($1, $3); }
1202         |  pat                                  { $$ = lsing($1); }
1203         /* right recursion? (WDP) */
1204         ;
1205
1206 rpats   : rpat                                  { $$ = lsing($1); }
1207         | rpats COMMA rpat                      { $$ = lapp($1,$3); }
1208         ;
1209
1210 rpat    :  qvar                                 { $$ = mkrbind($1,mknothing()); }
1211         |  qvar EQUAL pat                       { $$ = mkrbind($1,mkjust($3)); }
1212         ;
1213
1214
1215 patk    :  patk qconop bpat                     { $$ = mkinfixap($2,$1,$3); }
1216         |  bpatk
1217         ;
1218
1219 bpatk   :  apatck
1220         |  conpatk
1221         |  qconk OCURLY rpats CCURLY            { $$ = mkrecord($1,$3); }
1222         |  minuskey INTEGER                     { $$ = mknegate(mklit(mkinteger($2))); }
1223         |  minuskey FLOAT                       { $$ = mknegate(mklit(mkfloatr($2))); }
1224         ;
1225
1226 conpatk :  gconk                                { $$ = mkident($1); }
1227         |  conpatk apat                         { $$ = mkap($1,$2); }
1228         ;
1229
1230 apatck  :  qvark                                { $$ = mkident($1); }
1231         |  qvark AT apat                        { $$ = mkas($1,$3); }
1232         |  lit_constant                         { $$ = mklit($1); setstartlineno(); }
1233         |  WILDCARD                             { $$ = mkwildp(); setstartlineno(); }
1234         |  oparenkey pat CPAREN                 { $$ = mkpar($2); }
1235         |  oparenkey pat COMMA pats CPAREN      { $$ = mktuple(mklcons($2,$4)); }
1236         |  obrackkey pats CBRACK                { $$ = mkllist($2); }
1237         |  lazykey apat                         { $$ = mklazyp($2); }
1238         ;
1239
1240
1241 gcon    :  qcon
1242         |  OBRACK CBRACK                        { $$ = creategid(-1); }
1243         |  OPAREN CPAREN                        { $$ = creategid(0); }
1244         |  OPAREN commas CPAREN                 { $$ = creategid($2); }
1245         ;
1246
1247 gconk   :  qconk
1248         |  obrackkey CBRACK                     { $$ = creategid(-1); }
1249         |  oparenkey CPAREN                     { $$ = creategid(0); }
1250         |  oparenkey commas CPAREN              { $$ = creategid($2); }
1251         ;
1252
1253 /**********************************************************************
1254 *                                                                     *
1255 *                                                                     *
1256 *     Keywords which record the line start                            *
1257 *                                                                     *
1258 *                                                                     *
1259 **********************************************************************/
1260
1261 importkey:  IMPORT      { setstartlineno(); }
1262         ;
1263
1264 datakey :   DATA        { setstartlineno();
1265                           if(etags)
1266 #if 1/*etags*/
1267                             printf("%u\n",startlineno);
1268 #else
1269                             fprintf(stderr,"%u\tdata\n",startlineno);
1270 #endif
1271                         }
1272         ;
1273
1274 typekey :   TYPE        { setstartlineno();
1275                           if(etags)
1276 #if 1/*etags*/
1277                             printf("%u\n",startlineno);
1278 #else
1279                             fprintf(stderr,"%u\ttype\n",startlineno);
1280 #endif
1281                         }
1282         ;
1283
1284 newtypekey : NEWTYPE    { setstartlineno();
1285                           if(etags)
1286 #if 1/*etags*/
1287                             printf("%u\n",startlineno);
1288 #else
1289                             fprintf(stderr,"%u\tnewtype\n",startlineno);
1290 #endif
1291                         }
1292         ;
1293
1294 instkey :   INSTANCE    { setstartlineno();
1295 #if 1/*etags*/
1296 /* OUT:                   if(etags)
1297                             printf("%u\n",startlineno);
1298 */
1299 #else
1300                             fprintf(stderr,"%u\tinstance\n",startlineno);
1301 #endif
1302                         }
1303         ;
1304
1305 defaultkey: DEFAULT     { setstartlineno(); }
1306         ;
1307
1308 classkey:   CLASS       { setstartlineno();
1309                           if(etags)
1310 #if 1/*etags*/
1311                             printf("%u\n",startlineno);
1312 #else
1313                             fprintf(stderr,"%u\tclass\n",startlineno);
1314 #endif
1315                         }
1316         ;
1317
1318 modulekey:  MODULE      { setstartlineno();
1319                           if(etags)
1320 #if 1/*etags*/
1321                             printf("%u\n",startlineno);
1322 #else
1323                             fprintf(stderr,"%u\tmodule\n",startlineno);
1324 #endif
1325                         }
1326         ;
1327
1328 oparenkey:  OPAREN      { setstartlineno(); }
1329         ;
1330
1331 obrackkey:  OBRACK      { setstartlineno(); }
1332         ;
1333
1334 lazykey :   LAZY        { setstartlineno(); }
1335         ;
1336
1337 minuskey:   MINUS       { setstartlineno(); }
1338         ;
1339
1340
1341 /**********************************************************************
1342 *                                                                     *
1343 *                                                                     *
1344 *     Basic qualified/unqualified ids/ops                             *
1345 *                                                                     *
1346 *                                                                     *
1347 **********************************************************************/
1348
1349 qvar    :  qvarid
1350         |  OPAREN qvarsym CPAREN        { $$ = $2; }
1351         ;
1352 qcon    :  qconid
1353         |  OPAREN qconsym CPAREN        { $$ = $2; }
1354         ;
1355 qvarop  :  qvarsym
1356         |  BQUOTE qvarid BQUOTE         { $$ = $2; }
1357         ;
1358 qconop  :  qconsym
1359         |  BQUOTE qconid BQUOTE         { $$ = $2; }
1360         ;
1361 qop     :  qconop
1362         |  qvarop
1363         ;
1364
1365 /* Non "-" op, used in right sections */
1366 qop1    :  qconop
1367         |  qvarop1
1368         ;
1369
1370 /* Non "-" varop, used in right sections */
1371 qvarop1 :  QVARSYM
1372         |  varsym_nominus               { $$ = mknoqual($1); }
1373         |  BQUOTE qvarid BQUOTE         { $$ = $2; }
1374         ;
1375
1376
1377 var     :  varid
1378         |  OPAREN varsym CPAREN         { $$ = $2; }
1379         ;
1380 con     :  tycon                        /* using tycon removes conflicts */
1381         |  OPAREN CONSYM CPAREN         { $$ = $2; }
1382         ;
1383 varop   :  varsym
1384         |  BQUOTE varid BQUOTE          { $$ = $2; }
1385         ;
1386 conop   :  CONSYM
1387         |  BQUOTE CONID BQUOTE          { $$ = $2; }
1388         ;
1389 op      :  conop
1390         |  varop
1391         ;
1392
1393 qvark   :  qvarid                       { setstartlineno(); $$ = $1; }
1394         |  oparenkey qvarsym CPAREN     { $$ = $2; }
1395         ;
1396 qconk   :  qconid                       { setstartlineno(); $$ = $1; }
1397         |  oparenkey qconsym CPAREN     { $$ = $2; }
1398         ;
1399 vark    :  varid                        { setstartlineno(); $$ = $1; }
1400         |  oparenkey varsym CPAREN      { $$ = $2; }
1401         ;
1402
1403 qvarid  :  QVARID
1404         |  varid                        { $$ = mknoqual($1); }
1405         ;
1406 qvarsym :  QVARSYM
1407         |  varsym                       { $$ = mknoqual($1); }
1408         ;
1409 qconid  :  QCONID
1410         |  tycon                        { $$ = mknoqual($1); } /* using tycon removes conflicts */
1411         ;
1412 qconsym :  QCONSYM
1413         |  CONSYM                       { $$ = mknoqual($1); }
1414         ;
1415 qtycon  :  QCONID
1416         |  tycon                        { $$ = mknoqual($1); } /* using tycon removes conflicts */
1417         ;
1418 qtycls  :  QCONID
1419         |  tycon                        { $$ = mknoqual($1); } /* using tycon removes conflicts */
1420         ;
1421
1422 varsym  :  varsym_nominus
1423         |  MINUS                        { $$ = install_literal("-"); }
1424         ;
1425
1426 /* AS HIDING QUALIFIED are valid varids */
1427 varid   :  VARID
1428         |  AS                           { $$ = install_literal("as"); }
1429         |  HIDING                       { $$ = install_literal("hiding"); }
1430         |  QUALIFIED                    { $$ = install_literal("qualified"); }
1431         ;
1432
1433 /* DARROW BANG are valid varsyms */
1434 varsym_nominus : VARSYM
1435         |  DARROW                       { $$ = install_literal("=>"); }
1436         |  BANG                         { $$ = install_literal("!"); }
1437         ;
1438
1439 ccallid :  VARID
1440         |  CONID
1441         ;
1442
1443 tyvar   :  varid                        { $$ = mknamedtvar(mknoqual($1)); }
1444         ;
1445 tycon   :  CONID
1446         ;
1447 modid   :  CONID
1448         ;
1449
1450 tyvar_list: tyvar                       { $$ = lsing($1); }
1451         |  tyvar_list COMMA tyvar       { $$ = lapp($1,$3); }
1452         ;
1453
1454 /**********************************************************************
1455 *                                                                     *
1456 *                                                                     *
1457 *     Stuff to do with layout                                         *
1458 *                                                                     *
1459 *                                                                     *
1460 **********************************************************************/
1461
1462 ocurly  : layout OCURLY                         { hsincindent(); }
1463
1464 vocurly : layout                                { hssetindent(); }
1465         ;
1466
1467 layout  :                                       { hsindentoff(); }
1468         ;
1469
1470 ccurly  :
1471          CCURLY
1472                 {
1473                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1474                   hsendindent();
1475                 }
1476         ;
1477
1478 vccurly :  { expect_ccurly = 1; }  vccurly1  { expect_ccurly = 0; }
1479         ;
1480
1481 vccurly1:
1482          VCCURLY
1483                 {
1484                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1485                   hsendindent();
1486                 }
1487         | error
1488                 {
1489                   yyerrok;
1490                   FN = NULL; SAMEFN = 0; PREVPATT = NULL;
1491                   hsendindent();
1492                 }
1493         ;
1494
1495 %%
1496
1497 /**********************************************************************
1498 *                                                                     *
1499 *      Error Processing and Reporting                                 *
1500 *                                                                     *
1501 *  (This stuff is here in case we want to use Yacc macros and such.)  *
1502 *                                                                     *
1503 **********************************************************************/
1504
1505 void
1506 checkinpat()
1507 {
1508   if(!inpat)
1509     hsperror("pattern syntax used in expression");
1510 }
1511
1512
1513 /* The parser calls "hsperror" when it sees a
1514    `report this and die' error.  It sets the stage
1515    and calls "yyerror".
1516
1517    There should be no direct calls in the parser to
1518    "yyerror", except for the one from "hsperror".  Thus,
1519    the only other calls will be from the error productions
1520    introduced by yacc/bison/whatever.
1521
1522    We need to be able to recognise the from-error-production
1523    case, because we sometimes want to say, "Oh, never mind",
1524    because the layout rule kicks into action and may save
1525    the day.  [WDP]
1526 */
1527
1528 static BOOLEAN error_and_I_mean_it = FALSE;
1529
1530 void
1531 hsperror(s)
1532   char *s;
1533 {
1534     error_and_I_mean_it = TRUE;
1535     yyerror(s);
1536 }
1537
1538 extern char *yytext;
1539 extern int yyleng;
1540
1541 void
1542 yyerror(s)
1543   char *s;
1544 {
1545     /* We want to be able to distinguish 'error'-raised yyerrors
1546        from yyerrors explicitly coded by the parser hacker.
1547     */
1548     if (expect_ccurly && ! error_and_I_mean_it ) {
1549         /*NOTHING*/;
1550
1551     } else {
1552         fprintf(stderr, "\"%s\", line %d, column %d: %s on input: ",
1553           input_filename, hsplineno, hspcolno + 1, s);
1554
1555         if (yyleng == 1 && *yytext == '\0')
1556             fprintf(stderr, "<EOF>");
1557
1558         else {
1559             fputc('"', stderr);
1560             format_string(stderr, (unsigned char *) yytext, yyleng);
1561             fputc('"', stderr);
1562         }
1563         fputc('\n', stderr);
1564
1565         /* a common problem */
1566         if (strcmp(yytext, "#") == 0)
1567             fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
1568
1569         exit(1);
1570     }
1571 }
1572
1573 void
1574 format_string(fp, s, len)
1575   FILE *fp;
1576   unsigned char *s;
1577   int len;
1578 {
1579     while (len-- > 0) {
1580         switch (*s) {
1581         case '\0':    fputs("\\NUL", fp);   break;
1582         case '\007':  fputs("\\a", fp);     break;
1583         case '\010':  fputs("\\b", fp);     break;
1584         case '\011':  fputs("\\t", fp);     break;
1585         case '\012':  fputs("\\n", fp);     break;
1586         case '\013':  fputs("\\v", fp);     break;
1587         case '\014':  fputs("\\f", fp);     break;
1588         case '\015':  fputs("\\r", fp);     break;
1589         case '\033':  fputs("\\ESC", fp);   break;
1590         case '\034':  fputs("\\FS", fp);    break;
1591         case '\035':  fputs("\\GS", fp);    break;
1592         case '\036':  fputs("\\RS", fp);    break;
1593         case '\037':  fputs("\\US", fp);    break;
1594         case '\177':  fputs("\\DEL", fp);   break;
1595         default:
1596             if (*s >= ' ')
1597                 fputc(*s, fp);
1598             else
1599                 fprintf(fp, "\\^%c", *s + '@');
1600             break;
1601         }
1602         s++;
1603     }
1604 }