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