X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsArrows.lhs;h=45fbf07682fb01a915c9b14b274cdc97be58da34;hp=d65a0b80c6464383cfe13927548bf15beacdc2f6;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hpb=48f550f99f6f82f26de79529cf256b1e0a2b8e88

diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index d65a0b8..45fbf07 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -40,7 +40,7 @@ import TysWiredIn
 import BasicTypes
 import PrelNames
 import Outputable
-
+import Bag
 import VarSet
 import SrcLoc
 
@@ -149,7 +149,7 @@ mkCorePairExpr e1 e2 = mkCoreTup [e1, e2]
 
 The input is divided into a local environment, which is a flat tuple
 (unless it's too big), and a stack, each element of which is paired
-with the stack in turn.  In general, the input has the form
+with the environment in turn.  In general, the input has the form
 
 	(...((x1,...,xn),s1),...sk)
 
@@ -1023,20 +1023,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 +1050,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 +1062,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}