X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsPat.lhs;h=71aba6b71fee48f3bce8c3a563e36ec0d9c9f001;hb=e26dd9a959b7b7810c2e2089940422092a95f2e3;hp=09494a1ad1c047660ebd4b3468bf2b9b44b263a3;hpb=77a8c0dbd5c5ad90fe483cb9ddc2b6ef36d3f4d8;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
index 09494a1..71aba6b 100644
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ b/ghc/compiler/hsSyn/HsPat.lhs
@@ -5,231 +5,227 @@
 
 \begin{code}
 module HsPat (
-	InPat(..),
-	OutPat(..),
+	Pat(..), InPat, OutPat, 
+	
+	HsConDetails(..), hsConArgs,
 
-	irrefutablePat, irrefutablePats,
-	failureFreePat, isWildPat,
-	patsAreAllCons, isConPat,
+	mkPrefixConPat, mkCharLitPat, mkNilPat,
+
+	failureFreePat, isWildPat, 
+	patsAreAllCons, isConPat, isSigPat,
 	patsAreAllLits,	isLitPat,
 	collectPatBinders, collectPatsBinders,
-	collectSigTysFromPats
+	collectSigTysFromPat, collectSigTysFromPats
     ) where
 
 #include "HsVersions.h"
 
--- friends:
-import HsBasic		( HsLit )
-import HsExpr		( HsExpr )
-import HsTypes		( HsType )
-import BasicTypes	( Fixity, Boxity, tupleParens )
 
+import {-# SOURCE #-} HsExpr		( HsExpr )
+
+-- friends:
+import HsLit		( HsLit(HsCharPrim), HsOverLit )
+import HsTypes		( HsType, SyntaxName, PostTcType )
+import BasicTypes	( Boxity, tupleParens )
 -- others:
-import Var		( Id, TyVar )
+import TysWiredIn	( nilDataCon, charDataCon, charTy )
+import Var		( TyVar )
 import DataCon		( DataCon, dataConTyCon )
-import Name		( isDataSymOcc, getOccName, NamedThing )
 import Maybes		( maybeToBool )
 import Outputable	
 import TyCon		( maybeTyConSingleCon )
 import Type		( Type )
 \end{code}
 
-Patterns come in distinct before- and after-typechecking flavo(u)rs.
-\begin{code}
-data InPat name
-  = WildPatIn				-- wild card
-  | VarPatIn	    name		-- variable
-  | LitPatIn	    HsLit		-- literal
-  | LazyPatIn	    (InPat name)	-- lazy pattern
-  | AsPatIn	    name		-- as pattern
-		    (InPat name)
-  | SigPatIn	    (InPat name)
-		    (HsType name)
-  | ConPatIn	    name		-- constructed type
-		    [InPat name]
-  | ConOpPatIn	    (InPat name)
-		    name
-		    Fixity		-- c.f. OpApp in HsExpr
-		    (InPat name)
-
-  | NPlusKPatIn	    name		--  n+k pattern
-		    HsLit
-
-  -- We preserve prefix negation and parenthesis for the precedence parser.
-
-  | NegPatIn	    (InPat name)	-- negated pattern
-  | ParPatIn        (InPat name)	-- parenthesised pattern
-
-  | ListPatIn	    [InPat name]	-- syntactic list
-					-- must have >= 1 elements
-  | TuplePatIn	    [InPat name] Boxity	-- tuple (boxed?)
-
-  | RecPatIn	    name 		-- record
-		    [(name, InPat name, Bool)]	-- True <=> source used punning
-
-data OutPat id
-  = WildPat	    Type	-- wild card
-  | VarPat	    id		-- variable (type is in the Id)
-  | LazyPat	    (OutPat id)	-- lazy pattern
-  | AsPat	    id		-- as pattern
-		    (OutPat id)
-
-  | ListPat		 	-- syntactic list
-		    Type	-- the type of the elements
-   	    	    [OutPat id]
-
-  | TuplePat	    [OutPat id]	-- tuple
-		    Boxity
-						-- UnitPat is TuplePat []
-
-  | ConPat	    DataCon
-		    Type    	-- the type of the pattern
-		    [TyVar]	-- Existentially bound type variables
-		    [id]	-- Ditto dictionaries
-		    [OutPat id]
-
-  -- ConOpPats are only used on the input side
-
-  | RecPat	    DataCon		-- record constructor
-		    Type    	-- the type of the pattern
-		    [TyVar]	-- Existentially bound type variables
-		    [id]		-- Ditto dictionaries
-		    [(Id, OutPat id, Bool)]	-- True <=> source used punning
-
-  | LitPat	    -- Used for *non-overloaded* literal patterns:
-		    -- Int#, Char#, Int, Char, String, etc.
-		    HsLit
-		    Type 	-- type of pattern
-
-  | NPat	    -- Used for *overloaded* literal patterns
-		    HsLit			-- the literal is retained so that
-						-- the desugarer can readily identify
-						-- equations with identical literal-patterns
-		    Type 	-- type of pattern, t
-   	    	    (HsExpr id (OutPat id))
-						-- of type t -> Bool; detects match
-
-  | NPlusKPat	    id
-		    HsLit			-- Same reason as for LitPat
-						-- (This could be an Integer, but then
-						-- it's harder to partitionEqnsByLit
-						-- in the desugarer.)
-		    Type    	-- Type of pattern, t
-   	    	    (HsExpr id (OutPat id)) 	-- Of type t -> Bool; detects match
-   	    	    (HsExpr id (OutPat id)) 	-- Of type t -> t; subtracts k
 
+\begin{code}
+type InPat id = Pat id		-- No 'Out' constructors
+type OutPat id = Pat id		-- No 'In' constructors
+
+data Pat id
+  =	------------ Simple patterns ---------------
+    WildPat	PostTcType		-- Wild card
+  | VarPat	id			-- Variable
+  | LazyPat	(Pat id)		-- Lazy pattern
+  | AsPat	id (Pat id)		-- As pattern
+  | ParPat      (Pat id)		-- Parenthesised pattern
+
+	------------ Lists, tuples, arrays ---------------
+  | ListPat	[Pat id]		-- Syntactic list
+		PostTcType		-- The type of the elements
+   	    	    
+  | TuplePat	[Pat id]		-- Tuple
+		Boxity			-- UnitPat is TuplePat []
+
+  | PArrPat	[Pat id]		-- Syntactic parallel array
+		PostTcType		-- The type of the elements
+
+	------------ Constructor patterns ---------------
+  | ConPatIn	id 
+		(HsConDetails id (Pat id))
+
+  | ConPatOut	DataCon 
+		(HsConDetails id (Pat id))
+		Type    		-- The type of the pattern
+		[TyVar]			-- Existentially bound type variables
+		[id]			-- Ditto dictionaries
+
+	------------ Literal and n+k patterns ---------------
+  | LitPat	    HsLit		-- Used for *non-overloaded* literal patterns:
+					-- Int#, Char#, Int, Char, String, etc.
+
+  | NPatIn	    HsOverLit 		-- Always positive
+		    (Maybe SyntaxName)	-- Just (Name of 'negate') for negative
+					-- patterns, Nothing otherwise
+
+  | NPatOut	    HsLit		-- Used for literal patterns where there's an equality function to call
+		    			-- The literal is retained so that the desugarer can readily identify
+					-- equations with identical literal-patterns
+					-- Always HsInteger, HsRat or HsString.
+					-- Always HsInteger, HsRat or HsString.
+					-- *Unlike* NPatIn, for negative literals, the
+					-- 	literal is acutally negative!
+		    Type	 	-- Type of pattern, t
+   	    	    (HsExpr id)		-- Of type t -> Bool; detects match
+
+  | NPlusKPatIn	    id			-- n+k pattern
+		    HsOverLit		-- It'll always be an HsIntegral
+		    SyntaxName		-- Name of '-' (see RnEnv.lookupSyntaxName)
+
+  | NPlusKPatOut    id
+		    Integer
+   	    	    (HsExpr id)	 	-- Of type t -> Bool; detects match
+   	    	    (HsExpr id) 	-- Of type t -> t; subtracts k
+
+
+	------------ Generics ---------------
+  | TypePat	    (HsType id)		-- Type pattern for generic definitions
+                                        -- e.g  f{| a+b |} = ...
+                                        -- These show up only in class declarations,
+                                        -- and should be a top-level pattern
+
+	------------ Pattern type signatures ---------------
+  | SigPatIn	    (Pat id)		-- Pattern with a type signature
+		    (HsType id)
+
+  | SigPatOut	    (Pat id)		-- Pattern p
+		    Type		-- Type, t, of the whole pattern
+		    (HsExpr id)		-- Coercion function,
+						-- of type t -> typeof(p)
+
+	------------ Dictionary patterns (translation only) ---------------
   | DictPat	    -- Used when destructing Dictionaries with an explicit case
 		    [id]			-- superclass dicts
 		    [id]			-- methods
 \end{code}
 
-Now name in Inpat is not need to be in NAmedThing to be Outputable.
-Needed by ../deSugar/Check.lhs
+HsConDetails is use both for patterns and for data type declarations
+
+\begin{code}
+data HsConDetails id arg
+  = PrefixCon [arg]			-- C p1 p2 p3
+  | RecCon    [(id, arg)]		-- C { x = p1, y = p2 }
+  | InfixCon  arg arg			-- p1 `C` p2
+
+hsConArgs :: HsConDetails id arg -> [arg]
+hsConArgs (PrefixCon ps)   = ps
+hsConArgs (RecCon fs)      = map snd fs
+hsConArgs (InfixCon p1 p2) = [p1,p2]
+\end{code}
 
-JJQC-2-12-97
+
+%************************************************************************
+%*									*
+%* 		Printing patterns
+%*									*
+%************************************************************************
 
 \begin{code}
-instance (Outputable name) => Outputable (InPat name) where
-    ppr = pprInPat
+instance (OutputableBndr name) => Outputable (Pat name) where
+    ppr = pprPat
+
+pprPat :: (OutputableBndr name) => Pat name -> SDoc
+
+pprPat (VarPat var)	  	-- Print with type info if -dppr-debug is on
+  = getPprStyle $ \ sty ->
+    if debugStyle sty then
+	parens (pprBndr LambdaBind var)		-- Could pass the site to pprPat
+						-- but is it worth it?
+    else
+	ppr var
 
-pprInPat :: (Outputable name) => InPat name -> SDoc
+pprPat (WildPat _)	  = char '_'
+pprPat (LazyPat pat)      = char '~' <> ppr pat
+pprPat (AsPat name pat)   = parens (hcat [ppr name, char '@', ppr pat])
+pprPat (ParPat pat)	  = parens (pprPat pat)
 
-pprInPat (WildPatIn)	    = char '_'
-pprInPat (VarPatIn var)	    = ppr var
-pprInPat (LitPatIn s)	    = ppr s
-pprInPat (SigPatIn pat ty)  = ppr pat <+> dcolon <+> ppr ty
-pprInPat (LazyPatIn pat)    = char '~' <> ppr pat
-pprInPat (AsPatIn name pat) = parens (hcat [ppr name, char '@', ppr pat])
+pprPat (ListPat pats _)   = brackets (interpp'SP pats)
+pprPat (PArrPat pats _)   = pabrackets (interpp'SP pats)
+pprPat (TuplePat pats bx) = tupleParens bx (interpp'SP pats)
 
-pprInPat (ConPatIn c pats)
-  | null pats = ppr c
-  | otherwise = hsep [ppr c, interppSP pats] -- inner ParPats supply the necessary parens.
+pprPat (ConPatIn c details) 	   = pprConPat c details
+pprPat (ConPatOut c details _ _ _) = pprConPat c details
 
-pprInPat (ConOpPatIn pat1 op fixity pat2)
- = hsep [ppr pat1, ppr op, ppr pat2] -- ParPats put in parens
+pprPat (LitPat s)	      = ppr s
+pprPat (NPatIn l _)	      = ppr l
+pprPat (NPatOut l _ _)        = ppr l
+pprPat (NPlusKPatIn n k _)    = hcat [ppr n, char '+', ppr k]
+pprPat (NPlusKPatOut n k _ _) = hcat [ppr n, char '+', integer k]
 
+pprPat (TypePat ty) = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
+
+pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
+pprPat (SigPatOut pat ty _) = ppr pat <+> dcolon <+> ppr ty
+
+pprPat (DictPat dicts methods)
+ = parens (sep [ptext SLIT("{-dict-}"),
+		  brackets (interpp'SP dicts),
+		  brackets (interpp'SP methods)])
+
+
+
+pprConPat con (PrefixCon pats) 	   = ppr con <+> interppSP pats -- inner ParPats supply the necessary parens.
+pprConPat con (InfixCon pat1 pat2) = hsep [ppr pat1, ppr con, ppr pat2] -- ParPats put in parens
 	-- ToDo: use pprSym to print op (but this involves fiddling various
 	-- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
-
-pprInPat (NegPatIn pat)
-  = let
-	pp_pat = pprInPat pat
-    in
-    char '-' <> (
-    case pat of
-      LitPatIn _ -> pp_pat
-      _          -> parens pp_pat
-    )
-
-pprInPat (ParPatIn pat)
-  = parens (pprInPat pat)
-
-pprInPat (ListPatIn pats)
-  = brackets (interpp'SP pats)
-pprInPat (TuplePatIn pats boxity)
-  = tupleParens boxity (interpp'SP pats)
-pprInPat (NPlusKPatIn n k)
-  = parens (hcat [ppr n, char '+', ppr k])
-
-pprInPat (RecPatIn con rpats)
-  = hsep [ppr con, braces (hsep (punctuate comma (map (pp_rpat) rpats)))]
+pprConPat con (RecCon rpats)
+  = ppr con <+> braces (hsep (punctuate comma (map (pp_rpat) rpats)))
   where
-    pp_rpat (v, _, True) = ppr v
-    pp_rpat (v, p, _)    = hsep [ppr v, char '=', ppr p]
-\end{code}
+    pp_rpat (v, p) = hsep [ppr v, char '=', ppr p]
 
-\begin{code}
-instance (NamedThing id, Outputable id) => Outputable (OutPat id) where
-    ppr = pprOutPat
+
+-- add parallel array brackets around a document
+--
+pabrackets   :: SDoc -> SDoc
+pabrackets p  = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 \end{code}
 
-\begin{code}
-pprOutPat (WildPat ty)	= char '_'
-pprOutPat (VarPat var)	= ppr var
-pprOutPat (LazyPat pat)	= hcat [char '~', ppr pat]
-pprOutPat (AsPat name pat)
-  = parens (hcat [ppr name, char '@', ppr pat])
-
-pprOutPat (ConPat name ty [] [] [])
-  = ppr name
-
--- Kludge to get infix constructors to come out right
--- when ppr'ing desugar warnings.
-pprOutPat (ConPat name ty tyvars dicts pats)
-  = getPprStyle $ \ sty ->
-    parens      $
-    case pats of
-      [p1,p2] 
-        | userStyle sty && isDataSymOcc (getOccName name) ->
-	    hsep [ppr p1, ppr name, ppr p2]
-      _ -> hsep [ppr name, interppSP tyvars, interppSP dicts, interppSP pats]
-
-pprOutPat (ListPat ty pats)      = brackets (interpp'SP pats)
-pprOutPat (TuplePat pats boxity) = tupleParens boxity (interpp'SP pats)
-
-pprOutPat (RecPat con ty tvs dicts rpats)
-  = hsep [ppr con, interppSP tvs, interppSP dicts, braces (hsep (punctuate comma (map (pp_rpat) rpats)))]
-  where
-    pp_rpat (v, _, True) = ppr v
-    pp_rpat (v, p, _)    = hsep [ppr v, char '=', ppr p]
 
-pprOutPat (LitPat l ty) 	= ppr l	-- ToDo: print more
-pprOutPat (NPat   l ty e)	= ppr l	-- ToDo: print more
-pprOutPat (NPlusKPat n k ty e1 e2)		-- ToDo: print more
-  = parens (hcat [ppr n, char '+', ppr k])
+%************************************************************************
+%*									*
+%* 		Building patterns
+%*									*
+%************************************************************************
 
-pprOutPat (DictPat dicts methods)
- = parens (sep [ptext SLIT("{-dict-}"),
-		  brackets (interpp'SP dicts),
-		  brackets (interpp'SP methods)])
+\begin{code}
+mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
+-- Make a vanilla Prefix constructor pattern
+mkPrefixConPat dc pats ty = ConPatOut dc (PrefixCon pats) ty [] []
+
+mkNilPat :: Type -> OutPat id
+mkNilPat ty = mkPrefixConPat nilDataCon [] ty
 
+mkCharLitPat :: Int -> OutPat id
+mkCharLitPat c = mkPrefixConPat charDataCon [LitPat (HsCharPrim c)] charTy
 \end{code}
 
+
 %************************************************************************
 %*									*
-%* predicates for checking things about pattern-lists in EquationInfo	*
+%* Predicates for checking things about pattern-lists in EquationInfo	*
 %*									*
 %************************************************************************
+
 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
 
 Unlike in the Wadler chapter, where patterns are either ``variables''
@@ -254,29 +250,30 @@ patterns are treated specially, of course.
 
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 \begin{code}
-irrefutablePats :: [OutPat id] -> Bool
-irrefutablePats pat_list = all irrefutablePat pat_list
-
-irrefutablePat (AsPat	_ pat)	= irrefutablePat pat
-irrefutablePat (WildPat	_)	= True
-irrefutablePat (VarPat	_)	= True
-irrefutablePat (LazyPat	_)	= True
-irrefutablePat (DictPat ds ms)	= (length ds + length ms) <= 1
-irrefutablePat other		= False
-
 failureFreePat :: OutPat id -> Bool
 
 failureFreePat (WildPat _) 		  = True
 failureFreePat (VarPat _)  		  = True
 failureFreePat (LazyPat	_) 		  = True
+failureFreePat (ParPat	_) 		  = True
 failureFreePat (AsPat _ pat)		  = failureFreePat pat
-failureFreePat (ConPat con tys _ _ pats)  = only_con con && all failureFreePat pats
-failureFreePat (RecPat con _ _ _ fields)  = only_con con && and [ failureFreePat pat | (_,pat,_) <- fields ]
+
 failureFreePat (ListPat _ _)		  = False
+failureFreePat (PArrPat _ _)		  = False
 failureFreePat (TuplePat pats _)	  = all failureFreePat pats
+
+failureFreePat (ConPatOut con ps _ _ _)   = only_con con && failure_free_con ps
+
+failureFreePat (SigPatOut p _ _)	  = failureFreePat p
+
 failureFreePat (DictPat _ _)		  = True
+
 failureFreePat other_pat		  = False   -- Literals, NPat
 
+failure_free_con (PrefixCon pats) = all failureFreePat pats
+failure_free_con (InfixCon p1 p2) = failureFreePat p1 && failureFreePat p2
+failure_free_con (RecCon fs)      = all (failureFreePat . snd) fs
+
 only_con con = maybeToBool (maybeTyConSingleCon (dataConTyCon con))
 \end{code}
 
@@ -284,71 +281,97 @@ only_con con = maybeToBool (maybeTyConSingleCon (dataConTyCon con))
 isWildPat (WildPat _) = True
 isWildPat other	      = False
 
-patsAreAllCons :: [OutPat id] -> Bool
+patsAreAllCons :: [Pat id] -> Bool
 patsAreAllCons pat_list = all isConPat pat_list
 
 isConPat (AsPat _ pat)		= isConPat pat
-isConPat (ConPat _ _ _ _ _)	= True
+isConPat (ConPatIn _ _)		= True
+isConPat (ConPatOut _ _ _ _ _)	= True
 isConPat (ListPat _ _)		= True
+isConPat (PArrPat _ _)		= True
 isConPat (TuplePat _ _)		= True
-isConPat (RecPat _ _ _ _ _)	= True
 isConPat (DictPat ds ms)	= (length ds + length ms) > 1
 isConPat other			= False
 
-patsAreAllLits :: [OutPat id] -> Bool
+isSigPat (SigPatIn _ _)    = True
+isSigPat (SigPatOut _ _ _) = True
+isSigPat other		   = False
+
+patsAreAllLits :: [Pat id] -> Bool
 patsAreAllLits pat_list = all isLitPat pat_list
 
-isLitPat (AsPat _ pat)	       = isLitPat pat
-isLitPat (LitPat _ _)	       = True
-isLitPat (NPat   _ _ _)	       = True
-isLitPat (NPlusKPat _ _ _ _ _) = True
-isLitPat other		       = False
+isLitPat (AsPat _ pat)	        = isLitPat pat
+isLitPat (LitPat _)	        = True
+isLitPat (NPatIn _ _)	        = True
+isLitPat (NPatOut   _ _ _)      = True
+isLitPat (NPlusKPatIn _ _ _)    = True
+isLitPat (NPlusKPatOut _ _ _ _) = True
+isLitPat other		        = False
 \end{code}
 
+%************************************************************************
+%*									*
+%* 		Gathering stuff out of patterns
+%*									*
+%************************************************************************
+
 This function @collectPatBinders@ works with the ``collectBinders''
 functions for @HsBinds@, etc.  The order in which the binders are
 collected is important; see @HsBinds.lhs@.
 
+It collects the bounds *value* variables in renamed patterns; type variables
+are *not* collected.
+
 \begin{code}
-collectPatBinders :: InPat a -> [a]
+collectPatBinders :: Pat a -> [a]
 collectPatBinders pat = collect pat []
 
-collectPatsBinders :: [InPat a] -> [a]
+collectPatsBinders :: [Pat a] -> [a]
 collectPatsBinders pats = foldr collect [] pats
 
-collect WildPatIn	      	 bndrs = bndrs
-collect (VarPatIn var)      	 bndrs = var : bndrs
-collect (LitPatIn _)	      	 bndrs = bndrs
+collect (WildPat _)	      	 bndrs = bndrs
+collect (VarPat var)      	 bndrs = var : bndrs
+collect (LazyPat pat)     	 bndrs = collect pat bndrs
+collect (AsPat a pat)     	 bndrs = a : collect pat bndrs
+collect (ParPat  pat)     	 bndrs = collect pat bndrs
+
+collect (ListPat pats _)    	 bndrs = foldr collect bndrs pats
+collect (PArrPat pats _)    	 bndrs = foldr collect bndrs pats
+collect (TuplePat pats _)  	 bndrs = foldr collect bndrs pats
+
+collect (ConPatIn c ps)   	 bndrs = foldr collect bndrs (hsConArgs ps)
+collect (ConPatOut c ps _ _ ds)	 bndrs = ds ++ foldr collect bndrs (hsConArgs ps)
+
+collect (LitPat _)	      	 bndrs = bndrs
+collect (NPatIn _ _)		 bndrs = bndrs
+collect (NPatOut _ _ _)		 bndrs = bndrs
+
+collect (NPlusKPatIn n _ _)      bndrs = n : bndrs
+collect (NPlusKPatOut n _ _ _)   bndrs = n : bndrs
+
 collect (SigPatIn pat _)	 bndrs = collect pat bndrs
-collect (LazyPatIn pat)     	 bndrs = collect pat bndrs
-collect (AsPatIn a pat)     	 bndrs = a : collect pat bndrs
-collect (NPlusKPatIn n _)        bndrs = n : bndrs
-collect (ConPatIn c pats)   	 bndrs = foldr collect bndrs pats
-collect (ConOpPatIn p1 c f p2)   bndrs = collect p1 (collect p2 bndrs)
-collect (NegPatIn  pat)     	 bndrs = collect pat bndrs
-collect (ParPatIn  pat)     	 bndrs = collect pat bndrs
-collect (ListPatIn pats)    	 bndrs = foldr collect bndrs pats
-collect (TuplePatIn pats _)  	 bndrs = foldr collect bndrs pats
-collect (RecPatIn c fields) 	 bndrs = foldr (\ (f,pat,_) bndrs -> collect pat bndrs) bndrs fields
+collect (SigPatOut pat _ _)	 bndrs = collect pat bndrs
+collect (TypePat ty)             bndrs = bndrs
+collect (DictPat ids1 ids2)      bndrs = ids1 ++ ids2 ++ bndrs
 \end{code}
 
-
 \begin{code}
 collectSigTysFromPats :: [InPat name] -> [HsType name]
 collectSigTysFromPats pats = foldr collect_pat [] pats
 
-collect_pat (SigPatIn pat ty)	   acc = collect_pat pat (ty:acc)
-collect_pat WildPatIn	      	   acc = acc
-collect_pat (VarPatIn var)         acc = acc
-collect_pat (LitPatIn _)	   acc = acc
-collect_pat (LazyPatIn pat)        acc = collect_pat pat acc
-collect_pat (AsPatIn a pat)        acc = collect_pat pat acc
-collect_pat (NPlusKPatIn n _)      acc = acc
-collect_pat (ConPatIn c pats)      acc = foldr collect_pat acc pats
-collect_pat (ConOpPatIn p1 c f p2) acc = collect_pat p1 (collect_pat p2 acc)
-collect_pat (NegPatIn  pat)        acc = collect_pat pat acc
-collect_pat (ParPatIn  pat)        acc = collect_pat pat acc
-collect_pat (ListPatIn pats)       acc = foldr collect_pat acc pats
-collect_pat (TuplePatIn pats _)    acc = foldr collect_pat acc pats
-collect_pat (RecPatIn c fields)    acc = foldr (\ (f,pat,_) acc -> collect_pat pat acc) acc fields
+collectSigTysFromPat :: InPat name -> [HsType name]
+collectSigTysFromPat pat = collect_pat pat []
+
+collect_pat (SigPatIn pat ty)  acc = collect_pat pat (ty:acc)
+collect_pat (TypePat ty)       acc = ty:acc
+
+collect_pat (LazyPat pat)      acc = collect_pat pat acc
+collect_pat (AsPat a pat)      acc = collect_pat pat acc
+collect_pat (ParPat  pat)      acc = collect_pat pat acc
+collect_pat (ListPat pats _)   acc = foldr collect_pat acc pats
+collect_pat (PArrPat pats _)   acc = foldr collect_pat acc pats
+collect_pat (TuplePat pats _)  acc = foldr collect_pat acc pats
+collect_pat (ConPatIn c ps)    acc = foldr collect_pat acc (hsConArgs ps)
+collect_pat other	       acc = acc 	-- Literals, vars, wildcard
 \end{code}
+