compiler/hsSyn/HsUtils.lhs

   1
   2 %
   3 % (c) The University of Glasgow, 1992-2006
   4 %
   5
   6 Here we collect a variety of helper functions that construct or
   7 analyse HsSyn.  All these functions deal with generic HsSyn; functions
   8 which deal with the intantiated versions are located elsewhere:
   9
  10    Parameterised by     Module
  11    ----------------     -------------
  12    RdrName              parser/RdrHsSyn
  13    Name                 rename/RnHsSyn
  14    Id                   typecheck/TcHsSyn
  15
  16 \begin{code}
  17 module HsUtils where
  18
  19 import HsBinds
  20 import HsExpr
  21 import HsPat
  22 import HsTypes
  23 import HsLit
  24
  25 import RdrName
  26 import Var
  27 import Coercion
  28 import Type
  29 import DataCon
  30 import Name
  31 import NameSet
  32 import BasicTypes
  33 import SrcLoc
  34 import FastString
  35 import Outputable
  36 import Util
  37 import Bag
  38 \end{code}
  39
  40
  41 %************************************************************************
  42 %*                                                                      *
  43         Some useful helpers for constructing syntax
  44 %*                                                                      *
  45 %************************************************************************
  46
  47 These functions attempt to construct a not-completely-useless SrcSpan
  48 from their components, compared with the nl* functions below which
  49 just attach noSrcSpan to everything.
  50
  51 \begin{code}
  52 mkHsPar :: LHsExpr id -> LHsExpr id
  53 mkHsPar e = L (getLoc e) (HsPar e)
  54
  55 mkSimpleMatch :: [LPat id] -> LHsExpr id -> LMatch id
  56 mkSimpleMatch pats rhs
  57   = L loc $
  58     Match pats Nothing (unguardedGRHSs rhs)
  59   where
  60     loc = case pats of
  61                 []      -> getLoc rhs
  62                 (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
  63
  64 unguardedGRHSs :: LHsExpr id -> GRHSs id
  65 unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds
  66
  67 unguardedRHS :: LHsExpr id -> [LGRHS id]
  68 unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
  69
  70 mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
  71 mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
  72
  73 mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name
  74 mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
  75
  76 nlHsTyApp :: name -> [Type] -> LHsExpr name
  77 nlHsTyApp fun_id tys = noLoc (HsWrap (mkWpTyApps tys) (HsVar fun_id))
  78
  79 mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id
  80 mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
  81
  82 mkHsWrap :: HsWrapper -> HsExpr id -> HsExpr id
  83 mkHsWrap co_fn e | isIdHsWrapper co_fn = e
  84                  | otherwise           = HsWrap co_fn e
  85
  86 mkHsWrapCoI :: CoercionI -> HsExpr id -> HsExpr id
  87 mkHsWrapCoI IdCo     e = e
  88 mkHsWrapCoI (ACo co) e = mkHsWrap (WpCast co) e
  89
  90 coiToHsWrapper :: CoercionI -> HsWrapper
  91 coiToHsWrapper IdCo     = idHsWrapper
  92 coiToHsWrapper (ACo co) = WpCast co
  93
  94 mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
  95 mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
  96         where
  97           matches = mkMatchGroup [mkSimpleMatch pats body]
  98
  99 mkMatchGroup :: [LMatch id] -> MatchGroup id
 100 mkMatchGroup matches = MatchGroup matches placeHolderType
 101
 102 mkHsDictLet :: LHsBinds Id -> LHsExpr Id -> LHsExpr Id
 103 -- Used for the dictionary bindings gotten from TcSimplify
 104 -- We make them recursive to be on the safe side
 105 mkHsDictLet binds expr
 106   | isEmptyLHsBinds binds = expr
 107   | otherwise             = L (getLoc expr) (HsLet (HsValBinds val_binds) expr)
 108                           where
 109                             val_binds = ValBindsOut [(Recursive, binds)] []
 110
 111 mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
 112 -- Used for constructing dictionary terms etc, so no locations
 113 mkHsConApp data_con tys args
 114   = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
 115   where
 116     mk_app f a = noLoc (HsApp f (noLoc a))
 117
 118 mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id
 119 -- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
 120 mkSimpleHsAlt pat expr
 121   = mkSimpleMatch [pat] expr
 122
 123 -------------------------------
 124 -- These are the bits of syntax that contain rebindable names
 125 -- See RnEnv.lookupSyntaxName
 126
 127 mkHsIntegral   :: Integer -> PostTcType -> HsOverLit id
 128 mkHsFractional :: Rational -> PostTcType -> HsOverLit id
 129 mkHsIsString   :: FastString -> PostTcType -> HsOverLit id
 130 mkHsDo         :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> HsExpr id
 131
 132 mkNPat      :: HsOverLit id -> Maybe (SyntaxExpr id) -> Pat id
 133 mkNPlusKPat :: Located id -> HsOverLit id -> Pat id
 134
 135 mkTransformStmt   :: [LStmt idL] -> LHsExpr idR                -> StmtLR idL idR
 136 mkTransformByStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
 137
 138 mkGroupUsingStmt   :: [LStmt idL]                -> LHsExpr idR -> StmtLR idL idR
 139 mkGroupByStmt      :: [LStmt idL] -> LHsExpr idR                -> StmtLR idL idR
 140 mkGroupByUsingStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
 141
 142 mkExprStmt :: LHsExpr idR -> StmtLR idL idR
 143 mkBindStmt :: LPat idL -> LHsExpr idR -> StmtLR idL idR
 144
 145 emptyRecStmt :: StmtLR idL idR
 146 mkRecStmt    :: [LStmtLR idL idR] -> StmtLR idL idR
 147
 148
 149 mkHsIntegral   i       = OverLit (HsIntegral   i)  noRebindableInfo noSyntaxExpr
 150 mkHsFractional f       = OverLit (HsFractional f)  noRebindableInfo noSyntaxExpr
 151 mkHsIsString   s       = OverLit (HsIsString   s)  noRebindableInfo noSyntaxExpr
 152
 153 noRebindableInfo :: Bool
 154 noRebindableInfo = error "noRebindableInfo"     -- Just another placeholder;
 155
 156 mkHsDo ctxt stmts body = HsDo ctxt stmts body placeHolderType
 157
 158 mkNPat lit neg     = NPat lit neg noSyntaxExpr
 159 mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
 160
 161 mkTransformStmt   stmts usingExpr        = TransformStmt (stmts, []) usingExpr Nothing
 162 mkTransformByStmt stmts usingExpr byExpr = TransformStmt (stmts, []) usingExpr (Just byExpr)
 163
 164 mkGroupUsingStmt   stmts usingExpr        = GroupStmt (stmts, []) (GroupByNothing usingExpr)
 165 mkGroupByStmt      stmts byExpr           = GroupStmt (stmts, []) (GroupBySomething (Right noSyntaxExpr) byExpr)
 166 mkGroupByUsingStmt stmts byExpr usingExpr = GroupStmt (stmts, []) (GroupBySomething (Left usingExpr) byExpr)
 167
 168 mkExprStmt expr     = ExprStmt expr noSyntaxExpr placeHolderType
 169 mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
 170
 171 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
 172                        , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
 173                        , recS_bind_fn = noSyntaxExpr
 174                        , recS_rec_rets = [], recS_dicts = emptyLHsBinds }
 175
 176 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
 177
 178 -------------------------------
 179 --- A useful function for building @OpApps@.  The operator is always a
 180 -- variable, and we don't know the fixity yet.
 181 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
 182 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
 183
 184 mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
 185 mkHsSplice e = HsSplice unqualSplice e
 186
 187 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
 188 mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind
 189
 190 unqualSplice :: RdrName
 191 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
 192                 -- A name (uniquified later) to
 193                 -- identify the splice
 194
 195 mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
 196 mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
 197
 198 unqualQuasiQuote :: RdrName
 199 unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
 200                 -- A name (uniquified later) to
 201                 -- identify the quasi-quote
 202
 203 mkHsString :: String -> HsLit
 204 mkHsString s = HsString (mkFastString s)
 205
 206 -------------
 207 userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
 208 userHsTyVarBndrs bndrs = [ L loc (UserTyVar v placeHolderKind) | L loc v <- bndrs ]
 209 \end{code}
 210
 211
 212 %************************************************************************
 213 %*                                                                      *
 214         Constructing syntax with no location info
 215 %*                                                                      *
 216 %************************************************************************
 217
 218 \begin{code}
 219 nlHsVar :: id -> LHsExpr id
 220 nlHsVar n = noLoc (HsVar n)
 221
 222 nlHsLit :: HsLit -> LHsExpr id
 223 nlHsLit n = noLoc (HsLit n)
 224
 225 nlVarPat :: id -> LPat id
 226 nlVarPat n = noLoc (VarPat n)
 227
 228 nlLitPat :: HsLit -> LPat id
 229 nlLitPat l = noLoc (LitPat l)
 230
 231 nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
 232 nlHsApp f x = noLoc (HsApp f x)
 233
 234 nlHsIntLit :: Integer -> LHsExpr id
 235 nlHsIntLit n = noLoc (HsLit (HsInt n))
 236
 237 nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
 238 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
 239
 240 nlHsVarApps :: id -> [id] -> LHsExpr id
 241 nlHsVarApps f xs = noLoc (foldl mk (HsVar f) (map HsVar xs))
 242                  where
 243                    mk f a = HsApp (noLoc f) (noLoc a)
 244
 245 nlConVarPat :: id -> [id] -> LPat id
 246 nlConVarPat con vars = nlConPat con (map nlVarPat vars)
 247
 248 nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
 249 nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
 250
 251 nlConPat :: id -> [LPat id] -> LPat id
 252 nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
 253
 254 nlNullaryConPat :: id -> LPat id
 255 nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
 256
 257 nlWildConPat :: DataCon -> LPat RdrName
 258 nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
 259                                    (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
 260
 261 nlWildPat :: LPat id
 262 nlWildPat  = noLoc (WildPat placeHolderType)    -- Pre-typechecking
 263
 264 nlHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> LHsExpr id
 265 nlHsDo ctxt stmts body = noLoc (mkHsDo ctxt stmts body)
 266
 267 nlHsOpApp :: LHsExpr id -> id -> LHsExpr id -> LHsExpr id
 268 nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
 269
 270 nlHsLam  :: LMatch id -> LHsExpr id
 271 nlHsPar  :: LHsExpr id -> LHsExpr id
 272 nlHsIf   :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
 273 nlHsCase :: LHsExpr id -> [LMatch id] -> LHsExpr id
 274 nlList   :: [LHsExpr id] -> LHsExpr id
 275
 276 nlHsLam match           = noLoc (HsLam (mkMatchGroup [match]))
 277 nlHsPar e               = noLoc (HsPar e)
 278 nlHsIf cond true false  = noLoc (HsIf cond true false)
 279 nlHsCase expr matches   = noLoc (HsCase expr (mkMatchGroup matches))
 280 nlList exprs            = noLoc (ExplicitList placeHolderType exprs)
 281
 282 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
 283 nlHsTyVar :: name                         -> LHsType name
 284 nlHsFunTy :: LHsType name -> LHsType name -> LHsType name
 285
 286 nlHsAppTy f t           = noLoc (HsAppTy f t)
 287 nlHsTyVar x             = noLoc (HsTyVar x)
 288 nlHsFunTy a b           = noLoc (HsFunTy a b)
 289
 290 nlHsTyConApp :: name -> [LHsType name] -> LHsType name
 291 nlHsTyConApp tycon tys  = foldl nlHsAppTy (nlHsTyVar tycon) tys
 292 \end{code}
 293
 294 Tuples.  All these functions are *pre-typechecker* because they lack
 295 types on the tuple.
 296
 297 \begin{code}
 298 mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
 299 -- Makes a pre-typechecker boxed tuple, deals with 1 case
 300 mkLHsTupleExpr [e] = e
 301 mkLHsTupleExpr es  = noLoc $ ExplicitTuple (map Present es) Boxed
 302
 303 mkLHsVarTuple :: [a] -> LHsExpr a
 304 mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)
 305
 306 nlTuplePat :: [LPat id] -> Boxity -> LPat id
 307 nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
 308
 309 missingTupArg :: HsTupArg a
 310 missingTupArg = Missing placeHolderType
 311 \end{code}
 312
 313 %************************************************************************
 314 %*                                                                      *
 315                 Bindings; with a location at the top
 316 %*                                                                      *
 317 %************************************************************************
 318
 319 \begin{code}
 320 mkFunBind :: Located id -> [LMatch id] -> HsBind id
 321 -- Not infix, with place holders for coercion and free vars
 322 mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatchGroup ms,
 323                             fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames,
 324                             fun_tick = Nothing }
 325
 326
 327 mkHsVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
 328 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
 329
 330 mkVarBind :: id -> LHsExpr id -> LHsBind id
 331 mkVarBind var rhs = L (getLoc rhs) $
 332                     VarBind { var_id = var, var_rhs = rhs, var_inline = False }
 333
 334 ------------
 335 mk_easy_FunBind :: SrcSpan -> id -> [LPat id]
 336                 -> LHsExpr id -> LHsBind id
 337
 338 mk_easy_FunBind loc fun pats expr
 339   = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
 340
 341 ------------
 342 mk_FunBind :: SrcSpan -> id
 343            -> [([LPat id], LHsExpr id)]
 344            -> LHsBind id
 345
 346 mk_FunBind _   _   [] = panic "TcGenDeriv:mk_FunBind"
 347 mk_FunBind loc fun pats_and_exprs
 348   = L loc $ mkFunBind (L loc fun) matches
 349   where
 350     matches = [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs]
 351
 352 ------------
 353 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
 354 mkMatch pats expr binds
 355   = noLoc (Match (map paren pats) Nothing
 356                  (GRHSs (unguardedRHS expr) binds))
 357   where
 358     paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
 359                      | otherwise          = lp
 360 \end{code}
 361
 362
 363 %************************************************************************
 364 %*                                                                      *
 365         Collecting binders from HsBindGroups and HsBinds
 366 %*                                                                      *
 367 %************************************************************************
 368
 369 Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
 370
 371 ...
 372 where
 373   (x, y) = ...
 374   f i j  = ...
 375   [a, b] = ...
 376
 377 it should return [x, y, f, a, b] (remember, order important).
 378
 379 \begin{code}
 380 collectLocalBinders :: HsLocalBindsLR idL idR -> [Located idL]
 381 collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
 382 collectLocalBinders (HsIPBinds _)   = []
 383 collectLocalBinders EmptyLocalBinds = []
 384
 385 collectHsValBinders :: HsValBindsLR idL idR -> [Located idL]
 386 collectHsValBinders (ValBindsIn  binds _) = collectHsBindLocatedBinders binds
 387 collectHsValBinders (ValBindsOut binds _) = foldr collect_one [] binds
 388   where
 389    collect_one (_,binds) acc = foldrBag (collectAcc . unLoc) acc binds
 390
 391 collectAcc :: HsBindLR idL idR -> [Located idL] -> [Located idL]
 392 collectAcc (PatBind { pat_lhs = p }) acc = collectLocatedPatBinders p ++ acc
 393 collectAcc (FunBind { fun_id = f })  acc    = f : acc
 394 collectAcc (VarBind { var_id = f })  acc    = noLoc f : acc
 395 collectAcc (AbsBinds { abs_exports = dbinds, abs_binds = _binds }) acc
 396   = [noLoc dp | (_,dp,_,_) <- dbinds] ++ acc
 397         -- ++ foldr collectAcc acc binds
 398         -- I don't think we want the binders from the nested binds
 399         -- The only time we collect binders from a typechecked
 400         -- binding (hence see AbsBinds) is in zonking in TcHsSyn
 401
 402 collectHsBindBinders :: LHsBindsLR idL idR -> [idL]
 403 collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds)
 404
 405 collectHsBindLocatedBinders :: LHsBindsLR idL idR -> [Located idL]
 406 collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
 407 \end{code}
 408
 409
 410 %************************************************************************
 411 %*                                                                      *
 412         Getting binders from statements
 413 %*                                                                      *
 414 %************************************************************************
 415
 416 \begin{code}
 417 collectLStmtsBinders :: [LStmtLR idL idR] -> [Located idL]
 418 collectLStmtsBinders = concatMap collectLStmtBinders
 419
 420 collectStmtsBinders :: [StmtLR idL idR] -> [Located idL]
 421 collectStmtsBinders = concatMap collectStmtBinders
 422
 423 collectLStmtBinders :: LStmtLR idL idR -> [Located idL]
 424 collectLStmtBinders = collectStmtBinders . unLoc
 425
 426 collectStmtBinders :: StmtLR idL idR -> [Located idL]
 427   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 428 collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat
 429 collectStmtBinders (LetStmt binds)      = collectLocalBinders binds
 430 collectStmtBinders (ExprStmt _ _ _)     = []
 431 collectStmtBinders (ParStmt xs)         = collectLStmtsBinders
 432                                         $ concatMap fst xs
 433 collectStmtBinders (TransformStmt (stmts, _) _ _) = collectLStmtsBinders stmts
 434 collectStmtBinders (GroupStmt (stmts, _) _)       = collectLStmtsBinders stmts
 435 collectStmtBinders (RecStmt { recS_stmts = ss })  = collectLStmtsBinders ss
 436 \end{code}
 437
 438
 439 %************************************************************************
 440 %*                                                                      *
 441 %*      Gathering stuff out of patterns
 442 %*                                                                      *
 443 %************************************************************************
 444
 445 This function @collectPatBinders@ works with the ``collectBinders''
 446 functions for @HsBinds@, etc.  The order in which the binders are
 447 collected is important; see @HsBinds.lhs@.
 448
 449 It collects the bounds *value* variables in renamed patterns; type variables
 450 are *not* collected.
 451
 452 \begin{code}
 453 collectPatBinders :: LPat a -> [a]
 454 collectPatBinders pat = map unLoc (collectLocatedPatBinders pat)
 455
 456 collectLocatedPatBinders :: LPat a -> [Located a]
 457 collectLocatedPatBinders pat = collectl pat []
 458
 459 collectPatsBinders :: [LPat a] -> [a]
 460 collectPatsBinders pats = map unLoc (collectLocatedPatsBinders pats)
 461
 462 collectLocatedPatsBinders :: [LPat a] -> [Located a]
 463 collectLocatedPatsBinders pats = foldr collectl [] pats
 464
 465 ---------------------
 466 collectl :: LPat name -> [Located name] -> [Located name]
 467 collectl (L l pat) bndrs
 468   = go pat
 469   where
 470     go (VarPat var)               = L l var : bndrs
 471     go (VarPatOut var bs)         = L l var : collectHsBindLocatedBinders bs
 472                                     ++ bndrs
 473     go (WildPat _)                = bndrs
 474     go (LazyPat pat)              = collectl pat bndrs
 475     go (BangPat pat)              = collectl pat bndrs
 476     go (AsPat a pat)              = a : collectl pat bndrs
 477     go (ViewPat _ pat _)          = collectl pat bndrs
 478     go (ParPat  pat)              = collectl pat bndrs
 479
 480     go (ListPat pats _)           = foldr collectl bndrs pats
 481     go (PArrPat pats _)           = foldr collectl bndrs pats
 482     go (TuplePat pats _ _)        = foldr collectl bndrs pats
 483
 484     go (ConPatIn _ ps)            = foldr collectl bndrs (hsConPatArgs ps)
 485     go (ConPatOut {pat_args=ps})  = foldr collectl bndrs (hsConPatArgs ps)
 486         -- See Note [Dictionary binders in ConPatOut]
 487     go (LitPat _)                 = bndrs
 488     go (NPat _ _ _)               = bndrs
 489     go (NPlusKPat n _ _ _)        = n : bndrs
 490
 491     go (SigPatIn pat _)           = collectl pat bndrs
 492     go (SigPatOut pat _)          = collectl pat bndrs
 493     go (QuasiQuotePat _)          = bndrs
 494     go (TypePat _)                = bndrs
 495     go (CoPat _ pat _)            = collectl (noLoc pat) bndrs
 496 \end{code}
 497
 498 Note [Dictionary binders in ConPatOut]
 499 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 500 Do *not* gather (a) dictionary and (b) dictionary bindings as binders
 501 of a ConPatOut pattern.  For most calls it doesn't matter, because
 502 it's pre-typechecker and there are no ConPatOuts.  But it does matter
 503 more in the desugarer; for example, DsUtils.mkSelectorBinds uses
 504 collectPatBinders.  In a lazy pattern, for example f ~(C x y) = ...,
 505 we want to generate bindings for x,y but not for dictionaries bound by
 506 C.  (The type checker ensures they would not be used.)
 507
 508 Desugaring of arrow case expressions needs these bindings (see DsArrows
 509 and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
 510 own pat-binder-collector:
 511
 512 Here's the problem.  Consider
 513
 514 data T a where
 515    C :: Num a => a -> Int -> T a
 516
 517 f ~(C (n+1) m) = (n,m)
 518
 519 Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
 520 and *also* uses that dictionary to match the (n+1) pattern.  Yet, the
 521 variables bound by the lazy pattern are n,m, *not* the dictionary d.
 522 So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
 523
 524 \begin{code}
 525 collectSigTysFromPats :: [InPat name] -> [LHsType name]
 526 collectSigTysFromPats pats = foldr collect_lpat [] pats
 527
 528 collectSigTysFromPat :: InPat name -> [LHsType name]
 529 collectSigTysFromPat pat = collect_lpat pat []
 530
 531 collect_lpat :: InPat name -> [LHsType name] -> [LHsType name]
 532 collect_lpat pat acc = collect_pat (unLoc pat) acc
 533
 534 collect_pat :: Pat name -> [LHsType name] -> [LHsType name]
 535 collect_pat (SigPatIn pat ty)   acc = collect_lpat pat (ty:acc)
 536 collect_pat (TypePat ty)        acc = ty:acc
 537
 538 collect_pat (LazyPat pat)       acc = collect_lpat pat acc
 539 collect_pat (BangPat pat)       acc = collect_lpat pat acc
 540 collect_pat (AsPat _ pat)       acc = collect_lpat pat acc
 541 collect_pat (ParPat  pat)       acc = collect_lpat pat acc
 542 collect_pat (ListPat pats _)    acc = foldr collect_lpat acc pats
 543 collect_pat (PArrPat pats _)    acc = foldr collect_lpat acc pats
 544 collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats
 545 collect_pat (ConPatIn _ ps)     acc = foldr collect_lpat acc (hsConPatArgs ps)
 546 collect_pat _                   acc = acc       -- Literals, vars, wildcard
 547 \end{code}