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