diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-06-27 10:30:20 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-06-27 13:34:05 -0400 |
| commit | 6567c815135e93f8550d526f81d13f31c0cd92b6 (patch) | |
| tree | cf842eaf2045f5ae36579b5e64200c61a8fe7b75 /compiler/hsSyn/HsUtils.hs | |
| parent | 1e471265c1ea9b2c4e9709adc182c36d0635f071 (diff) | |
| download | haskell-6567c815135e93f8550d526f81d13f31c0cd92b6.tar.gz | |
Treat banged bindings as FunBinds
This is another attempt at resolving #13594 by treating strict variable
binds as FunBinds instead of PatBinds (as suggested in comment:1).
Test Plan: Validate
Reviewers: austin, alanz
Subscribers: rwbarton, thomie, mpickering
GHC Trac Issues: #13594
Differential Revision: https://phabricator.haskell.org/D3670
Diffstat (limited to 'compiler/hsSyn/HsUtils.hs')
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index c1a9a2f252..ba001ea7ff 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -72,7 +72,7 @@ module HsUtils( noRebindableInfo, -- Collecting binders - isUnliftedHsBind, + isUnliftedHsBind, isBangedBind, collectLocalBinders, collectHsValBinders, collectHsBindListBinders, collectHsIdBinders, @@ -756,9 +756,9 @@ mk_easy_FunBind loc fun pats expr [mkMatch (mkPrefixFunRhs (L loc fun)) pats expr (noLoc emptyLocalBinds)] --- | Make a prefix 'FunRhs' 'HsMatchContext' +-- | Make a prefix, non-strict function 'HsMatchContext' mkPrefixFunRhs :: Located id -> HsMatchContext id -mkPrefixFunRhs n = FunRhs n Prefix +mkPrefixFunRhs n = FunRhs n Prefix NoSrcStrict ------------ mkMatch :: HsMatchContext (NameOrRdrName (IdP p)) -> [LPat p] -> LHsExpr p @@ -859,6 +859,15 @@ isUnliftedHsBind bind -- would get type forall a. Num a => (# a, Bool #) -- and we want to reject that. See Trac #9140 +-- | Is a binding a strict variable bind (e.g. @!x = ...@)? +isBangedBind :: HsBind GhcTc -> Bool +isBangedBind b | isBangedPatBind b = True +isBangedBind (FunBind {fun_matches = matches}) + | [L _ match] <- unLoc $ mg_alts matches + , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match + = True +isBangedBind _ = False + collectLocalBinders :: HsLocalBindsLR idL idR -> [IdP idL] collectLocalBinders (HsValBinds binds) = collectHsIdBinders binds -- No pattern synonyms here |