X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=078cfa4374f68c26790e7344ed2c33f323dedc27;hb=fbff1b7b9c89f6369c4394a0b10fa7c06e011698;hp=8d561bab9fdff1dc5d667f00e43eed6468c230af;hpb=8350c21760d8610b0b2f329095ffb80bb1bc20d9;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 8d561ba..078cfa4 100644
--- 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))))
@@ -1284,7 +1293,9 @@ exp10 :: { LHsExpr RdrName }
 					   return (L loc (mkHsDo DoExpr stmts body)) }
   	| 'mdo' stmtlist		{% let loc = comb2 $1 $2 in
 					   checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-					   return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
+                                           return (L loc (mkHsDo MDoExpr
+                                                                 [L loc (mkRecStmt stmts)]
+                                                                 body)) }
         | scc_annot exp		    		{ LL $ if opt_SccProfilingOn
 							then HsSCC (unLoc $1) $2
 							else HsPar $2 }
@@ -1356,8 +1367,8 @@ aexp2	:: { LHsExpr RdrName }
 	| RATIONAL			{ sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
 
         -- N.B.: sections get parsed by these next two productions.
-        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
-        -- (you'd have to write '((+ 3), (4 -))')
+        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
+        -- correct Haskell (you'd have to write '((+ 3), (4 -))')
         -- but the less cluttered version fell out of having texps.
 	| '(' texp ')'			{ LL (HsPar $2) }
 	| '(' tup_exprs ')'             { LL (ExplicitTuple $2 Boxed) }
@@ -1417,8 +1428,8 @@ texp :: { LHsExpr RdrName }
 	-- Note [Parsing sections]
 	-- ~~~~~~~~~~~~~~~~~~~~~~~
 	-- We include left and right sections here, which isn't
-	-- technically right according to Haskell 98.  For example
-	--	(3 +, True) isn't legal
+	-- technically right according to the Haskell standard.
+        -- For example (3 +, True) isn't legal.
 	-- However, we want to parse bang patterns like
 	--	(!x, !y)
 	-- and it's convenient to do so here as a section