Small fixes to the generics branch to get rid of warnings,

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

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a0cc964..078cfa4 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -216,6 +216,7 @@ incorrect.
  'deriving'    { L _ ITderiving }
  'do'          { L _ ITdo }
  'else'        { L _ ITelse }
+ 'generic'     { L _ ITgeneric }
  'hiding'      { L _ IThiding }
  'if'          { L _ ITif }
  'import'      { L _ ITimport }
@@ -266,6 +267,8 @@ incorrect.
  '{-# WARNING'     { L _ ITwarning_prag }
  '{-# UNPACK'      { L _ ITunpack_prag }
  '{-# ANN'         { L _ ITann_prag }
+ '{-# VECTORISE'          { L _ ITvect_prag }
+ '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
  '#-}'            { L _ ITclose_prag }
 
  '..'          { L _ ITdotdot }                        -- reserved symbols
@@ -563,6 +566,8 @@ topdecl :: { OrdList (LHsDecl RdrName) }
         | '{-# DEPRECATED' deprecations '#-}'   { $2 }
         | '{-# WARNING' warnings '#-}'          { $2 }
        | '{-# RULES' rules '#-}'               { $2 }
+       | '{-# VECTORISE_SCALAR' qvar '#-}'     { unitOL $ LL $ VectD (HsVect $2 Nothing) }
+       | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ LL $ VectD (HsVect $2 (Just $4)) }
        | annotation { unitOL $1 }
        | decl                                  { unLoc $1 }
 
@@ -1228,9 +1233,13 @@ gdrh :: { LGRHS RdrName }
        : '|' guardquals '=' exp        { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
-       : infixexp '::' sigtypedoc      {% do s <- checkValSig $1 $3 
-                                        ; return (LL $ unitOL (LL $ SigD s)) }
-               -- See Note [Declaration/signature overlap] for why we need infixexp here
+        : 'generic' infixexp '::' sigtypedoc
+                        {% do (TypeSig l ty) <- checkValSig $2 $4
+                        ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) }
+       -- See Note [Declaration/signature overlap] for why we need infixexp here
+       | infixexp '::' sigtypedoc
+                        {% do s <- checkValSig $1 $3 
+                        ; return (LL $ unitOL (LL $ SigD s)) }
        | var ',' sig_vars '::' sigtypedoc
                                { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
        | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))