X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FRdrHsSyn.lhs;h=be51624ae2eb2b78e20f867527d1bf7c146679f8;hb=f940a549b7562dcdbea3af81ee93b1660d279497;hp=c4526f84b9d9ab02a04970406272d3187bccb3a7;hpb=2eb04ca0f8d0ec72b417cddc60672c696b4a3daa;p=ghc-hetmet.git

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index c4526f8..be51624 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -4,6 +4,13 @@
 Functions over HsSyn specialised to RdrName.
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module RdrHsSyn (
 	extractHsTyRdrTyVars, 
 	extractHsRhoRdrTyVars, extractGenericPatTyVars,
@@ -58,7 +65,7 @@ import RdrName		( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc,
 			  isRdrDataCon, isUnqual, getRdrName, isQual,
 			  setRdrNameSpace )
 import BasicTypes	( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
-import Lexer		( P, failSpanMsgP, extension, glaExtsEnabled, bangPatEnabled )
+import Lexer		( P, failSpanMsgP, extension, standaloneDerivingEnabled, bangPatEnabled )
 import TysWiredIn	( unitTyCon ) 
 import ForeignCall	( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
 			  DNCallSpec(..), DNKind(..), CLabelString )
@@ -413,9 +420,9 @@ checkTyVars tparms = mapM_ chk tparms
 	  parseError l "Type found where type variable expected"
 
 -- Check whether the type arguments in a type synonym head are simply
--- variables.  If not, we have a type equation of a type function and return
--- all patterns.  If yes, we return 'Nothing' as the third component to
--- indicate a vanilla type synonym.
+-- variables.  If not, we have a type family instance and return all patterns.
+-- If yes, we return 'Nothing' as the third component to indicate a vanilla
+-- type synonym. 
 --
 checkSynHdr :: LHsType RdrName 
 	    -> Bool                             -- is type instance?
@@ -442,6 +449,7 @@ checkTyClHdr :: LHsContext RdrName -> LHsType RdrName
 -- etc
 -- With associated types, we can also have non-variable parameters; ie,
 --      T Int [a]
+-- or   Int :++: [a]
 -- The unaltered parameter list is returned in the fourth component of the
 -- result.  Eg, for
 --      T Int [a]
@@ -459,7 +467,7 @@ checkTyClHdr (L l cxt) ty
 				     return (L l tc, tvs, acc)
     go l (HsOpTy t1 ltc@(L _ tc) t2) acc
 	| isRdrTc tc		= do tvs <- extractTyVars (t1:t2:acc)
-				     return (ltc, tvs, acc)
+				     return (ltc, tvs, t1:t2:acc)
     go l (HsParTy ty)    acc    = gol ty acc
     go l (HsAppTy t1 t2) acc    = gol t1 (t2:acc)
     go l other	         acc    = 
@@ -577,9 +585,9 @@ checkPred (L spn ty)
 
 checkDerivDecl :: LDerivDecl RdrName -> P (LDerivDecl RdrName)
 checkDerivDecl d@(L loc _) = 
-    do glaExtOn <- extension glaExtsEnabled
-       if glaExtOn then return d
-	 else parseError loc "Illegal stand-alone deriving declaration (use -fglasgow-exts)"
+    do stDerivOn <- extension standaloneDerivingEnabled
+       if stDerivOn then return d
+	 else parseError loc "Illegal stand-alone deriving declaration (use -XStandaloneDeriving)"
 
 ---------------------------------------------------------------------------
 -- Checking statements in a do-expression
@@ -645,7 +653,7 @@ checkAPat loc e = case e of
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
    -- NB. Negative *primitive* literals are already handled by the lexer
-   HsOverLit pos_lit            -> return (mkNPat pos_lit Nothing)
+   HsOverLit pos_lit          -> return (mkNPat pos_lit Nothing)
    NegApp (L _ (HsOverLit pos_lit)) _ 
 			-> return (mkNPat pos_lit (Just noSyntaxExpr))
    
@@ -657,6 +665,8 @@ checkAPat loc e = case e of
 
    ELazyPat e	      -> checkLPat e >>= (return . LazyPat)
    EAsPat n e	      -> checkLPat e >>= (return . AsPat n)
+   -- view pattern is well-formed if the pattern is
+   EViewPat expr patE -> checkLPat patE >>= (return . (\p -> ViewPat expr p placeHolderType))
    ExprWithTySig e t  -> checkLPat e >>= \e ->
    			 -- Pattern signatures are parsed as sigtypes,
    			 -- but they aren't explicit forall points.  Hence
@@ -669,7 +679,7 @@ checkAPat loc e = case e of
    
    -- n+k patterns
    OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ 
-	(L _ (HsOverLit lit@(HsIntegral _ _)))
+	(L _ (HsOverLit lit@(HsIntegral _ _ _)))
    		      | plus == plus_RDR
    		      -> return (mkNPlusKPat (L nloc n) lit)
    
@@ -692,6 +702,7 @@ checkAPat loc e = case e of
    RecordCon c _ (HsRecFields fs dd) 
 		      -> mapM checkPatField fs >>= \fs ->
 			 return (ConPatIn c (RecCon (HsRecFields fs dd)))
+   HsQuasiQuoteE q    -> return (QuasiQuotePat q)
 -- Generics 
    HsType ty          -> return (TypePat ty) 
    _                  -> patFail loc