X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=3b51e5841845de141519f628fbc23282085b7770;hp=212a79ce3695ad00bcabefff13debcb510592485;hb=e9f9ec1e57d53b9302a395ce0d02c0fa59e28341;hpb=b06d623b2e367a572de5daf06d6a0b12c2740471

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 212a79c..3b51e58 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1013,10 +1013,10 @@ atype :: { LHsType RdrName }
 	| '[:' ctype ':]'		{ LL $ HsPArrTy  $2 }
 	| '(' ctype ')'		        { LL $ HsParTy   $2 }
 	| '(' ctype '::' kind ')'	{ LL $ HsKindSig $2 (unLoc $4) }
-	| '$(' exp ')'	      		{ LL $ HsSpliceTy (mkHsSplice $2 ) }
-	| TH_ID_SPLICE	      		{ LL $ HsSpliceTy (mkHsSplice 
-					         (L1 $ HsVar (mkUnqual varName 
-							        (getTH_ID_SPLICE $1)))) } -- $x
+	| quasiquote       	        { L1 (HsQuasiQuoteTy (unLoc $1)) }
+	| '$(' exp ')'	      		{ LL $ mkHsSpliceTy $2 }
+	| TH_ID_SPLICE	      		{ LL $ mkHsSpliceTy $ L1 $ HsVar $ 
+					  mkUnqual varName (getTH_ID_SPLICE $1) }
 -- Generics
         | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
 
@@ -1044,7 +1044,7 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] }
 	 | {- empty -}			{ [] }
 
 tv_bndr :: { LHsTyVarBndr RdrName }
-	: tyvar				{ L1 (UserTyVar (unLoc $1)) }
+	: tyvar				{ L1 (UserTyVar (unLoc $1) placeHolderKind) }
 	| '(' tyvar '::' kind ')'	{ LL (KindedTyVar (unLoc $2) 
 							  (unLoc $4)) }
 
@@ -1168,7 +1168,9 @@ deriving :: { Located (Maybe [LHsType RdrName]) }
 -----------------------------------------------------------------------------
 -- Value definitions
 
-{- There's an awkward overlap with a type signature.  Consider
+{- Note [Declaration/signature overlap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's an awkward overlap with a type signature.  Consider
 	f :: Int -> Int = ...rhs...
    Then we can't tell whether it's a type signature or a value
    definition with a result signature until we see the '='.
@@ -1220,10 +1222,9 @@ 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 the above notes for why we need infixexp here
+	: infixexp '::' sigtypedoc	{% do s <- checkValSig $1 $3 
+				         ; return (LL $ unitOL (LL $ SigD s)) }
+		-- See Note [Declaration/signature overlap] for why we need infixexp here
 	| 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))))
@@ -1244,6 +1245,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 -----------------------------------------------------------------------------
 -- Expressions
 
+quasiquote :: { Located (HsQuasiQuote RdrName) }
+	: TH_QUASIQUOTE   { let { loc = getLoc $1
+                                ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
+                                ; quoterId = mkUnqual varName quoter }
+                            in L1 (mkHsQuasiQuote quoterId quoteSpan quote) }
+
 exp   :: { LHsExpr RdrName }
 	: infixexp '::' sigtype		{ LL $ ExprWithTySig $1 $3 }
 	| infixexp '-<' exp		{ LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
@@ -1355,14 +1362,10 @@ aexp2	:: { LHsExpr RdrName }
 	-- Template Haskell Extension
 	| TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice 
 					(L1 $ HsVar (mkUnqual varName 
-							(getTH_ID_SPLICE $1)))) } -- $x
-	| '$(' exp ')'   	{ LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
-
-	| TH_QUASIQUOTE       	{ let { loc = getLoc $1
-                                      ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
-                                      ; quoterId = mkUnqual varName quoter
-                                      }
-                                  in sL loc $ HsQuasiQuoteE (mkHsQuasiQuote quoterId quoteSpan quote) }
+							(getTH_ID_SPLICE $1)))) } 
+	| '$(' exp ')'   	{ LL $ HsSpliceE (mkHsSplice $2) }               
+
+
 	| TH_VAR_QUOTE qvar 	{ LL $ HsBracket (VarBr (unLoc $2)) }
 	| TH_VAR_QUOTE qcon 	{ LL $ HsBracket (VarBr (unLoc $2)) }
 	| TH_TY_QUOTE tyvar 	{ LL $ HsBracket (VarBr (unLoc $2)) }
@@ -1371,8 +1374,8 @@ aexp2	:: { LHsExpr RdrName }
 	| '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }                       
 	| '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
 					return (LL $ HsBracket (PatBr p)) }
-	| '[d|' cvtopbody '|]'	{% checkDecBrGroup $2 >>= \g -> 
-					return (LL $ HsBracket (DecBr g)) }
+	| '[d|' cvtopbody '|]'	{ LL $ HsBracket (DecBrL $2) }
+	| quasiquote       	{ L1 (HsQuasiQuoteE (unLoc $1)) }
 
 	-- arrow notation extension
 	| '(|' aexp2 cmdargs '|)'	{ LL $ HsArrForm $2 Nothing (reverse $3) }
@@ -1416,7 +1419,7 @@ texp :: { LHsExpr RdrName }
 	| qopm infixexp       { LL $ SectionR $1 $2 }
 
        -- View patterns get parenthesized above
-	| exp '->' exp   { LL $ EViewPat $1 $3 }
+	| exp '->' texp   { LL $ EViewPat $1 $3 }
 
 -- Always at least one comma
 tup_exprs :: { [HsTupArg RdrName] }