X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=e009071ebc6d99fe73c0ff9b5d2d92cc97983810;hb=924142621ebc30a3c16368e0df3466ee14185ddd;hp=a0cc96417c862044228212b0ff685617ffd8e31e;hpb=ba05282d3915e7051b3f016366b971a8506b0093;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a0cc964..e009071 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -266,6 +266,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 +565,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 }
 
@@ -717,6 +721,11 @@ decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
 decl_cls  : at_decl_cls		        { LL (unitOL (L1 (TyClD (unLoc $1)))) }
 	  | decl                        { $1 }
 
+	  -- A 'default' signature used with the generic-programming extension
+          | 'default' infixexp '::' sigtypedoc
+                    {% do { (TypeSig l ty) <- checkValSig $2 $4
+                          ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) } }
+
 decls_cls :: { Located (OrdList (LHsDecl RdrName)) }	-- Reversed
 	  : decls_cls ';' decl_cls	{ LL (unLoc $1 `appOL` unLoc $3) }
 	  | decls_cls ';'		{ LL (unLoc $1) }
@@ -1228,9 +1237,11 @@ 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
+        : 
+	-- 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))))