diff options
author | Ben Gamari <bgamari.foss@gmail.com> | 2017-05-08 17:47:19 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-05-08 22:26:41 -0400 |
commit | 372995364c52eef15066132d7d1ea8b6760034e6 (patch) | |
tree | 1b5d39684c0fe65636a43ff67405615abd2ea8c6 /compiler/parser/RdrHsSyn.hs | |
parent | b99bae6d132e083b73283963be85932596341ddd (diff) | |
download | haskell-372995364c52eef15066132d7d1ea8b6760034e6.tar.gz |
Treat banged bindings as FunBinds
This reworks the HsSyn representation to make banged variable patterns
(e.g. !x = e) be represented as FunBinds instead of PatBinds, adding a flag to
FunRhs to record the bang.
Fixes #13594.
Reviewers: austin, goldfire, alanz, simonpj
Reviewed By: simonpj
Subscribers: simonpj, rwbarton, thomie, mpickering
Differential Revision: https://phabricator.haskell.org/D3525
Diffstat (limited to 'compiler/parser/RdrHsSyn.hs')
-rw-r--r-- | compiler/parser/RdrHsSyn.hs | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 5b1006ac79..db11287b26 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -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) pats Nothing rhs + return $ Match (FunRhs ln Prefix NoSrcStrict) pats Nothing rhs InfixCon pat1 pat2 -> - return $ Match (FunRhs ln Infix) [pat1, pat2] Nothing rhs + return $ Match (FunRhs ln Infix NoSrcStrict) [pat1, pat2] Nothing rhs RecCon{} -> recordPatSynErr loc pat ; return $ L loc match } fromDecl (L loc decl) = extraDeclErr loc decl @@ -923,25 +923,27 @@ 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 lhs (Just sig) grhss +checkValDef msg _strictness 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 lhs opt_sig g@(L l (_,grhss)) +checkValDef msg strictness lhs opt_sig g@(L l (_,grhss)) = do { mb_fun <- isFunLhs lhs ; case mb_fun of Just (fun, is_infix, pats, ann) -> - checkFunBind msg ann (getLoc lhs) + checkFunBind msg strictness ann (getLoc lhs) fun is_infix pats opt_sig (L l grhss) Nothing -> checkPatBind msg lhs g } checkFunBind :: SDoc + -> SrcStrictness -> [AddAnn] -> SrcSpan -> Located RdrName @@ -950,13 +952,13 @@ checkFunBind :: SDoc -> Maybe (LHsType RdrName) -> Located (GRHSs RdrName (LHsExpr RdrName)) -> P ([AddAnn],HsBind RdrName) -checkFunBind msg ann lhs_loc fun is_infix pats opt_sig (L rhs_span grhss) +checkFunBind msg strictness 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 + [L match_span (Match { m_ctxt = FunRhs fun is_infix strictness , m_pats = ps , m_type = opt_sig , m_grhss = grhss })]) |