-************************************************************************
-* *
-\subsection{Match}
-* *
-************************************************************************
-
-\begin{code}
-rnMatch :: RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
-
-rnMatch match@(Match _ pats maybe_rhs_sig grhss)
- = pushSrcLocRn (getMatchLoc match) $
-
- -- Bind pattern-bound type variables
- let
- rhs_sig_tys = case maybe_rhs_sig of
- Nothing -> []
- Just ty -> [ty]
- pat_sig_tys = collectSigTysFromPats pats
- doc_sig = text "a result type-signature"
- doc_pat = text "a pattern match"
- in
- bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys) $ \ sig_tyvars ->
-
- -- Note that we do a single bindLocalsRn for all the
- -- matches together, so that we spot the repeated variable in
- -- f x x = 1
- bindLocalsFVRn doc_pat (collectPatsBinders pats) $ \ new_binders ->
-
- mapFvRn rnPat pats `thenRn` \ (pats', pat_fvs) ->
- rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) ->
- doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
- (case maybe_rhs_sig of
- Nothing -> returnRn (Nothing, emptyFVs)
- Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenRn` \ (ty', ty_fvs) ->
- returnRn (Just ty', ty_fvs)
- | otherwise -> addErrRn (patSigErr ty) `thenRn_`
- returnRn (Nothing, emptyFVs)
- ) `thenRn` \ (maybe_rhs_sig', ty_fvs) ->
-
- let
- binder_set = mkNameSet new_binders
- unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
- all_fvs = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
- in
- warnUnusedMatches unused_binders `thenRn_`
-
- returnRn (Match sig_tyvars pats' maybe_rhs_sig' grhss', all_fvs)
- -- The bindLocals and bindTyVars will remove the bound FVs
-
-
-bindPatSigTyVars :: [RdrNameHsType]
- -> ([Name] -> RnMS (a, FreeVars))
- -> RnMS (a, FreeVars)
- -- Find the type variables in the pattern type
- -- signatures that must be brought into scope
-bindPatSigTyVars tys thing_inside
- = getLocalNameEnv `thenRn` \ name_env ->
- let
- tyvars_in_sigs = extractHsTysRdrTyVars tys
- forall_tyvars = filter (not . (`elemFM` name_env)) tyvars_in_sigs
- doc_sig = text "a pattern type-signature"
- in
- bindNakedTyVarsFVRn doc_sig forall_tyvars thing_inside
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection{Guarded right-hand sides (GRHSs)}
-%* *
-%************************************************************************
-
-\begin{code}
-rnGRHSs :: RdrNameGRHSs -> RnMS (RenamedGRHSs, FreeVars)
-
-rnGRHSs (GRHSs grhss binds maybe_ty)
- = ASSERT( not (maybeToBool maybe_ty) )
- rnBinds binds $ \ binds' ->
- mapFvRn rnGRHS grhss `thenRn` \ (grhss', fvGRHSs) ->
- returnRn (GRHSs grhss' binds' Nothing, fvGRHSs)
-
-rnGRHS (GRHS guarded locn)
- = doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
- pushSrcLocRn locn $
- (if not (opt_GlasgowExts || is_standard_guard guarded) then
- addWarnRn (nonStdGuardErr guarded)
- else
- returnRn ()
- ) `thenRn_`
-
- rnStmts guarded `thenRn` \ ((_, guarded'), fvs) ->
- returnRn (GRHS guarded' locn, fvs)
- where
- -- Standard Haskell 1.4 guards are just a single boolean
- -- expression, rather than a list of qualifiers as in the
- -- Glasgow extension
- is_standard_guard [ResultStmt _ _] = True
- is_standard_guard [ExprStmt _ _, ResultStmt _ _] = True
- is_standard_guard other = False
-\end{code}