-*********************************************************
-* *
-\subsection{Patterns}
-* *
-*********************************************************
-
-\begin{code}
-rnPat :: RdrNamePat -> RnMS (RenamedPat, FreeVars)
-
-rnPat WildPatIn = returnRn (WildPatIn, emptyFVs)
-
-rnPat (VarPatIn name)
- = lookupBndrRn name `thenRn` \ vname ->
- returnRn (VarPatIn vname, emptyFVs)
-
-rnPat (SigPatIn pat ty)
- = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
-
- if glaExts
- then rnPat pat `thenRn` \ (pat', fvs1) ->
- rnHsTypeFVs doc ty `thenRn` \ (ty', fvs2) ->
- returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
-
- else addErrRn (patSigErr ty) `thenRn_`
- rnPat pat
- where
- doc = text "a pattern type-signature"
-
-rnPat (LitPatIn s@(HsString _))
- = returnRn (LitPatIn s, unitFV eqStringName)
-
-rnPat (LitPatIn lit)
- = litFVs lit `thenRn` \ fvs ->
- returnRn (LitPatIn lit, fvs)
-
-rnPat (NPatIn lit)
- = rnOverLit lit `thenRn` \ (lit', fvs1) ->
- returnRn (NPatIn lit', fvs1 `addOneFV` eqClassName) -- Needed to find equality on pattern
-
-rnPat (NPlusKPatIn name lit minus)
- = rnOverLit lit `thenRn` \ (lit', fvs) ->
- lookupBndrRn name `thenRn` \ name' ->
- lookupSyntaxName minus `thenRn` \ minus' ->
- returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ordClassName `addOneFV` minus')
-
-rnPat (LazyPatIn pat)
- = rnPat pat `thenRn` \ (pat', fvs) ->
- returnRn (LazyPatIn pat', fvs)
-
-rnPat (AsPatIn name pat)
- = rnPat pat `thenRn` \ (pat', fvs) ->
- lookupBndrRn name `thenRn` \ vname ->
- returnRn (AsPatIn vname pat', fvs)
-
-rnPat (ConPatIn con pats)
- = lookupOccRn con `thenRn` \ con' ->
- mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
- returnRn (ConPatIn con' patslist, fvs `addOneFV` con')
-
-rnPat (ConOpPatIn pat1 con _ pat2)
- = rnPat pat1 `thenRn` \ (pat1', fvs1) ->
- lookupOccRn con `thenRn` \ con' ->
- rnPat pat2 `thenRn` \ (pat2', fvs2) ->
-
- getModeRn `thenRn` \ mode ->
- -- See comments with rnExpr (OpApp ...)
- (if isInterfaceMode mode
- then returnRn (ConOpPatIn pat1' con' defaultFixity pat2')
- else lookupFixityRn con' `thenRn` \ fixity ->
- mkConOpPatRn pat1' con' fixity pat2'
- ) `thenRn` \ pat' ->
- returnRn (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
-
-rnPat (ParPatIn pat)
- = rnPat pat `thenRn` \ (pat', fvs) ->
- returnRn (ParPatIn pat', fvs)
-
-rnPat (ListPatIn pats)
- = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
- returnRn (ListPatIn patslist, fvs `addOneFV` listTyCon_name)
-
-rnPat (PArrPatIn pats)
- = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
- returnRn (PArrPatIn patslist,
- fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
- where
- implicit_fvs = mkFVs [lengthPName, indexPName]
-
-rnPat (TuplePatIn pats boxed)
- = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
- returnRn (TuplePatIn patslist boxed, fvs `addOneFV` tycon_name)
- where
- tycon_name = tupleTyCon_name boxed (length pats)
-
-rnPat (RecPatIn con rpats)
- = lookupOccRn con `thenRn` \ con' ->
- rnRpats rpats `thenRn` \ (rpats', fvs) ->
- returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
-
-rnPat (TypePatIn name) =
- rnHsTypeFVs (text "type pattern") name `thenRn` \ (name', fvs) ->
- returnRn (TypePatIn name', fvs)
-\end{code}
-