X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FndpFlatten%2FFlattenMonad.hs;h=245e88d63bfc8611762c5e45b0808f772a99a9e9;hb=19b44dcc5e5b9f92735fa99aa45dfaa94777177c;hp=45405088fc67f96e55650b2f4c9f7a89bcae9e42;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/ndpFlatten/FlattenMonad.hs b/compiler/ndpFlatten/FlattenMonad.hs
index 4540508..245e88d 100644
--- a/compiler/ndpFlatten/FlattenMonad.hs
+++ b/compiler/ndpFlatten/FlattenMonad.hs
@@ -40,6 +40,13 @@
 --  * One FIXME left to resolve.
 --
 
+{-# 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 FlattenMonad (
 
   -- monad definition
@@ -75,7 +82,7 @@ import VarEnv       (VarEnv, emptyVarEnv, zipVarEnv, plusVarEnv,
 		     elemVarEnv, lookupVarEnv, lookupVarEnv_NF, delVarEnvList)
 import Type	    (Type, tyConAppTyCon)
 import HscTypes	    (HomePackageTable,
-		     ExternalPackageState(eps_PTE), HscEnv(hsc_HPT),
+		     ExternalPackageState(eps_PTE), HscEnv(..),
 		     TyThing(..), lookupType)
 import PrelNames    ( fstName, andName, orName,
 		     lengthPName, replicatePName, mapPName, bpermutePName,
@@ -83,6 +90,7 @@ import PrelNames    ( fstName, andName, orName,
 import TysPrim      ( charPrimTyCon, intPrimTyCon, floatPrimTyCon, doublePrimTyCon )
 import PrimOp	    ( PrimOp(..) )
 import PrelInfo	    ( primOpId )
+import DynFlags	    (DynFlags)
 import CoreSyn      (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps)
 import CoreUtils    (exprType)
 import FastString   (FastString)
@@ -128,11 +136,12 @@ data FlattenState = FlattenState {
 
 -- initial value of the flattening state
 --
-initialFlattenState :: ExternalPackageState
+initialFlattenState :: DynFlags
+		    -> ExternalPackageState
 		    -> HomePackageTable 
 		    -> UniqSupply 
 		    -> FlattenState
-initialFlattenState eps hpt us = 
+initialFlattenState dflags eps hpt us = 
   FlattenState {
     us	     = us,
     env      = lookup,
@@ -142,7 +151,7 @@ initialFlattenState eps hpt us =
   }
   where
     lookup n = 
-      case lookupType hpt (eps_PTE eps) n of
+      case lookupType dflags hpt (eps_PTE eps) n of
         Just (AnId v) -> v 
 	_             -> pprPanic "FlattenMonad: unknown name:" (ppr n)
 
@@ -167,7 +176,8 @@ runFlatten :: HscEnv
 	   -> Flatten a 
 	   -> a    
 runFlatten hsc_env eps us m 
-  = fst $ unFlatten m (initialFlattenState eps (hsc_HPT hsc_env) us)
+  = fst $ unFlatten m (initialFlattenState (hsc_dflags hsc_env) 
+						eps (hsc_HPT hsc_env) us)
 
 
 -- variable generation