summaryrefslogtreecommitdiff
path: root/compiler/parser
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-05-12 16:59:33 -0400
committerBen Gamari <ben@smart-cactus.org>2017-05-12 18:26:51 -0400
commit3032ae81dd14c2eaefa9ecd8880dafa9bda104d9 (patch)
tree0c2dfb95e9faf6f497e2ec4d54893db6c1450a45 /compiler/parser
parent8fd7442efcf6ef0a274f51657633818bd878eb5c (diff)
downloadhaskell-3032ae81dd14c2eaefa9ecd8880dafa9bda104d9.tar.gz
Revert "Treat banged bindings as FunBinds"
This partially reverts commit 372995364c52eef15066132d7d1ea8b6760034e6 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
Diffstat (limited to 'compiler/parser')
-rw-r--r--compiler/parser/Parser.y34
-rw-r--r--compiler/parser/RdrHsSyn.hs16
2 files changed, 20 insertions, 30 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index c525ddf055..7af02053fd 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -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 () ;
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index d7facdc4f0..d6fc6fb642 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 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 })])