[commit: ghc] master: Remove redundant goop (7f2dee8)

git at git.haskell.org git at git.haskell.org
Mon Jul 31 12:37:13 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7f2dee8e5de5dbc09a7fb66ec54fd41ab4b1b2eb/ghc

>---------------------------------------------------------------

commit 7f2dee8e5de5dbc09a7fb66ec54fd41ab4b1b2eb
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Jul 31 13:25:17 2017 +0100

    Remove redundant goop
    
    See comment:22 in Trac #13594


>---------------------------------------------------------------

7f2dee8e5de5dbc09a7fb66ec54fd41ab4b1b2eb
 compiler/deSugar/Match.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index a870c6f..95cf40d 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -749,14 +749,9 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
                          matchEquations ctxt new_vars eqns_info rhs_ty
         ; return (new_vars, result_expr) }
   where
-    mk_eqn_info vars (L _ (Match ctx pats _ grhss))
+    mk_eqn_info vars (L _ (Match { m_pats = pats, m_grhss = grhss }))
       = do { dflags <- getDynFlags
-           ; let add_bang
-                   | FunRhs {mc_strictness=SrcStrict} <- ctx
-                   = pprTrace "addBang" empty addBang
-                   | otherwise
-                   = decideBangHood dflags
-                 upats = map (unLoc . add_bang) pats
+           ; let upats = map (unLoc . decideBangHood dflags) pats
                  dicts = toTcTypeBag (collectEvVarsPats upats) -- Only TcTyVars
            ; tm_cs <- genCaseTmCs2 mb_scr upats vars
            ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]



More information about the ghc-commits mailing list