FIX BUILD with GHC 6.4.x
[ghc-hetmet.git] / compiler / stranal / DmdAnal.lhs
index 4c5de96..eec165a 100644 (file)
@@ -7,6 +7,13 @@
                        -----------------
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module DmdAnal ( dmdAnalPgm, dmdAnalTopRhs, 
                 both {- needed by WwLib -}
    ) where
@@ -43,11 +50,13 @@ import UniqFM               ( plusUFM_C, addToUFM_Directly, lookupUFM_Directly,
 import Type            ( isUnLiftedType, coreEqType, splitTyConApp_maybe )
 import Coercion         ( coercionKind )
 import CoreLint                ( showPass, endPass )
-import Util            ( mapAndUnzip, mapAccumL, mapAccumR, lengthIs )
+import Util            ( mapAndUnzip, lengthIs )
 import BasicTypes      ( Arity, TopLevelFlag(..), isTopLevel, isNeverActive,
                          RecFlag(..), isRec )
 import Maybes          ( orElse, expectJust )
 import Outputable
+
+import Data.List
 \end{code}
 
 To think about
@@ -647,15 +656,6 @@ nonAbsentArgs (d   : ds) = 1 + nonAbsentArgs ds
 %************************************************************************
 
 \begin{code}
-splitDmdTy :: DmdType -> (Demand, DmdType)
--- Split off one function argument
--- We already have a suitable demand on all
--- free vars, so no need to add more!
-splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)
-splitDmdTy ty@(DmdType fv [] res_ty)      = (resTypeArgDmd res_ty, ty)
-\end{code}
-
-\begin{code}
 unitVarDmd var dmd = DmdType (unitVarEnv var dmd) [] TopRes
 
 addVarDmd top_lvl dmd_ty@(DmdType fv ds res) var dmd
@@ -860,6 +860,13 @@ dmdTransform sigs var dmd
 %************************************************************************
 
 \begin{code}
+splitDmdTy :: DmdType -> (Demand, DmdType)
+-- Split off one function argument
+-- We already have a suitable demand on all
+-- free vars, so no need to add more!
+splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)
+splitDmdTy ty@(DmdType fv [] res_ty)      = (resTypeArgDmd res_ty, ty)
+
 splitCallDmd :: Demand -> (Int, Demand)
 splitCallDmd (Call d) = case splitCallDmd d of
                          (n, r) -> (n+1, r)
@@ -874,7 +881,6 @@ deferType (DmdType fv _ _) = DmdType (deferEnv fv) [] TopRes
        -- Notice that we throw away info about both arguments and results
        -- For example,   f = let ... in \x -> x
        -- We don't want to get a stricness type V->T for f.
-       -- Peter??
 
 deferEnv :: DmdEnv -> DmdEnv
 deferEnv fv = mapVarEnv defer fv