ghc/compiler/parser/hsparser.y

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