X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsPat.lhs;h=42da26554a748a383f36cf2629b0e8b36cdadbb3;hb=74b27e20425336403d80e942ee3faf00f8c36ef8;hp=aa1568d27fe1066cb8dd5ffe1699b471e779cbd4;hpb=247fd64109002ed88c27bc5d6cfea6a71ee48cfa;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index aa1568d..42da265 100644
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[PatSyntax]{Abstract Haskell syntax---patterns}
@@ -8,6 +9,7 @@ module HsPat (
 	Pat(..), InPat, OutPat, LPat, 
 	
 	HsConDetails(..), hsConArgs,
+	HsRecField(..), mkRecField,
 
 	mkPrefixConPat, mkCharLitPat, mkNilPat, mkCoPat,
 
@@ -22,20 +24,20 @@ module HsPat (
 import {-# SOURCE #-} HsExpr		( SyntaxExpr )
 
 -- friends:
-import HsBinds		( DictBinds, HsBind(..), ExprCoFn, isIdCoercion, pprCoFn,
-			  emptyLHsBinds, pprLHsBinds )
-import HsLit		( HsLit(HsCharPrim), HsOverLit )
-import HsTypes		( LHsType, PostTcType )
-import BasicTypes	( Boxity, tupleParens )
+import HsBinds
+import HsLit
+import HsTypes
+import HsDoc
+import BasicTypes
 -- others:
 import PprCore		( {- instance OutputableBndr TyVar -} )
-import TysWiredIn	( nilDataCon, charDataCon, charTy )
-import Var		( TyVar )
-import DataCon		( DataCon, dataConTyCon )
-import TyCon		( isProductTyCon )
+import TysWiredIn
+import Var
+import DataCon
+import TyCon
 import Outputable	
-import Type		( Type )
-import SrcLoc		( Located(..), unLoc, noLoc )
+import Type
+import SrcLoc
 \end{code}
 
 
@@ -48,6 +50,9 @@ type LPat id = Located (Pat id)
 data Pat id
   =	------------ Simple patterns ---------------
     WildPat	PostTcType		-- Wild card
+	-- The sole reason for a type on a WildPat is to
+	-- support hsPatType :: Pat Id -> Type
+
   | VarPat	id			-- Variable
   | VarPatOut	id (DictBinds id)	-- Used only for overloaded Ids; the 
 					-- bindings give its overloaded instances
@@ -120,16 +125,11 @@ data Pat id
   | SigPatOut	    (LPat id)		-- Pattern with a type signature
 		    Type
 
-	------------ Dictionary patterns (translation only) ---------------
-  | DictPat	    -- Used when destructing Dictionaries with an explicit case
-		    [id]		-- Superclass dicts
-		    [id]		-- Methods
-
 	------------ Pattern coercions (translation only) ---------------
-  | CoPat 	ExprCoFn		-- If co::t1 -> t2, p::t2, 
+  | CoPat 	HsWrapper		-- If co::t1 -> t2, p::t2, 
 					-- then (CoPat co p) :: t1
 		(Pat id)		-- Why not LPat?  Ans: existing locn will do
-	    	Type
+	    	Type			-- Type of whole pattern, t1
 	-- During desugaring a (CoPat co pat) turns into a cast with 'co' on 
 	-- the scrutinee, followed by a match on 'pat'
 \end{code}
@@ -138,13 +138,21 @@ HsConDetails is use both for patterns and for data type declarations
 
 \begin{code}
 data HsConDetails id arg
-  = PrefixCon [arg]			-- C p1 p2 p3
-  | RecCon    [(Located id, arg)]	-- C { x = p1, y = p2 }
-  | InfixCon  arg arg			-- p1 `C` p2
+  = PrefixCon [arg]               -- C p1 p2 p3
+  | RecCon    [HsRecField id arg] -- C { x = p1, y = p2 }
+  | InfixCon  arg arg		  -- p1 `C` p2
+
+data HsRecField id arg = HsRecField {
+	hsRecFieldId  :: Located id,
+	hsRecFieldArg :: arg,
+	hsRecFieldDoc :: Maybe (LHsDoc id)
+}
+
+mkRecField id arg = HsRecField id arg Nothing
 
 hsConArgs :: HsConDetails id arg -> [arg]
 hsConArgs (PrefixCon ps)   = ps
-hsConArgs (RecCon fs)      = map snd fs
+hsConArgs (RecCon fs)      = map hsRecFieldArg fs
 hsConArgs (InfixCon p1 p2) = [p1,p2]
 \end{code}
 
@@ -195,12 +203,9 @@ pprPat (NPat l Nothing  _ _)  = ppr l
 pprPat (NPat l (Just _) _ _)  = char '-' <> ppr l
 pprPat (NPlusKPat n k _ _)    = hcat [ppr n, char '+', ppr k]
 pprPat (TypePat ty)	      = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
-pprPat (CoPat co pat _)	      = parens (pprCoFn (ppr pat) co)
+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
-pprPat (DictPat ds ms)	      = parens (sep [ptext SLIT("{-dict-}"),
-					     brackets (interpp'SP ds),
-					     brackets (interpp'SP ms)])
 
 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
 pprUserCon c details          = ppr c <+> pprConArgs details
@@ -209,13 +214,17 @@ pprConArgs (PrefixCon pats) = interppSP pats
 pprConArgs (InfixCon p1 p2) = interppSP [p1,p2]
 pprConArgs (RecCon rpats)   = braces (hsep (punctuate comma (map (pp_rpat) rpats)))
 			    where
-			      pp_rpat (v, p) = hsep [ppr v, char '=', ppr p]
-
+			      pp_rpat (HsRecField v p _d) = 
+                                hsep [ppr v, char '=', ppr p]
 
 -- add parallel array brackets around a document
 --
 pabrackets   :: SDoc -> SDoc
 pabrackets p  = ptext SLIT("[:") <> p <> ptext SLIT(":]")
+
+instance (OutputableBndr id, Outputable arg) =>
+         Outputable (HsRecField id arg) where
+    ppr (HsRecField n ty doc) = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
 \end{code}
 
 
@@ -239,9 +248,9 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] ty
 mkCharLitPat :: Char -> OutPat id
 mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
 
-mkCoPat :: ExprCoFn -> OutPat id -> Type -> OutPat id
+mkCoPat :: HsWrapper -> OutPat id -> Type -> OutPat id
 mkCoPat co lpat@(L loc pat) ty
-  | isIdCoercion co = lpat
+  | isIdHsWrapper co = lpat
   | otherwise = L loc (CoPat co pat ty)
 \end{code}
 
@@ -288,7 +297,6 @@ isConPat (ConPatOut {})  = True
 isConPat (ListPat {})	 = True
 isConPat (PArrPat {})	 = True
 isConPat (TuplePat {})	 = True
-isConPat (DictPat ds ms) = (length ds + length ms) > 1
 isConPat other		 = False
 
 isSigPat (SigPatIn _ _)  = True
@@ -342,6 +350,5 @@ isIrrefutableHsPat pat
     go1 (NPlusKPat _ _ _ _) = False
 
     go1 (TypePat _)   = panic "isIrrefutableHsPat: type pattern"
-    go1 (DictPat _ _) = panic "isIrrefutableHsPat: type pattern"
 \end{code}