[project @ 1998-06-08 11:45:09 by simonpj]

[ghc-hetmet.git] / ghc / compiler / parser / hsparser.y

diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y
index 31145d8..ab59ce6 100644 (file)
--- a/ghc/compiler/parser/hsparser.y
+++ b/ghc/compiler/parser/hsparser.y
@@ -76,7 +76,6 @@ char *ineg PROTO((char *));
 
 long    source_version = 0;
 
-BOOLEAN inpat;
 %}
 
 %union {
@@ -184,7 +183,7 @@ BOOLEAN inpat;
 **********************************************************************/
 
 %token  INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
-%token  INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
+%token  INLINE_UPRAGMA NOINLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
 %token  END_UPRAGMA 
 %token  SOURCE_UPRAGMA
 
@@ -505,10 +504,14 @@ deriving: /* empty */                             { $$ = mknothing(); }
         | DERIVING dtyclses                     { $$ = mkjust($2); }
        ;
 
-classd :  classkey simple_context DARROW simple_con_app1 cbody
-               { $$ = mkcbind($2,$4,$5,startlineno); }
-       |  classkey simple_con_app1 cbody                       
-               { $$ = mkcbind(Lnil,$2,$3,startlineno); }
+classd :  classkey btype DARROW simple_con_app1 cbody
+               /* Context can now be more than simple_context */
+               { $$ = mkcbind(type2context($2),$4,$5,startlineno); }
+       |  classkey btype cbody
+               /* We have to say btype rather than simple_con_app1, else
+                  we get reduce/reduce errs */
+               { check_class_decl_head($3);
+                 $$ = mkcbind(Lnil,$2,$3,startlineno); }
        ;
 
 cbody  :  /* empty */                          { $$ = mknullbind(); }
@@ -522,7 +525,7 @@ instd       :  instkey inst_type rinst              { $$ = mkibind($2,$3,startlineno); }
 /* Compare ctype */
 inst_type : type DARROW type                   { is_context_format( $3, 0 );   /* Check the instance head */
                                                  $$ = mkcontext(type2context($1),$3); }
-         | type                                { is_context_format( $1, 0 );   /* Check the instance head */
+         | btype                               { is_context_format( $1, 0 );   /* Check the instance head */
                                                  $$ = $1; }
          ;
 
@@ -591,6 +594,12 @@ decl       : qvarsk DCOLON sigtype
                  PREVPATT = NULL; FN = NULL; SAMEFN = 0;
                }
 
+       |  NOINLINE_UPRAGMA qvark END_UPRAGMA
+               {
+                 $$ = mknoinline_uprag($2, startlineno);
+                 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+               }
+
        |  MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
                {
                  $$ = mkmagicuf_uprag($2, $3, startlineno);
@@ -644,7 +653,7 @@ type_and_maybe_id :
 /* A sigtype is a rank 2 type; it can have for-alls as function args:
        f :: All a => (All b => ...) -> Int
 */
-sigtype        : type DARROW sigarrowtype              { $$ = mkcontext(type2context($1),$3); }
+sigtype        : btype DARROW sigarrowtype             { $$ = mkcontext(type2context($1),$3); }
        | sigarrowtype 
        ;
 
@@ -654,11 +663,11 @@ sigarrowtype : bigatype RARROW sigarrowtype       { $$ = mktfun($1,$3); }
             ;
 
 /* A "big" atype can be a forall-type in brackets.  */
-bigatype: OPAREN type DARROW type CPAREN       { $$ = mkcontext(type2context($2),$4); }
+bigatype: OPAREN btype DARROW type CPAREN      { $$ = mkcontext(type2context($2),$4); }
        ;
 
        /* 1 S/R conflict at DARROW -> shift */
-ctype   : type DARROW type                     { $$ = mkcontext(type2context($1),$3); }
+ctype   : btype DARROW type                    { $$ = mkcontext(type2context($1),$3); }
        | type
        ;
 
@@ -728,7 +737,7 @@ constrs     :  constr                               { $$ = lsing($1); }
        ;
 
 constr :  constr_after_context
-       |  type DARROW constr_after_context     { $$ = mkconstrcxt ( type2context($1), $3 ); }
+       |  btype DARROW constr_after_context    { $$ = mkconstrcxt ( type2context($1), $3 ); }
        ;
 
 constr_after_context :
@@ -846,6 +855,12 @@ instdef :
                  PREVPATT = NULL; FN = NULL; SAMEFN = 0;
                }
 
+       |  NOINLINE_UPRAGMA qvark END_UPRAGMA
+               {
+                 $$ = mknoinline_uprag($2, startlineno);
+                 PREVPATT = NULL; FN = NULL; SAMEFN = 0;
+               }
+
        |  MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
                {
                  $$ = mkmagicuf_uprag($2, $3, startlineno);
@@ -969,8 +984,8 @@ dexp        :  MINUS kexp                           { $$ = mknegate($2); }
   We need to factor out a leading let expression so we can set
   inpat=TRUE when parsing (non let) expressions inside stmts and quals
 */
-expLno         :  oexpLno DCOLON ctype                 { $$ = mkrestr($1,$3); }
-       |  oexpLno
+expLno         : oexpLno DCOLON ctype                  { $$ = mkrestr($1,$3); }
+       | oexpLno
        ;
 oexpLno        :  oexpLno qop oexp %prec MINUS         { $$ = mkinfixap($2,$1,$3); }
        |  dexpLno
@@ -1083,9 +1098,9 @@ aexp      :  qvar                                 { $$ = mkident($1); }
 
        /* only in patterns ... */
        /* these add 2 S/R conflict with with  aexp . OCURLY rbinds CCURLY */
-       |  qvar AT aexp                         { checkinpat(); $$ = mkas($1,$3); }
-       |  LAZY aexp                            { checkinpat(); $$ = mklazyp($2); }
-       |  WILDCARD                             { checkinpat(); $$ = mkwildp();   }
+       |  qvar AT aexp                         { $$ = mkas($1,$3); }
+       |  LAZY aexp                            { $$ = mklazyp($2); }
+       |  WILDCARD                             { $$ = mkwildp();   }
        ;
 
        /* ccall arguments */
@@ -1096,7 +1111,7 @@ cexps     :  cexps aexp                           { $$ = lapp($1,$2); }
 caserest:  ocurly alts ccurly                  { $$ = $2; }
        |  vocurly alts vccurly                 { $$ = $2; }
 
-dorest  :  ocurly stmts ccurly                 { checkdostmts($2); $$ = $2; }
+dorest  :  ocurly stmts ccurly                 { checkdostmts($2); $$ = $2; }
        |  vocurly stmts vccurly                { checkdostmts($2); $$ = $2; }
        ;
 
@@ -1162,14 +1177,13 @@ quals   :  qual                                 { $$ = lsing($1); }
 
 qual   :  letdecls                             { $$ = mkseqlet($1); }
        |  expL                                 { $$ = $1; }
-       |  {inpat=TRUE;} expLno 
-          {inpat=FALSE;} leftexp
-               { if ($4 == NULL) {
-                     expORpat(LEGIT_EXPR,$2);
-                     $$ = mkguard($2);
+       |  expLno leftexp
+               { if ($2 == NULL) {
+                     expORpat(LEGIT_EXPR,$1);
+                     $$ = mkguard($1);
                  } else {
-                     expORpat(LEGIT_PATT,$2);
-                     $$ = mkqual($2,$4);
+                     expORpat(LEGIT_PATT,$1);
+                     $$ = mkqual($1,$2);
                  }
                }
        ;
@@ -1178,7 +1192,7 @@ alts      :  alt                                  { $$ = $1; }
        |  alts SEMI alt                        { $$ = lconc($1,$3); }
        ;
 
-alt    :  pat { PREVPATT = $1; } altrest       { $$ = lsing($3); PREVPATT = NULL; }
+alt    :  pat { PREVPATT = $1; } altrest       { expORpat(LEGIT_PATT,$1); $$ = lsing($3); PREVPATT = NULL; }
        |  /* empty */                          { $$ = Lnil; }
        ;
 
@@ -1190,20 +1204,20 @@ gdpat   :  gd RARROW exp                        { $$ = lsing(mkpgdexp($1,$3)); }
        |  gd RARROW exp gdpat                  { $$ = mklcons(mkpgdexp($1,$3),$4);  }
        ;
 
-stmts  :  stmt                                 { $$ = $1; }
+stmts  :  stmt                                 { $$ = $1; }
        |  stmts SEMI stmt                      { $$ = lconc($1,$3); }
        ;
 
-stmt   :  /* empty */                          { $$ = Lnil; }
-       |  letdecls                             { $$ = lsing(mkseqlet($1)); }
+stmt   : /* empty */                           { $$ = Lnil; } 
+       | letdecls                              { $$ = lsing(mkseqlet($1)); }
        |  expL                                 { $$ = lsing(mkdoexp($1,hsplineno)); }
-       |  {inpat=TRUE;} expLno {inpat=FALSE;} leftexp
-               { if ($4 == NULL) {
-                     expORpat(LEGIT_EXPR,$2);
-                     $$ = lsing(mkdoexp($2,endlineno));
+        |  expLno leftexp
+               { if ($2 == NULL) {
+                     expORpat(LEGIT_EXPR,$1);
+                     $$ = lsing(mkdoexp($1,endlineno));
                  } else {
-                     expORpat(LEGIT_PATT,$2);
-                     $$ = lsing(mkdobind($2,$4,endlineno));
+                     expORpat(LEGIT_PATT,$1);
+                     $$ = lsing(mkdobind($1,$2,endlineno));
                  }
                }
        ;
@@ -1572,7 +1586,7 @@ vccurly1:
                  FN = NULL; SAMEFN = 0; PREVPATT = NULL;
                  hsendindent();
                }
-       ;
+       ;
 
 %%
 
@@ -1584,13 +1598,15 @@ vccurly1:
 *                                                                     *
 **********************************************************************/
 
+
+/*
 void
 checkinpat()
 {
   if(!inpat)
     hsperror("pattern syntax used in expression");
 }
-
+*/
 
 /* The parser calls "hsperror" when it sees a
    `report this and die' error.  It sets the stage