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