Big tidy-up of deriving code

[ghc-hetmet.git] / compiler / parser / Parser.y.pp

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 009eddc..889e4ce 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -178,9 +178,9 @@ incorrect.
  'data'        { L _ ITdata } 
  'default'     { L _ ITdefault }
  'deriving'    { L _ ITderiving }
  'data'        { L _ ITdata } 
  'default'     { L _ ITdefault }
  'deriving'    { L _ ITderiving }

+ 'derived'     { L _ ITderived }

  'do'          { L _ ITdo }
  'else'        { L _ ITelse }
  'do'          { L _ ITdo }
  'else'        { L _ ITelse }

- 'for'                 { L _ ITfor }

  'hiding'      { L _ IThiding }
  'if'          { L _ ITif }
  'import'      { L _ ITimport }
  'hiding'      { L _ IThiding }
  'if'          { L _ ITif }
  'import'      { L _ ITimport }

@@ -740,10 +740,7 @@ tycl_hdr :: { Located (LHsContext RdrName,
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }

-       : 'deriving' qtycon            'for' qtycon  {% do { p <- checkInstType (fmap HsTyVar $2)
-                                                          ; checkDerivDecl (LL (DerivDecl p $4)) } }
-
-        | 'deriving' '(' inst_type ')' 'for' qtycon  {% checkDerivDecl (LL (DerivDecl $3 $6)) }
+       : 'derived' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }

 
 -----------------------------------------------------------------------------
 -- Nested declarations
 
 -----------------------------------------------------------------------------
 -- Nested declarations

@@ -971,8 +968,13 @@ ctype      :: { LHsType RdrName }
 -- errors in ctype.  The basic problem is that
 --     (Eq a, Ord a)
 -- looks so much like a tuple type.  We can't tell until we find the =>
 -- errors in ctype.  The basic problem is that
 --     (Eq a, Ord a)
 -- looks so much like a tuple type.  We can't tell until we find the =>

+--
+-- We have the t1 ~ t2 form here and in gentype, to permit an individual
+-- equational constraint without parenthesis.

 context :: { LHsContext RdrName }
 context :: { LHsContext RdrName }

-       : btype                         {% checkContext $1 }
+        : btype '~'      btype         {% checkContext
+                                            (LL $ HsPredTy (HsEqualP $1 $3)) }
+       | btype                         {% checkContext $1 }

 
 type :: { LHsType RdrName }
        : ipvar '::' gentype            { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
 
 type :: { LHsType RdrName }
        : ipvar '::' gentype            { LL (HsPredTy (HsIParam (unLoc $1) $3)) }

@@ -983,7 +985,7 @@ gentype :: { LHsType RdrName }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
         | btype tyvarop  gentype       { LL $ HsOpTy $1 $2 $3 }
        | btype '->'     ctype          { LL $ HsFunTy $1 $3 }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
         | btype tyvarop  gentype       { LL $ HsOpTy $1 $2 $3 }
        | btype '->'     ctype          { LL $ HsFunTy $1 $3 }

-        | btype '~'      gentype       { LL $ HsPredTy (HsEqualP $1 $3) }
+        | btype '~'      btype         { LL $ HsPredTy (HsEqualP $1 $3) }

 
 btype :: { LHsType RdrName }
        : btype atype                   { LL $ HsAppTy $1 $2 }
 
 btype :: { LHsType RdrName }
        : btype atype                   { LL $ HsAppTy $1 $2 }

@@ -1736,7 +1738,7 @@ special_id
        : 'as'                  { L1 FSLIT("as") }
        | 'qualified'           { L1 FSLIT("qualified") }
        | 'hiding'              { L1 FSLIT("hiding") }
        : 'as'                  { L1 FSLIT("as") }
        | 'qualified'           { L1 FSLIT("qualified") }
        | 'hiding'              { L1 FSLIT("hiding") }

-        | 'for'                 { L1 FSLIT("for") }
+       | 'derived'             { L1 FSLIT("derived") }

        | 'export'              { L1 FSLIT("export") }
        | 'label'               { L1 FSLIT("label")  }
        | 'dynamic'             { L1 FSLIT("dynamic") }
        | 'export'              { L1 FSLIT("export") }
        | 'label'               { L1 FSLIT("label")  }
        | 'dynamic'             { L1 FSLIT("dynamic") }