X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsPat.lhs;h=53a8bc035fbb8b8b00306fe41b991cb86ebc4639;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hp=87f471788129a863aa9cdd745925449dac66f919;hpb=3787d9878e4d62829a555f01b2a4c5866f24f303;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index 87f4717..53a8bc0 100644
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -5,7 +5,7 @@
 \section[PatSyntax]{Abstract Haskell syntax---patterns}
 
 \begin{code}
-{-# OPTIONS -w #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
 -- 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
@@ -19,6 +19,8 @@ module HsPat (
 	HsConPatDetails, hsConPatArgs, 
 	HsRecFields(..), HsRecField(..), hsRecFields,
 
+	HsQuasiQuote(..),
+
 	mkPrefixConPat, mkCharLitPat, mkNilPat, mkCoPat, mkCoPatCoI,
 
 	isBangHsBind,	
@@ -34,7 +36,6 @@ import {-# SOURCE #-} HsExpr		(SyntaxExpr, LHsExpr, pprLExpr)
 import HsBinds
 import HsLit
 import HsTypes
-import HsDoc
 import BasicTypes
 -- others:
 import Coercion
@@ -46,6 +47,7 @@ import TyCon
 import Outputable	
 import Type
 import SrcLoc
+import FastString
 \end{code}
 
 
@@ -113,6 +115,10 @@ data Pat id
                                     -- (= the argument type of the view function)
                                     -- for hsPatType.
 
+	------------ Quasiquoted patterns ---------------
+	-- See Note [Quasi-quote overview] in TcSplice
+  | QuasiQuotePat   (HsQuasiQuote id)
+
 	------------ Literal and n+k patterns ---------------
   | LitPat	    HsLit		-- Used for *non-overloaded* literal patterns:
 					-- Int#, Char#, Int, Char, String, etc.
@@ -200,6 +206,14 @@ hsRecFields :: HsRecFields id arg -> [id]
 hsRecFields rbinds = map (unLoc . hsRecFieldId) (rec_flds rbinds)
 \end{code}
 
+\begin{code}
+data HsQuasiQuote id = HsQuasiQuote 
+		       id
+		       id
+		       SrcSpan
+		       FastString
+\end{code}
+
 
 %************************************************************************
 %*									*
@@ -247,14 +261,20 @@ pprPat (LitPat s)	      = ppr s
 pprPat (NPat l Nothing  _)  = ppr l
 pprPat (NPat l (Just _) _)  = char '-' <> ppr l
 pprPat (NPlusKPat n k _ _)    = hcat [ppr n, char '+', ppr k]
+pprPat (QuasiQuotePat (HsQuasiQuote name quoter _ quote)) 
+    = char '$' <> brackets (ppr name) <>
+      ptext SLIT("[:") <> ppr quoter <> ptext SLIT("|") <>
+      ppr quote <> ptext SLIT("|]")
 pprPat (TypePat ty)	      = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
 pprPat (CoPat co pat _)	      = parens (pprHsWrapper (ppr pat) co)
 pprPat (SigPatIn pat ty)      = ppr pat <+> dcolon <+> ppr ty
 pprPat (SigPatOut pat ty)     = ppr pat <+> dcolon <+> ppr ty
 
+pprUserCon :: (Outputable con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
 pprUserCon c details          = ppr c <+> pprConArgs details
 
+pprConArgs ::  OutputableBndr id => HsConPatDetails id -> SDoc
 pprConArgs (PrefixCon pats) = interppSP pats
 pprConArgs (InfixCon p1 p2) = interppSP [p1,p2]
 pprConArgs (RecCon rpats)   = ppr rpats
@@ -307,7 +327,7 @@ mkCoPat co pat ty
   | otherwise        = CoPat co pat ty
 
 mkCoPatCoI :: CoercionI -> Pat id -> Type -> Pat id
-mkCoPatCoI IdCo     pat ty = pat
+mkCoPatCoI IdCo     pat _  = pat
 mkCoPatCoI (ACo co) pat ty = mkCoPat (WpCo co) pat ty
 \end{code}
 
@@ -342,39 +362,43 @@ patterns are treated specially, of course.
 
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 \begin{code}
+isWildPat :: Pat id -> Bool
 isWildPat (WildPat _) = True
-isWildPat other	      = False
+isWildPat _           = False
 
 patsAreAllCons :: [Pat id] -> Bool
 patsAreAllCons pat_list = all isConPat pat_list
 
+isConPat :: Pat id -> Bool
 isConPat (AsPat _ pat)	 = isConPat (unLoc pat)
 isConPat (ConPatIn {})	 = True
 isConPat (ConPatOut {})  = True
 isConPat (ListPat {})	 = True
 isConPat (PArrPat {})	 = True
 isConPat (TuplePat {})	 = True
-isConPat other		 = False
+isConPat _               = False
 
+isSigPat :: Pat id -> Bool
 isSigPat (SigPatIn _ _)  = True
 isSigPat (SigPatOut _ _) = True
-isSigPat other		 = False
+isSigPat _               = False
 
 patsAreAllLits :: [Pat id] -> Bool
 patsAreAllLits pat_list = all isLitPat pat_list
 
+isLitPat :: Pat id -> Bool
 isLitPat (AsPat _ pat)	        = isLitPat (unLoc pat)
 isLitPat (LitPat _)	        = True
 isLitPat (NPat _ _ _)	        = True
 isLitPat (NPlusKPat _ _ _ _)    = True
-isLitPat other		        = False
+isLitPat _                      = False
 
 isBangHsBind :: HsBind id -> Bool
 -- In this module because HsPat is above HsBinds in the import graph
-isBangHsBind (PatBind { pat_lhs = L _ (BangPat p) }) = True
-isBangHsBind bind				     = False
+isBangHsBind (PatBind { pat_lhs = L _ (BangPat _) }) = True
+isBangHsBind _                                       = False
 
-isIrrefutableHsPat :: LPat id -> Bool
+isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool
 -- (isIrrefutableHsPat p) is true if matching against p cannot fail,
 -- in the sense of falling through to the next pattern.
 --	(NB: this is not quite the same as the (silly) defn
@@ -391,7 +415,7 @@ isIrrefutableHsPat pat
     go1 (WildPat _)         = True
     go1 (VarPat _)          = True
     go1 (VarPatOut _ _)     = True
-    go1 (LazyPat pat)       = True
+    go1 (LazyPat _)         = True
     go1 (BangPat pat)       = go pat
     go1 (CoPat _ pat _)     = go1 pat
     go1 (ParPat pat)        = go pat
@@ -400,8 +424,8 @@ isIrrefutableHsPat pat
     go1 (SigPatIn pat _)    = go pat
     go1 (SigPatOut pat _)   = go pat
     go1 (TuplePat pats _ _) = all go pats
-    go1 (ListPat pats _)    = False
-    go1 (PArrPat pats _)    = False	-- ?
+    go1 (ListPat _ _)       = False
+    go1 (PArrPat _ _)       = False	-- ?
 
     go1 (ConPatIn _ _) = False	-- Conservative
     go1 (ConPatOut{ pat_con = L _ con, pat_args = details }) 
@@ -412,6 +436,10 @@ isIrrefutableHsPat pat
     go1 (NPat _ _ _)	   = False
     go1 (NPlusKPat _ _ _ _) = False
 
-    go1 (TypePat _)   = panic "isIrrefutableHsPat: type pattern"
+    go1 (QuasiQuotePat {}) = urk pat	-- Gotten rid of by renamer, before
+					-- isIrrefutablePat is called
+    go1 (TypePat {})       = urk pat
+
+    urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
 \end{code}