Remove the now-unused constructor VarPatOut
[ghc-hetmet.git] / compiler / hsSyn / HsPat.lhs
index 1bf0aa8..fe3003d 100644 (file)
@@ -47,6 +47,7 @@ import SrcLoc
 import FastString
 -- libraries:
 import Data.Data hiding (TyCon)
+import Data.Maybe
 \end{code}
 
 
@@ -63,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
@@ -256,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
@@ -396,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
@@ -411,7 +408,9 @@ isIrrefutableHsPat pat
 
     go1 (ConPatIn {})       = False    -- Conservative
     go1 (ConPatOut{ pat_con = L _ con, pat_args = details }) 
-       =  isProductTyCon (dataConTyCon con)
+       =  isJust (tyConSingleDataCon_maybe (dataConTyCon con))
+          -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because 
+          -- the latter is false of existentials. See Trac #4439
        && all go (hsConPatArgs details)
 
     go1 (LitPat {})    = False
@@ -427,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