[project @ 2000-10-25 13:51:50 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / Simplify.lhs

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index bfd7f70..c972821 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -29,11 +29,11 @@ import Id           ( Id, idType, idInfo, isDataConId,
                          zapLamIdInfo, setOneShotLambda, 
                        )
 import IdInfo          ( OccInfo(..), isDeadOcc, isLoopBreaker,
-                         ArityInfo, setArityInfo, unknownArity,
+                         setArityInfo, unknownArity,
                          setUnfoldingInfo,
                          occInfo
                        )
-import Demand          ( Demand, isStrict )
+import Demand          ( isStrict )
 import DataCon         ( dataConNumInstArgs, dataConRepStrictness,
                          dataConSig, dataConArgTys
                        )
@@ -44,16 +44,16 @@ import CoreUnfold   ( mkOtherCon, mkUnfolding, otherCons,
                        )
 import CoreUtils       ( cheapEqExpr, exprIsDupable, exprIsTrivial, exprIsConApp_maybe,
                          exprType, coreAltsType, exprIsValue, idAppIsCheap,
-                         exprOkForSpeculation, etaReduceExpr,
+                         exprOkForSpeculation, 
                          mkCoerce, mkSCC, mkInlineMe, mkAltExpr
                        )
 import Rules           ( lookupRule )
 import CostCentre      ( currentCCS )
 import Type            ( mkTyVarTys, isUnLiftedType, seqType,
-                         mkFunTy, splitFunTy, splitTyConApp_maybe, 
+                         mkFunTy, splitTyConApp_maybe, 
                          funResultTy
                        )
-import Subst           ( mkSubst, substTy, substExpr,
+import Subst           ( mkSubst, substTy, 
                          isInScope, lookupIdSubst, substIdInfo
                        )
 import TyCon           ( isDataTyCon, tyConDataConsIfAvailable )
@@ -564,7 +564,6 @@ completeBinding old_bndr new_bndr top_lvl black_listed new_rhs thing_inside
     old_info          = idInfo old_bndr
     occ_info          = occInfo old_info
     loop_breaker      = isLoopBreaker occ_info
-    trivial_rhs              = exprIsTrivial new_rhs 
     must_keep_binding = black_listed || loop_breaker || isExportedId old_bndr
 
     finally_bind_it arity_info new_rhs
@@ -772,6 +771,7 @@ completeCall var occ cont
   = getBlackList               `thenSmpl` \ black_list_fn ->
     getInScope                 `thenSmpl` \ in_scope ->
     getContArgs var cont       `thenSmpl` \ (args, call_cont, inline_call) ->
+    getDOptsSmpl               `thenSmpl` \ dflags ->
     let
        black_listed       = black_list_fn var
        arg_infos          = [ interestingArg in_scope arg subst 
@@ -784,7 +784,7 @@ completeCall var occ cont
        inline_cont | inline_call = discardInline cont
                    | otherwise   = cont
 
-       maybe_inline = callSiteInline black_listed inline_call occ
+       maybe_inline = callSiteInline dflags black_listed inline_call occ
                                      var arg_infos interesting_cont
     in
        -- First, look for an inlining