Commit 2535a671 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactoring around FunRhs

* Clarify the comments around the mc_strictness field of FunRhs
* Use record field names consistently for FunRhs
parent c6d4219a
......@@ -1741,9 +1741,9 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun
(ppr_match, pref)
= case kind of
FunRhs (L _ fun) _ _ -> (pprMatchContext kind,
\ pp -> ppr fun <+> pp)
_ -> (pprMatchContext kind, \ pp -> pp)
FunRhs { mc_fun = L _ fun }
-> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
_ -> (pprMatchContext kind, \ pp -> pp)
ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc
ppr_pats kind pats
......
......@@ -129,9 +129,8 @@ type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
-- | Located Haskell Binding with separate Left and Right identifier types
type LHsBindLR idL idR = Located (HsBindLR idL idR)
{- Note [Varieties of binding pattern matches]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{- Note [FunBind vs PatBind]
~~~~~~~~~~~~~~~~~~~~~~~~~
The distinction between FunBind and PatBind is a bit subtle. FunBind covers
patterns which resemble function bindings and simple variable bindings.
......@@ -142,12 +141,17 @@ patterns which resemble function bindings and simple variable bindings.
x `f` y = e -- FunRhs has Infix
The actual patterns and RHSs of a FunBind are encoding in fun_matches.
The m_ctxt field of Match will be FunRhs and carries two bits of information
about the match,
The m_ctxt field of each Match in fun_matches will be FunRhs and carries
two bits of information about the match,
* The mc_fixity field on each Match describes the fixity of the
function binder in that match. E.g. this is legal:
f True False = e1
True `f` True = e2
* the mc_strictness field describes whether the match is decorated with a bang
(e.g. `!x = e`)
* the mc_fixity field describes the fixity of the function binder
* The mc_strictness field is used /only/ for nullary FunBinds: ones
with one Match, which has no pats. For these, it describes whether
the match is decorated with a bang (e.g. `!x = e`).
By contrast, PatBind represents data constructor patterns, as well as a few
other interesting cases. Namely,
......@@ -175,7 +179,7 @@ data HsBindLR idL idR
-- @(f :: a -> a) = ... @
--
-- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
-- 'MatchContext'. See Note [Varieties of binding pattern matches] for
-- 'MatchContext'. See Note [FunBind vs PatBind] for
-- details about the relationship between FunBind and PatBind.
--
-- 'ApiAnnotation.AnnKeywordId's
......@@ -219,7 +223,7 @@ data HsBindLR idL idR
--
-- The pattern is never a simple variable;
-- That case is done by FunBind.
-- See Note [Varieties of binding pattern matches] for details about the
-- See Note [FunBind vs PatBind] for details about the
-- relationship between FunBind and PatBind.
--
......
......@@ -2359,11 +2359,10 @@ pp_dotdot = text " .. "
-- Context of a pattern match. This is more subtle than it would seem. See Note
-- [Varieties of pattern matches].
data HsMatchContext id -- Not an extensible tag
= FunRhs { mc_fun :: Located id -- ^ function binder of @f@
, mc_fixity :: LexicalFixity -- ^ fixing of @f@
, mc_strictness :: SrcStrictness
-- ^ was the pattern banged? See
-- Note [Varieties of binding pattern matches]
= FunRhs { mc_fun :: Located id -- ^ function binder of @f@
, mc_fixity :: LexicalFixity -- ^ fixing of @f@
, mc_strictness :: SrcStrictness -- ^ was @f@ banged?
-- See Note [FunBind vs PatBind]
}
-- ^A pattern matching on an argument of a
-- function binding
......
......@@ -758,7 +758,9 @@ mk_easy_FunBind loc fun pats expr
-- | Make a prefix, non-strict function 'HsMatchContext'
mkPrefixFunRhs :: Located id -> HsMatchContext id
mkPrefixFunRhs n = FunRhs n Prefix NoSrcStrict
mkPrefixFunRhs n = FunRhs { mc_fun = n
, mc_fixity = Prefix
, mc_strictness = NoSrcStrict }
------------
mkMatch :: HsMatchContext (NameOrRdrName (IdP p)) -> [LPat p] -> LHsExpr p
......
......@@ -514,10 +514,16 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
do { unless (name == patsyn_name) $
wrongNameBindingErr loc decl
; match <- case details of
PrefixCon pats ->
return $ Match (FunRhs ln Prefix NoSrcStrict) pats Nothing rhs
InfixCon pat1 pat2 ->
return $ Match (FunRhs ln Infix NoSrcStrict) [pat1, pat2] Nothing rhs
PrefixCon pats -> return $ Match { m_ctxt = ctxt, m_pats = pats
, m_type = Nothing, m_grhss = rhs }
where
ctxt = FunRhs { mc_fun = ln, mc_fixity = Prefix, mc_strictness = NoSrcStrict }
InfixCon p1 p2 -> return $ Match { m_ctxt = ctxt, m_pats = [p1, p2]
, m_type = Nothing, m_grhss = rhs }
where
ctxt = FunRhs { mc_fun = ln, mc_fixity = Infix, mc_strictness = NoSrcStrict }
RecCon{} -> recordPatSynErr loc pat
; return $ L loc match }
fromDecl (L loc decl) = extraDeclErr loc decl
......@@ -960,7 +966,9 @@ checkFunBind msg strictness ann lhs_loc fun is_infix pats opt_sig (L rhs_span gr
-- Add back the annotations stripped from any HsPar values in the lhs
-- mapM_ (\a -> a match_span) ann
return (ann, makeFunBind fun
[L match_span (Match { m_ctxt = FunRhs fun is_infix strictness
[L match_span (Match { m_ctxt = FunRhs { mc_fun = fun
, mc_fixity = is_infix
, mc_strictness = strictness }
, m_pats = ps
, m_type = opt_sig
, m_grhss = grhss })])
......@@ -1075,7 +1083,7 @@ isFunLhs e = go e [] []
go (L l (HsPar e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
-- Things of the form `!x` are also FunBinds
-- See Note [Varieties of binding pattern matches]
-- See Note [FunBind vs PatBind]
go (L _ (SectionR (L _ (HsVar (L _ bang))) (L l (HsVar (L _ var))))) [] ann
| bang == bang_RDR
, not (isRdrDataCon var) = return (Just (L l var, Prefix, [], ann))
......
......@@ -47,7 +47,7 @@ import NameSet
import RdrName ( RdrName, rdrNameOcc )
import SrcLoc
import ListSetOps ( findDupsEq )
import BasicTypes ( RecFlag(..), LexicalFixity(..) )
import BasicTypes ( RecFlag(..) )
import Digraph ( SCC(..) )
import Bag
import Util
......@@ -1162,14 +1162,13 @@ rnMatch' ctxt rnBody match@(Match { m_ctxt = mf, m_pats = pats
Nothing -> return ()
Just (L loc ty) -> addErrAt loc (resSigErr match ty)
; let fixity = if isInfixMatch match then Infix else Prefix
-- Now the main event
-- Note that there are no local fixity decls for matches
; rnPats ctxt pats $ \ pats' -> do
{ (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
; let mf' = case (ctxt,mf) of
(FunRhs (L _ funid) _ _,FunRhs (L lf _) _ strict)
-> FunRhs (L lf funid) fixity strict
; let mf' = case (ctxt, mf) of
(FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })
-> mf { mc_fun = L lf funid }
_ -> ctxt
; return (Match { m_ctxt = mf', m_pats = pats'
, m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }}
......
......@@ -99,10 +99,11 @@ tcMatchesFun fn@(L _ fun_name) matches exp_ty
arity = matchGroupArity matches
herald = text "The equation(s) for"
<+> quotes (ppr fun_name) <+> text "have"
match_ctxt = MC { mc_what = FunRhs fn Prefix strictness, mc_body = tcBody }
what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness }
match_ctxt = MC { mc_what = what, mc_body = tcBody }
strictness
| [L _ match] <- unLoc $ mg_alts matches
, FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
, FunRhs{ mc_strictness = SrcStrict } <- m_ctxt match
= SrcStrict
| otherwise
= NoSrcStrict
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment