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