X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsArrows.lhs;h=c55d6a4828401ed55ad86d52babfe0770608d7a6;hb=edeee10702955ca3c53444f2f328b4cce0ab3e32;hp=63e5cbef28a9542b82d7b92678d0e1fc5e110095;hpb=34bb2bb9114fe35fc743b67254c6db7c3097dc72;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index 63e5cbe..c55d6a4 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -34,13 +34,12 @@ import MkCore
 import Name
 import Var
 import Id
-import PrelInfo
 import DataCon
 import TysWiredIn
 import BasicTypes
 import PrelNames
 import Outputable
-
+import Bag
 import VarSet
 import SrcLoc
 
@@ -1023,20 +1022,20 @@ See comments in HsUtils for why the other version does not include
 these bindings.
 
 \begin{code}
-collectPatBinders :: OutputableBndr a => LPat a -> [a]
+collectPatBinders :: LPat Id -> [Id]
 collectPatBinders pat = collectl pat []
 
-collectPatsBinders :: OutputableBndr a => [LPat a] -> [a]
+collectPatsBinders :: [LPat Id] -> [Id]
 collectPatsBinders pats = foldr collectl [] pats
 
 ---------------------
-collectl :: OutputableBndr a => LPat a -> [a] -> [a]
+collectl :: LPat Id -> [Id] -> [Id]
 -- See Note [Dictionary binders in ConPatOut]
 collectl (L _ pat) bndrs
   = go pat
   where
     go (VarPat var)               = var : bndrs
-    go (VarPatOut var bs)         = var : collectHsBindsBinders bs
+    go (VarPatOut var bs)         = var : collectEvBinders bs
                                     ++ bndrs
     go (WildPat _)                = bndrs
     go (LazyPat pat)              = collectl pat bndrs
@@ -1050,7 +1049,7 @@ collectl (L _ pat) bndrs
 
     go (ConPatIn _ ps)            = foldr collectl bndrs (hsConPatArgs ps)
     go (ConPatOut {pat_args=ps, pat_binds=ds}) =
-                                    collectHsBindsBinders ds
+                                    collectEvBinders ds
                                     ++ foldr collectl bndrs (hsConPatArgs ps)
     go (LitPat _)                 = bndrs
     go (NPat _ _ _)               = bndrs
@@ -1062,4 +1061,13 @@ collectl (L _ pat) bndrs
     go (CoPat _ pat _)            = collectl (noLoc pat) bndrs
     go (ViewPat _ pat _)          = collectl pat bndrs
     go p@(QuasiQuotePat {})       = pprPanic "collectl/go" (ppr p)
+
+collectEvBinders :: TcEvBinds -> [Id]
+collectEvBinders (EvBinds bs)   = foldrBag add_ev_bndr [] bs
+collectEvBinders (TcEvBinds {}) = panic "ToDo: collectEvBinders"
+
+add_ev_bndr :: EvBind -> [Id] -> [Id]
+add_ev_bndr (EvBind b _) bs | isId b    = b:bs
+                            | otherwise = bs
+  -- A worry: what about coercion variable binders??
 \end{code}