+ = newIPNameRn n `thenM` \ name ->
+ rnLHsType doc ty `thenM` \ ty' ->
+ returnM (HsIParam name ty')
+\end{code}
+
+
+*********************************************************
+* *
+\subsection{Patterns}
+* *
+*********************************************************
+
+\begin{code}
+rnPatsAndThen :: HsMatchContext Name
+ -> [LPat RdrName]
+ -> ([LPat Name] -> RnM (a, FreeVars))
+ -> RnM (a, FreeVars)
+-- Bring into scope all the binders and type variables
+-- bound by the patterns; then rename the patterns; then
+-- do the thing inside.
+--
+-- Note that we do a single bindLocalsRn for all the
+-- matches together, so that we spot the repeated variable in
+-- f x x = 1
+
+rnPatsAndThen ctxt pats thing_inside
+ = bindPatSigTyVarsFV pat_sig_tys $
+ bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
+ rnLPats pats `thenM` \ (pats', pat_fvs) ->
+ thing_inside pats' `thenM` \ (res, res_fvs) ->
+
+ let
+ unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
+ in
+ warnUnusedMatches unused_binders `thenM_`
+ returnM (res, res_fvs `plusFV` pat_fvs)
+ where
+ pat_sig_tys = collectSigTysFromPats pats
+ bndrs = collectLocatedPatsBinders pats
+ doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
+
+rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
+rnLPats ps = mapFvRn rnLPat ps
+
+rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
+rnLPat = wrapLocFstM rnPat
+
+-- -----------------------------------------------------------------------------
+-- rnPat
+
+rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
+
+rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
+
+rnPat (VarPat name)
+ = lookupBndrRn name `thenM` \ vname ->
+ returnM (VarPat vname, emptyFVs)
+
+rnPat (SigPatIn pat ty)
+ = doptM Opt_GlasgowExts `thenM` \ glaExts ->
+
+ if glaExts
+ then rnLPat pat `thenM` \ (pat', fvs1) ->
+ rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
+ returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
+
+ else addErr (patSigErr ty) `thenM_`
+ rnPat (unLoc pat) -- XXX shouldn't throw away the loc
+ where
+ doc = text "In a pattern type-signature"
+
+rnPat (LitPat lit)
+ = rnLit lit `thenM_`
+ returnM (LitPat lit, emptyFVs)
+
+rnPat (NPat lit mb_neg eq _)
+ = rnOverLit lit `thenM` \ (lit', fvs1) ->
+ (case mb_neg of
+ Nothing -> returnM (Nothing, emptyFVs)
+ Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
+ returnM (Just neg, fvs)
+ ) `thenM` \ (mb_neg', fvs2) ->
+ lookupSyntaxName eqName `thenM` \ (eq', fvs3) ->
+ returnM (NPat lit' mb_neg' eq' placeHolderType,
+ fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName)
+ -- Needed to find equality on pattern
+
+rnPat (NPlusKPat name lit _ _)
+ = rnOverLit lit `thenM` \ (lit', fvs1) ->
+ lookupLocatedBndrRn name `thenM` \ name' ->
+ lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
+ lookupSyntaxName geName `thenM` \ (ge, fvs3) ->
+ returnM (NPlusKPat name' lit' ge minus,
+ fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName)
+ -- The Report says that n+k patterns must be in Integral
+
+rnPat (LazyPat pat)
+ = rnLPat pat `thenM` \ (pat', fvs) ->
+ returnM (LazyPat pat', fvs)
+
+rnPat (BangPat pat)
+ = rnLPat pat `thenM` \ (pat', fvs) ->
+ returnM (BangPat pat', fvs)
+
+rnPat (AsPat name pat)
+ = rnLPat pat `thenM` \ (pat', fvs) ->
+ lookupLocatedBndrRn name `thenM` \ vname ->
+ returnM (AsPat vname pat', fvs)
+
+rnPat (ConPatIn con stuff) = rnConPat con stuff
+
+
+rnPat (ParPat pat)
+ = rnLPat pat `thenM` \ (pat', fvs) ->
+ returnM (ParPat pat', fvs)
+
+rnPat (ListPat pats _)
+ = rnLPats pats `thenM` \ (patslist, fvs) ->
+ returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
+
+rnPat (PArrPat pats _)
+ = rnLPats pats `thenM` \ (patslist, fvs) ->
+ returnM (PArrPat patslist placeHolderType,
+ fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
+ where
+ implicit_fvs = mkFVs [lengthPName, indexPName]
+
+rnPat (TuplePat pats boxed _)
+ = checkTupSize tup_size `thenM_`
+ rnLPats pats `thenM` \ (patslist, fvs) ->
+ returnM (TuplePat patslist boxed placeHolderType,
+ fvs `addOneFV` tycon_name)
+ where
+ tup_size = length pats
+ tycon_name = tupleTyCon_name boxed tup_size
+
+rnPat (TypePat name) =
+ rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
+ returnM (TypePat name', fvs)
+
+-- -----------------------------------------------------------------------------
+-- rnConPat
+
+rnConPat con (PrefixCon pats)
+ = lookupLocatedOccRn con `thenM` \ con' ->
+ rnLPats pats `thenM` \ (pats', fvs) ->
+ returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con')
+
+rnConPat con (RecCon rpats)
+ = lookupLocatedOccRn con `thenM` \ con' ->
+ rnRpats rpats `thenM` \ (rpats', fvs) ->
+ returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con')
+
+rnConPat con (InfixCon pat1 pat2)
+ = lookupLocatedOccRn con `thenM` \ con' ->
+ rnLPat pat1 `thenM` \ (pat1', fvs1) ->
+ rnLPat pat2 `thenM` \ (pat2', fvs2) ->
+ lookupFixityRn (unLoc con') `thenM` \ fixity ->
+ mkConOpPatRn con' fixity pat1' pat2' `thenM` \ pat' ->
+ returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con')
+
+-- -----------------------------------------------------------------------------
+-- rnRpats
+
+rnRpats :: [(Located RdrName, LPat RdrName)]
+ -> RnM ([(Located Name, LPat Name)], FreeVars)
+rnRpats rpats
+ = mappM_ field_dup_err dup_fields `thenM_`
+ mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
+ returnM (rpats', fvs)
+ where
+ (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
+
+ field_dup_err dups = addErr (dupFieldErr "pattern" dups)
+
+ rn_rpat (field, pat)
+ = lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
+ rnLPat pat `thenM` \ (pat', fvs) ->
+ returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
+