Commit 3032ae81 authored by Ben Gamari's avatar Ben Gamari 🐢

Revert "Treat banged bindings as FunBinds"

This partially reverts commit 37299536 as it
doesn't actually fix #13594. Namely it does not revert the mkPrefixFunRhs
refactoring since this is rather independent from the functional changes.

Going to try again with a whole working patch
parent 8fd7442e
......@@ -1742,9 +1742,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 (L _ fun) _ -> (pprMatchContext kind,
\ pp -> ppr fun <+> pp)
_ -> (pprMatchContext kind, \ pp -> pp)
ppr_pats :: HsMatchContext Name -> [Pat Id] -> SDoc
ppr_pats kind pats
......
......@@ -132,41 +132,12 @@ 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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The distinction between FunBind and PatBind is a bit subtle. FunBind covers
patterns which resemble function bindings and simple variable bindings.
f x = e
f !x = e
f = e
!x = e -- FunRhs has SrcStrict
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 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
By contrast, PatBind represents data constructor patterns, as well as a few
other interesting cases. Namely,
Just x = e
(x) = e
x :: Ty = e
-}
-- | Haskell Binding with separate Left and Right id's
data HsBindLR idL idR
= -- | Function-like Binding
= -- | Function Binding
--
-- FunBind is used for both functions @f x = e@
-- and variables @f = \x -> e@
-- and strict variables @!x = x + 1@
--
-- Reason 1: Special case for type inference: see 'TcBinds.tcMonoBinds'.
--
......@@ -177,10 +148,6 @@ data HsBindLR idL idR
-- parses as a pattern binding, just like
-- @(f :: a -> a) = ... @
--
-- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
-- 'MatchContext'. See Note [Varities of binding pattern matches] for
-- details about the relationship between FunBind and PatBind.
--
-- 'ApiAnnotation.AnnKeywordId's
--
-- - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches
......@@ -221,10 +188,7 @@ data HsBindLR idL idR
-- | Pattern Binding
--
-- The pattern is never a simple variable;
-- That case is done by FunBind.
-- See Note [Varities of binding pattern matches] for details about the
-- relationship between FunBind and PatBind.
-- That case is done by FunBind
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',
-- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
......
......@@ -1454,8 +1454,8 @@ Example infix function definition requiring individual API Annotations
isInfixMatch :: Match id body -> Bool
isInfixMatch match = case m_ctxt match of
FunRhs {mc_fixity = Infix} -> True
_ -> False
FunRhs _ Infix -> True
_ -> False
isEmptyMatchGroup :: MatchGroup id body -> Bool
isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
......@@ -1534,7 +1534,7 @@ pprMatch match
ctxt = m_ctxt match
(herald, other_pats)
= case ctxt of
FunRhs {mc_fun=L _ fun, mc_fixity=fixity}
FunRhs (L _ fun) fixity
| fixity == Prefix -> (pprPrefixOcc fun, m_pats match)
-- f x y z = e
-- Not pprBndr; the AbsBinds will
......@@ -2333,17 +2333,9 @@ pp_dotdot = text " .. "
-- | Haskell Match Context
--
-- Context of a pattern match. This is more subtle than it would seem. See Note
-- [Varieties of pattern matches].
-- Context of a Match
data HsMatchContext id
= FunRhs { mc_fun :: Located id -- ^ function binder of @f@
, mc_fixity :: LexicalFixity -- ^ fixing of @f@
, mc_strictness :: SrcStrictness
-- ^ was the pattern banged? See
-- Note [Varities of binding pattern matches]
}
-- ^A pattern matching on an argument of a
-- function binding
= FunRhs (Located id) LexicalFixity -- ^Function binding for f, fixity
| LambdaExpr -- ^Patterns of a lambda
| CaseAlt -- ^Patterns and guards on a case alternative
| IfAlt -- ^Guards of a multi-way if alternative
......@@ -2364,8 +2356,7 @@ data HsMatchContext id
deriving instance (DataIdPost id) => Data (HsMatchContext id)
instance OutputableBndr id => Outputable (HsMatchContext id) where
ppr (FunRhs (L _ id) fix str)
= text "FunRhs" <+> ppr id <+> ppr fix <+> ppr str
ppr (FunRhs (L _ id) fix) = text "FunRhs" <+> ppr id <+> ppr fix
ppr LambdaExpr = text "LambdaExpr"
ppr CaseAlt = text "CaseAlt"
ppr IfAlt = text "IfAlt"
......@@ -2450,8 +2441,7 @@ pprMatchContext ctxt
pprMatchContextNoun :: (Outputable (NameOrRdrName id),Outputable id)
=> HsMatchContext id -> SDoc
pprMatchContextNoun (FunRhs {mc_fun=L _ fun})
= text "equation for"
pprMatchContextNoun (FunRhs (L _ fun) _) = text "equation for"
<+> quotes (ppr fun)
pprMatchContextNoun CaseAlt = text "case alternative"
pprMatchContextNoun IfAlt = text "multi-way if alternative"
......@@ -2511,7 +2501,7 @@ instance (Outputable id, Outputable (NameOrRdrName id))
-- Used to generate the string for a *runtime* error message
matchContextErrString :: Outputable id
=> HsMatchContext id -> SDoc
matchContextErrString (FunRhs{mc_fun=L _ fun}) = text "function" <+> ppr fun
matchContextErrString (FunRhs (L _ fun) _) = text "function" <+> ppr fun
matchContextErrString CaseAlt = text "case"
matchContextErrString IfAlt = text "multi-way if"
matchContextErrString PatBindRhs = text "pattern binding"
......
......@@ -751,9 +751,9 @@ mk_easy_FunBind loc fun pats expr
[mkMatch (mkPrefixFunRhs (L loc fun)) pats expr
(noLoc emptyLocalBinds)]
-- | Make a prefix, non-strict function 'HsMatchContext'
-- | Make a prefix 'FunRhs' 'HsMatchContext'
mkPrefixFunRhs :: Located id -> HsMatchContext id
mkPrefixFunRhs n = FunRhs n Prefix NoSrcStrict
mkPrefixFunRhs n = FunRhs n Prefix
------------
mkMatch :: HsMatchContext (NameOrRdrName id) -> [LPat id] -> LHsExpr id
......
......@@ -2181,28 +2181,20 @@ docdecld :: { LDocDecl }
decl_no_th :: { LHsDecl RdrName }
: sigdecl { $1 }
| '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)
-- Turn it all into an expression so that
-- checkPattern can check that bangs are enabled
; l = comb2 $1 $> };
(ann, r) <- checkValDef empty SrcStrict e Nothing $3 ;
-- Depending upon what the pattern looks like we might get either
-- a FunBind or PatBind back from checkValDef. See Note
-- [Varieties of binding pattern matches]
case r of {
(FunBind n _ _ _ _) ->
ams (L l ()) [mj AnnFunId n] >> return () ;
(PatBind (L lh _lhs) _rhs _ _ _) ->
ams (L lh ()) [] >> return () } ;
_ <- ams (L l ()) (ann ++ fst (unLoc $3)) ;
return $! (sL l $ ValD r) } }
| infixexp_top opt_sig rhs {% do { (ann,r) <- checkValDef empty NoSrcStrict $1 (snd $2) $3;
| '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2) };
pat <- checkPattern empty e;
_ <- ams (sLL $1 $> ())
(fst $ unLoc $3);
return $ sLL $1 $> $ ValD $
PatBind pat (snd $ unLoc $3)
placeHolderType
placeHolderNames
([],[]) } }
-- Turn it all into an expression so that
-- checkPattern can check that bangs are enabled
| infixexp_top opt_sig rhs {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
let { l = comb2 $1 $> };
-- Depending upon what the pattern looks like we might get either
-- a FunBind or PatBind back from checkValDef. See Note
-- [Varieties of binding pattern matches]
case r of {
(FunBind n _ _ _ _) ->
ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
......
......@@ -514,9 +514,9 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
wrongNameBindingErr loc decl
; match <- case details of
PrefixCon pats ->
return $ Match (FunRhs ln Prefix NoSrcStrict) pats Nothing rhs
return $ Match (FunRhs ln Prefix) pats Nothing rhs
InfixCon pat1 pat2 ->
return $ Match (FunRhs ln Infix NoSrcStrict) [pat1, pat2] Nothing rhs
return $ Match (FunRhs ln Infix) [pat1, pat2] Nothing rhs
RecCon{} -> recordPatSynErr loc pat
; return $ L loc match }
fromDecl (L loc decl) = extraDeclErr loc decl
......@@ -923,27 +923,25 @@ patIsRec e = e == mkUnqual varName (fsLit "rec")
-- Check Equation Syntax
checkValDef :: SDoc
-> SrcStrictness
-> LHsExpr RdrName
-> Maybe (LHsType RdrName)
-> Located (a,GRHSs RdrName (LHsExpr RdrName))
-> P ([AddAnn],HsBind RdrName)
checkValDef msg _strictness lhs (Just sig) grhss
checkValDef msg lhs (Just sig) grhss
-- x :: ty = rhs parses as a *pattern* binding
= checkPatBind msg (L (combineLocs lhs sig)
(ExprWithTySig lhs (mkLHsSigWcType sig))) grhss
checkValDef msg strictness lhs opt_sig g@(L l (_,grhss))
checkValDef msg lhs opt_sig g@(L l (_,grhss))
= do { mb_fun <- isFunLhs lhs
; case mb_fun of
Just (fun, is_infix, pats, ann) ->
checkFunBind msg strictness ann (getLoc lhs)
checkFunBind msg ann (getLoc lhs)
fun is_infix pats opt_sig (L l grhss)
Nothing -> checkPatBind msg lhs g }
checkFunBind :: SDoc
-> SrcStrictness
-> [AddAnn]
-> SrcSpan
-> Located RdrName
......@@ -952,13 +950,13 @@ checkFunBind :: SDoc
-> Maybe (LHsType RdrName)
-> Located (GRHSs RdrName (LHsExpr RdrName))
-> P ([AddAnn],HsBind RdrName)
checkFunBind msg strictness ann lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
checkFunBind msg ann lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
= do ps <- checkPatterns msg pats
let match_span = combineSrcSpans lhs_loc rhs_span
-- 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 fun is_infix
, m_pats = ps
, m_type = opt_sig
, m_grhss = grhss })])
......
......@@ -1166,8 +1166,8 @@ rnMatch' ctxt rnBody match@(Match { m_ctxt = mf, m_pats = pats
; rnPats ctxt pats $ \ pats' -> do
{ (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
; let mf' = case (ctxt,mf) of
(FunRhs (L _ funid) _ _,FunRhs (L lf _) _ _)
-> FunRhs (L lf funid) fixity NoSrcStrict -- TODO: Is this right?
(FunRhs (L _ funid) _,FunRhs (L lf _) _)
-> FunRhs (L lf funid) fixity
_ -> ctxt
; return (Match { m_ctxt = mf', m_pats = pats'
, m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }}
......
......@@ -204,8 +204,7 @@
(FunRhs
({ DumpParsedAst.hs:11:1-4 }
(Unqual {OccName: main}))
(Prefix)
(NoSrcStrict))
(Prefix))
[]
(Nothing)
(GRHSs
......
......@@ -17,8 +17,7 @@
(Match
(FunRhs
({ DumpRenamedAst.hs:11:1-4 }{Name: main:DumpRenamedAst.main{v}})
(Prefix)
(NoSrcStrict))
(Prefix))
[]
(Nothing)
(GRHSs
......
......@@ -244,8 +244,7 @@
(Match
(FunRhs
({ DumpTypecheckedAst.hs:11:1-4 }{Name: main:DumpTypecheckedAst.main{v}})
(Prefix)
(NoSrcStrict))
(Prefix))
[]
(Nothing)
(GRHSs
......
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