From faca1a62c1385aa6ebdeb7d25ffa193ba2283fb9 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Fri, 5 Nov 2010 13:16:36 +0000 Subject: [PATCH] Remove the now-unused constructor VarPatOut --- compiler/deSugar/Check.lhs | 3 +-- compiler/deSugar/DsArrows.lhs | 2 -- compiler/deSugar/Match.lhs | 6 ------ compiler/hsSyn/HsPat.lhs | 5 ----- compiler/hsSyn/HsUtils.lhs | 2 -- compiler/typecheck/TcHsSyn.lhs | 6 ------ compiler/typecheck/TcPat.lhs | 12 +----------- 7 files changed, 2 insertions(+), 34 deletions(-) diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index 355055b..2432051 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -643,7 +643,7 @@ might_fail_pat (ConPatOut { pat_args = ps }) = any might_fail_lpat (hsConPatArgs -- Finally the ones that are sure to succeed, or which are covered by the checking algorithm might_fail_pat (LazyPat _) = False -- Always succeeds -might_fail_pat _ = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat +might_fail_pat _ = False -- VarPat, WildPat, LitPat, NPat, TypePat -------------- might_fail_lpat :: LPat Id -> Bool @@ -657,7 +657,6 @@ tidy_lpat p = fmap tidy_pat p tidy_pat :: Pat Id -> Pat Id tidy_pat pat@(WildPat _) = pat tidy_pat (VarPat id) = WildPat (idType id) -tidy_pat (VarPatOut id _) = WildPat (idType id) -- Ignore the bindings tidy_pat (ParPat p) = tidy_pat (unLoc p) tidy_pat (LazyPat p) = WildPat (hsLPatType p) -- For overlap and exhaustiveness checking -- purposes, a ~pat is like a wildcard diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index 89c453f..3360a95 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -1041,8 +1041,6 @@ collectl (L _ pat) bndrs = go pat where go (VarPat var) = var : bndrs - go (VarPatOut var bs) = var : collectEvBinders bs - ++ bndrs go (WildPat _) = bndrs go (LazyPat pat) = collectl pat bndrs go (BangPat pat) = collectl pat bndrs diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index c952446..9d7e124 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -468,11 +468,6 @@ tidy1 _ (WildPat ty) = return (idDsWrapper, WildPat ty) tidy1 v (VarPat var) = return (wrapBind var v, WildPat (idType var)) -tidy1 v (VarPatOut var binds) - = do { ds_ev_binds <- dsTcEvBinds binds - ; return (wrapBind var v . wrapDsEvBinds ds_ev_binds, - WildPat (idType var)) } - -- case v of { x@p -> mr[] } -- = case v of { p -> let x=v in mr[] } tidy1 v (AsPat (L _ var) pat) @@ -530,7 +525,6 @@ tidy1 _ (NPat lit mb_neg eq) tidy1 v (BangPat (L _ (LazyPat p))) = tidy1 v (BangPat p) tidy1 v (BangPat (L _ (ParPat p))) = tidy1 v (BangPat p) tidy1 _ p@(BangPat (L _(VarPat _))) = return (idDsWrapper, p) -tidy1 _ p@(BangPat (L _(VarPatOut _ _))) = return (idDsWrapper, p) tidy1 _ p@(BangPat (L _ (WildPat _))) = return (idDsWrapper, p) tidy1 _ p@(BangPat (L _ (CoPat _ _ _))) = return (idDsWrapper, p) tidy1 _ p@(BangPat (L _ (SigPatIn _ _))) = return (idDsWrapper, p) diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs index 25a350b..fe3003d 100644 --- a/compiler/hsSyn/HsPat.lhs +++ b/compiler/hsSyn/HsPat.lhs @@ -64,8 +64,6 @@ data Pat id -- support hsPatType :: Pat Id -> Type | VarPat id -- Variable - | VarPatOut id TcEvBinds -- Used only for overloaded Ids; the - -- bindings give its overloaded instances | LazyPat (LPat id) -- Lazy pattern | AsPat (Located id) (LPat id) -- As pattern | ParPat (LPat id) -- Parenthesised pattern @@ -257,7 +255,6 @@ patNeedsParens _ = False pprPat :: (OutputableBndr name) => Pat name -> SDoc pprPat (VarPat var) = pprPatBndr var -pprPat (VarPatOut var bs) = pprPatBndr var <+> braces (ppr bs) pprPat (WildPat _) = char '_' pprPat (LazyPat pat) = char '~' <> pprParendLPat pat pprPat (BangPat pat) = char '!' <> pprParendLPat pat @@ -397,7 +394,6 @@ isIrrefutableHsPat pat go1 (WildPat {}) = True go1 (VarPat {}) = True - go1 (VarPatOut {}) = True go1 (LazyPat {}) = True go1 (BangPat pat) = go pat go1 (CoPat _ pat _) = go1 pat @@ -430,7 +426,6 @@ isIrrefutableHsPat pat hsPatNeedsParens :: Pat a -> Bool hsPatNeedsParens (WildPat {}) = False hsPatNeedsParens (VarPat {}) = False -hsPatNeedsParens (VarPatOut {}) = True hsPatNeedsParens (LazyPat {}) = False hsPatNeedsParens (BangPat {}) = False hsPatNeedsParens (CoPat {}) = True diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index b2e981c..18f9abd 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -508,8 +508,6 @@ collect_lpat (L _ pat) bndrs = go pat where go (VarPat var) = var : bndrs - go (VarPatOut var _) = var : bndrs - -- See Note [Dictionary binders in ConPatOut] go (WildPat _) = bndrs go (LazyPat pat) = collect_lpat pat bndrs go (BangPat pat) = collect_lpat pat bndrs diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 39e9ea9..3d6c491 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -82,7 +82,6 @@ hsPatType :: Pat Id -> Type hsPatType (ParPat pat) = hsLPatType pat hsPatType (WildPat ty) = ty hsPatType (VarPat var) = idType var -hsPatType (VarPatOut var _) = idType var hsPatType (BangPat pat) = hsLPatType pat hsPatType (LazyPat pat) = hsLPatType pat hsPatType (LitPat lit) = hsLitType lit @@ -852,11 +851,6 @@ zonk_pat env (VarPat v) = do { v' <- zonkIdBndr env v ; return (extendZonkEnv1 env v', VarPat v') } -zonk_pat env (VarPatOut v binds) - = do { v' <- zonkIdBndr env v - ; (env', binds') <- zonkTcEvBinds (extendZonkEnv1 env v') binds - ; returnM (env', VarPatOut v' binds') } - zonk_pat env (LazyPat pat) = do { (env', pat') <- zonkPat env pat ; return (env', LazyPat pat') } diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index 7cb16de..a82584c 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -375,16 +375,6 @@ tc_pat penv (VarPat name) pat_ty thing_inside ; res <- tcExtendIdEnv1 name id thing_inside ; return (mkHsWrapPatCoI coi (VarPat id) pat_ty, res) } -{- Need this if we re-add Method constraints - ; (res, binds) <- bindInstsOfPatId id $ - tcExtendIdEnv1 name id $ - (traceTc (text "binding" <+> ppr name <+> ppr (idType id)) - >> thing_inside) - ; let pat' | isEmptyTcEvBinds binds = VarPat id - | otherwise = VarPatOut id binds - ; return (mkHsWrapPatCoI coi pat' pat_ty, res) } --} - tc_pat penv (ParPat pat) pat_ty thing_inside = do { (pat', res) <- tc_lpat pat pat_ty penv thing_inside ; return (ParPat pat', res) } @@ -558,7 +548,7 @@ tc_pat penv (NPlusKPat (L nm_loc name) lit ge minus) pat_ty thing_inside ; res <- tcExtendIdEnv1 name bndr_id thing_inside ; return (mkHsWrapPatCoI coi pat' pat_ty, res) } -tc_pat _ _other_pat _ _ = panic "tc_pat" -- ConPatOut, SigPatOut, VarPatOut +tc_pat _ _other_pat _ _ = panic "tc_pat" -- ConPatOut, SigPatOut ---------------- unifyPatType :: TcType -> TcType -> TcM CoercionI -- 1.7.10.4