Remove the unused HsExpr constructor DictPat

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 9f3bad0..ace132c 100644 (file)
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -608,7 +608,7 @@ has_nplusk_pat (PArrPat ps _)                    = any has_nplusk_lpat ps
 has_nplusk_pat (LazyPat p)                          = False    -- Why?
 has_nplusk_pat (BangPat p)                          = has_nplusk_lpat p        -- I think
 has_nplusk_pat (ConPatOut { pat_args = ps }) = any has_nplusk_lpat (hsConArgs ps)
-has_nplusk_pat p = False       -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat, DictPat
+has_nplusk_pat p = False       -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat
 
 simplify_lpat :: LPat Id -> LPat Id  
 simplify_lpat p = fmap simplify_pat p
@@ -661,15 +661,6 @@ simplify_pat (NPat lit mb_neg eq lit_ty) = tidyNPat lit mb_neg eq lit_ty
 simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2)
    = WildPat (idType (unLoc id))
 
-simplify_pat (DictPat dicts methods)
-  = case num_of_d_and_ms of
-       0 -> simplify_pat (TuplePat [] Boxed unitTy) 
-       1 -> simplify_pat (head dict_and_method_pats) 
-       _ -> simplify_pat (mkVanillaTuplePat (map noLoc dict_and_method_pats) Boxed)
-    where
-       num_of_d_and_ms  = length dicts + length methods
-       dict_and_method_pats = map VarPat (dicts ++ methods)
-
 simplify_pat (CoPat co pat ty) = simplify_pat pat 
 
 -----------------

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 5294320..52c2674 100644 (file)
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -447,15 +447,6 @@ tidy1 v (TuplePat pats boxity ty)
     arity = length pats
     tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty
 
-tidy1 v (DictPat dicts methods)
-  = case num_of_d_and_ms of
-       0 -> tidy1 v (TuplePat [] Boxed unitTy) 
-       1 -> tidy1 v (unLoc (head dict_and_method_pats))
-       _ -> tidy1 v (mkVanillaTuplePat dict_and_method_pats Boxed)
-  where
-    num_of_d_and_ms     = length dicts + length methods
-    dict_and_method_pats = map nlVarPat (dicts ++ methods)
-
 -- LitPats: we *might* be able to replace these w/ a simpler form
 tidy1 v (LitPat lit)
   = returnDs (idDsWrapper, tidyLitPat lit)

diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index e434779..42da265 100644 (file)
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -125,11 +125,6 @@ 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      HsWrapper               -- If co::t1 -> t2, p::t2, 
                                        -- then (CoPat co p) :: t1
@@ -211,9 +206,6 @@ 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
-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
@@ -305,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
@@ -359,6 +350,5 @@ isIrrefutableHsPat pat
     go1 (NPlusKPat _ _ _ _) = False
 
     go1 (TypePat _)   = panic "isIrrefutableHsPat: type pattern"
-    go1 (DictPat _ _) = panic "isIrrefutableHsPat: type pattern"
 \end{code}
 

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index bd1fc21..c1d1a10 100644 (file)
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -393,8 +393,6 @@ collectl (L l pat) bndrs
     go (SigPatIn pat _)                  = collectl pat bndrs
     go (SigPatOut pat _)         = collectl pat bndrs
     go (TypePat ty)               = bndrs
-    go (DictPat ids1 ids2)        = map noLoc ids1 ++ map noLoc ids2
-                                   ++ bndrs
     go (CoPat _ pat ty)           = collectl (noLoc pat) bndrs
 \end{code}
 

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 56c98dc..eaa7b23 100644 (file)
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -86,11 +86,6 @@ hsPatType (SigPatOut pat ty)     = ty
 hsPatType (NPat lit _ _ ty)        = ty
 hsPatType (NPlusKPat id _ _ _)      = idType (unLoc id)
 hsPatType (CoPat _ _ ty)           = ty
-hsPatType (DictPat ds ms)           = case (ds ++ ms) of
-                                      []  -> unitTy
-                                      [d] -> idType d
-                                      ds  -> mkTupleTy Boxed (length ds) (map idType ds)
-
 
 hsLitType :: HsLit -> TcType
 hsLitType (HsChar c)       = charTy
@@ -751,11 +746,6 @@ zonk_pat env (NPlusKPat (L loc n) lit e1 e2)
        ; e2' <- zonkExpr env e2
        ; return (extendZonkEnv1 env n', NPlusKPat (L loc n') lit' e1' e2') }
 
-zonk_pat env (DictPat ds ms)
-  = do { ds' <- zonkIdBndrs env ds
-       ; ms' <- zonkIdBndrs env ms
-       ; return (extendZonkEnv env (ds' ++ ms'), DictPat ds' ms') }
-
 zonk_pat env (CoPat co_fn pat ty) 
   = do { (env', co_fn') <- zonkCoFn env co_fn
        ; (env'', pat') <- zonkPat env' (noLoc pat)

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index ff08a28..097402f 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -471,7 +471,7 @@ tc_pat pstate pat@(NPlusKPat (L nm_loc name) lit ge minus) pat_ty thing_inside
        ; res <- tcExtendIdEnv1 name bndr_id (thing_inside pstate)
        ; returnM (NPlusKPat (L nm_loc bndr_id) lit' ge' minus', [], res) }
 
-tc_pat _ _other_pat _ _ = panic "tc_pat"       -- DictPat, ConPatOut, SigPatOut, VarPatOut
+tc_pat _ _other_pat _ _ = panic "tc_pat"       -- ConPatOut, SigPatOut, VarPatOut
 \end{code}