Remove the now-unused constructor VarPatOut
authorsimonpj@microsoft.com <unknown>
Fri, 5 Nov 2010 13:16:36 +0000 (13:16 +0000)
committersimonpj@microsoft.com <unknown>
Fri, 5 Nov 2010 13:16:36 +0000 (13:16 +0000)
compiler/deSugar/Check.lhs
compiler/deSugar/DsArrows.lhs
compiler/deSugar/Match.lhs
compiler/hsSyn/HsPat.lhs
compiler/hsSyn/HsUtils.lhs
compiler/typecheck/TcHsSyn.lhs
compiler/typecheck/TcPat.lhs

index 355055b..2432051 100644 (file)
@@ -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
index 89c453f..3360a95 100644 (file)
@@ -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
index c952446..9d7e124 100644 (file)
@@ -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)
index 25a350b..fe3003d 100644 (file)
@@ -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
index b2e981c..18f9abd 100644 (file)
@@ -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
index 39e9ea9..3d6c491 100644 (file)
@@ -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') }
index 7cb16de..a82584c 100644 (file)
@@ -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