summaryrefslogtreecommitdiff
path: root/compiler/parser/RdrHsSyn.hs
diff options
context:
space:
mode:
authorBen Gamari <bgamari.foss@gmail.com>2017-05-08 17:47:19 -0400
committerBen Gamari <ben@smart-cactus.org>2017-05-08 22:26:41 -0400
commit372995364c52eef15066132d7d1ea8b6760034e6 (patch)
tree1b5d39684c0fe65636a43ff67405615abd2ea8c6 /compiler/parser/RdrHsSyn.hs
parentb99bae6d132e083b73283963be85932596341ddd (diff)
downloadhaskell-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.hs16
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 })])