X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=24d8d1be58c33dafa93963dc6a0f7dbe0e324fb4;hb=cc7fd02d59c5b15f2aee8f3a420d3f6ee3048096;hp=6dbb49e9819eea7c3951ad50c41543f8de4a8c33;hpb=c281c07544cc58afe68fdda96afe53ba46985732;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 6dbb49e..24d8d1b 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -262,9 +262,9 @@ incorrect.
  '{-# SCC'	   { L _ ITscc_prag }
  '{-# GENERATED'   { L _ ITgenerated_prag }
  '{-# DEPRECATED'  { L _ ITdeprecated_prag }
- '{-# WARNING'  { L _ ITwarning_prag }
+ '{-# WARNING'     { L _ ITwarning_prag }
  '{-# UNPACK'      { L _ ITunpack_prag }
- '{-# ANN'      { L _ ITann_prag }
+ '{-# ANN'         { L _ ITann_prag }
  '#-}'		   { L _ ITclose_prag }
 
  '..'		{ L _ ITdotdot }  			-- reserved symbols
@@ -559,17 +559,17 @@ topdecl :: { OrdList (LHsDecl RdrName) }
         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
 	| 'default' '(' comma_types0 ')'	{ unitOL (LL $ DefD (DefaultDecl $3)) }
 	| 'foreign' fdecl			{ unitOL (LL (unLoc $2)) }
-    | '{-# DEPRECATED' deprecations '#-}' { $2 }
-    | '{-# WARNING' warnings '#-}'        { $2 }
+        | '{-# DEPRECATED' deprecations '#-}' { $2 }
+        | '{-# WARNING' warnings '#-}'        { $2 }
 	| '{-# RULES' rules '#-}'		{ $2 }
 	| annotation { unitOL $1 }
       	| decl					{ unLoc $1 }
 
 	-- Template Haskell Extension
-	| '$(' exp ')'				{ unitOL (LL $ SpliceD (SpliceDecl $2)) }
-	| TH_ID_SPLICE				{ unitOL (LL $ SpliceD (SpliceDecl $
-							L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
-						  )) }
+	-- The $(..) form is one possible form of infixexp
+	-- but we treat an arbitrary expression just as if 
+	-- it had a $(..) wrapped around it
+	| infixexp 				{ unitOL (LL $ mkTopSpliceDecl $1) } 
 
 -- Type classes
 --
@@ -981,7 +981,7 @@ context :: { LHsContext RdrName }
 
 type :: { LHsType RdrName }
         : btype                         { $1 }
-        | btype qtyconop type        { LL $ HsOpTy $1 $2 $3 }
+        | btype qtyconop type           { LL $ HsOpTy $1 $2 $3 }
         | btype tyvarop  type     	{ LL $ HsOpTy $1 $2 $3 }
  	| btype '->'     ctype		{ LL $ HsFunTy $1 $3 }
         | btype '~'      btype  	{ LL $ HsPredTy (HsEqualP $1 $3) }