From 74b27e20425336403d80e942ee3faf00f8c36ef8 Mon Sep 17 00:00:00 2001 From: Lemmih Date: Mon, 18 Jun 2007 12:46:05 +0000 Subject: [PATCH] Remove the unused HsExpr constructor DictPat --- compiler/deSugar/Check.lhs | 11 +---------- compiler/deSugar/Match.lhs | 9 --------- compiler/hsSyn/HsPat.lhs | 10 ---------- compiler/hsSyn/HsUtils.lhs | 2 -- compiler/typecheck/TcHsSyn.lhs | 10 ---------- compiler/typecheck/TcPat.lhs | 2 +- 6 files changed, 2 insertions(+), 42 deletions(-) diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index 9f3bad0..ace132c 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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} -- 1.7.10.4