[commit: ghc] wip/rwbarton-simplify: Fix space leaks in simplifier (#13426) (91a584e)

[git at git.haskell.org]

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

On branch  : wip/rwbarton-simplify
Link       : http://ghc.haskell.org/trac/ghc/changeset/91a584e237379a5d8dbe4d7be0e08c6ccca3132a/ghc

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

commit 91a584e237379a5d8dbe4d7be0e08c6ccca3132a
Author: Reid Barton <rwbarton at gmail.com>
Date:   Mon Mar 27 22:15:29 2017 -0400

    Fix space leaks in simplifier (#13426)


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

91a584e237379a5d8dbe4d7be0e08c6ccca3132a
 compiler/simplCore/Simplify.hs | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index e78714d..065f524 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -1001,16 +1001,22 @@ simplExprF1 env (Lit lit)      cont = rebuild env (Lit lit) cont
 simplExprF1 env (Tick t expr)  cont = simplTick env t expr cont
 simplExprF1 env (Cast body co) cont = simplCast env body co cont
 simplExprF1 env (Coercion co)  cont = simplCoercionF env co cont
-simplExprF1 env (Type ty)      cont = ASSERT( contIsRhsOrArg cont )
-                                      rebuild env (Type (substTy env ty)) cont
+simplExprF1 env (Type ty)      cont = ASSERT( contIsRhsOrArg cont ) do {
+                                      ty' <- simplType env ty;
+                                      rebuild env (Type ty') cont }
 
 simplExprF1 env (App fun arg) cont
-  = simplExprF env fun $
-    case arg of
-      Type ty -> ApplyToTy  { sc_arg_ty  = substTy env ty
-                            , sc_hole_ty = substTy env (exprType fun)
-                            , sc_cont    = cont }
-      _       -> ApplyToVal { sc_arg = arg, sc_env = env
+  = case arg of
+      Type ty -> do {
+        ty' <- simplType env ty;
+        hole' <- simplType env (exprType fun);
+        simplExprF env fun (ApplyToTy {
+                               sc_arg_ty  = ty'
+                             , sc_hole_ty = hole'
+                             , sc_cont    = cont })
+        }
+      _       -> simplExprF env fun $
+                 ApplyToVal { sc_arg = arg, sc_env = env
                             , sc_dup = NoDup, sc_cont = cont }
 
 simplExprF1 env expr@(Lam {}) cont
@@ -2217,7 +2223,7 @@ reallyRebuildCase env scrut case_bndr alts cont
 
         ; dflags <- getDynFlags
         ; let alts_ty' = contResultType dup_cont
-        ; case_expr <- mkCase dflags scrut' case_bndr' alts_ty' alts'
+        ; case_expr <- seqType alts_ty' `seq` mkCase dflags scrut' case_bndr' alts_ty' alts'
 
         -- Notice that rebuild gets the in-scope set from env', not alt_env
         -- (which in any case is only build in simplAlts)