remove empty dir

[ghc-hetmet.git] / ghc / compiler / stranal / WorkWrap.lhs

diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
index d587894..64eba89 100644 (file)
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ b/ghc/compiler/stranal/WorkWrap.lhs
@@ -11,7 +11,7 @@ module WorkWrap ( wwTopBinds, mkWrapper ) where
 import CoreSyn
 import CoreUnfold      ( certainlyWillInline )
 import CoreLint                ( showPass, endPass )
-import CoreUtils       ( exprType, exprIsValue )
+import CoreUtils       ( exprType, exprIsHNF )
 import Id              ( Id, idType, isOneShotLambda, 
                          setIdNewStrictness, mkWorkerId,
                          setIdWorkerInfo, setInlinePragma,
@@ -29,7 +29,7 @@ import Unique         ( hasKey )
 import BasicTypes      ( RecFlag(..), isNonRec, Activation(..) )
 import VarEnv          ( isEmptyVarEnv )
 import Maybes          ( orElse )
-import CmdLineOpts
+import DynFlags
 import WwLib
 import Util            ( lengthIs, notNull )
 import Outputable
@@ -158,10 +158,10 @@ wwExpr (Let bind expr)
     wwExpr expr                        `thenUs` \ new_expr ->
     returnUs (mkLets intermediate_bind new_expr)
 
-wwExpr (Case expr binder alts)
+wwExpr (Case expr binder ty alts)
   = wwExpr expr                                `thenUs` \ new_expr ->
     mapUs ww_alt alts                  `thenUs` \ new_alts ->
-    returnUs (Case new_expr binder new_alts)
+    returnUs (Case new_expr binder ty new_alts)
   where
     ww_alt (con, binders, rhs)
       =        wwExpr rhs                      `thenUs` \ new_rhs ->
@@ -228,7 +228,6 @@ tryWW is_rec fn_id rhs
     maybe_fn_dmd = newDemandInfo fn_info
     unfolding   = unfoldingInfo fn_info
     inline_prag  = inlinePragInfo fn_info
-    maybe_sig    = newStrictnessInfo fn_info
 
        -- In practice it always will have a strictness 
        -- signature, even if it's a uninformative one
@@ -245,7 +244,7 @@ tryWW is_rec fn_id rhs
                                     StrictSig (mkTopDmdType wrap_dmds res_info)
 
     is_fun    = notNull wrap_dmds
-    is_thunk  = not is_fun && not (exprIsValue rhs)
+    is_thunk  = not is_fun && not (exprIsHNF rhs)
 
 ---------------------
 splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs