X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FndpFlatten%2FFlattening.hs;h=4f0f86b53a73ac79c9a154c6c27b31ad453943a4;hb=05afb7485eea44d6410139f8a20c94b6f66c46f2;hp=b8bf32dfe1f7b5d0c63fed78dfbabd203fae114e;hpb=ce9687a5f450014c5596b32de8e8a7b99b6389e8;p=ghc-hetmet.git

diff --git a/ghc/compiler/ndpFlatten/Flattening.hs b/ghc/compiler/ndpFlatten/Flattening.hs
index b8bf32d..4f0f86b 100644
--- a/ghc/compiler/ndpFlatten/Flattening.hs
+++ b/ghc/compiler/ndpFlatten/Flattening.hs
@@ -56,7 +56,7 @@ module Flattening (
 
 -- friends
 import NDPCoreUtils (tupleTyArgs, funTyArgs, parrElemTy, isDefault,
-		     isLit, mkPArrTy, mkTuple, isSimpleExpr, boolTy, substIdEnv)
+		     isLit, mkPArrTy, mkTuple, isSimpleExpr, substIdEnv)
 import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext,
 		     liftVar, liftConst, intersectWithContext, mk'fst,
 		     mk'lengthP, mk'replicateP, mk'mapP, mk'bpermuteDftP,
@@ -66,28 +66,30 @@ import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext,
 import CmdLineOpts  (opt_Flatten)
 import Panic        (panic)
 import ErrUtils     (dumpIfSet_dyn)
-import UniqSupply   (UniqSupply, mkSplitUniqSupply)
-import CmdLineOpts  (DynFlag(..), DynFlags)
+import UniqSupply   (mkSplitUniqSupply)
+import CmdLineOpts  (DynFlag(..))
 import Literal      (Literal, literalType)
-import Var	    (Var(..),TyVar)
+import Var	    (Var(..))
 import DataCon	    (DataCon, dataConTag)
 import TypeRep      (Type(..))
 import Type         (isTypeKind)
-import HscTypes	    (HomeSymbolTable, PersistentCompilerState, ModDetails(..))
+import HscTypes	    (PersistentCompilerState, ModGuts(..), 
+		     ModGuts, HscEnv(..) )
 import CoreFVs	    (exprFreeVars)
 import CoreSyn	    (Expr(..), Bind(..), Alt(..), AltCon(..), Note(..),
-		     CoreBndr, CoreExpr, CoreBind, CoreAlt, mkLams, mkLets,
+		     CoreBndr, CoreExpr, CoreBind, mkLams, mkLets,
 		     mkApps, mkIntLitInt)  
 import PprCore      (pprCoreExpr)
 import CoreLint	    (showPass, endPass)
 
 import CoreUtils    (exprType, applyTypeToArg, mkPiType)
-import VarEnv       (IdEnv, mkVarEnv, zipVarEnv, extendVarEnv)
+import VarEnv       (zipVarEnv)
 import TysWiredIn   (mkTupleTy)
 import BasicTypes   (Boxity(..))
-import Outputable   (showSDoc, Outputable(..))
+import Outputable
 import FastString
 
+
 -- FIXME: fro debugging - remove this
 import TRACE    (trace)
 
@@ -100,15 +102,16 @@ import Monad        (liftM, foldM)
 -- entry point to the flattening transformation for the compiler driver when
 -- compiling a complete module (EXPORTED) 
 --
-flatten :: DynFlags 
+flatten :: HscEnv
 	-> PersistentCompilerState 
-	-> HomeSymbolTable
-	-> ModDetails			-- the module to be flattened
-	-> IO ModDetails
-flatten dflags pcs hst modDetails@(ModDetails {md_binds = binds}) 
-  | not opt_Flatten = return modDetails -- skip without -fflatten
+	-> ModGuts
+	-> IO ModGuts
+flatten hsc_env pcs mod_impl@(ModGuts {mg_binds = binds}) 
+  | not opt_Flatten = return mod_impl -- skip without -fflatten
   | otherwise       =
   do
+    let dflags = hsc_dflags hsc_env
+
     us <- mkSplitUniqSupply 'l'		-- 'l' as in fLattening
     --
     -- announce vectorisation
@@ -117,26 +120,27 @@ flatten dflags pcs hst modDetails@(ModDetails {md_binds = binds})
     --
     -- vectorise all toplevel bindings
     --
-    let binds' = runFlatten pcs hst us $ vectoriseTopLevelBinds binds
+    let binds' = runFlatten hsc_env pcs us $ vectoriseTopLevelBinds binds
     --
     -- and dump the result if requested
     --
     endPass dflags "Flattening [first phase: vectorisation]" 
 	    Opt_D_dump_vect binds'
-    return $ modDetails {md_binds = binds'}
+    return $ mod_impl {mg_binds = binds'}
 
 -- entry point to the flattening transformation for the compiler driver when
 -- compiling a single expression in interactive mode (EXPORTED) 
 --
-flattenExpr :: DynFlags 
+flattenExpr :: HscEnv
 	    -> PersistentCompilerState 
-	    -> HomeSymbolTable 
 	    -> CoreExpr			-- the expression to be flattened
 	    -> IO CoreExpr
-flattenExpr dflags pcs hst expr
+flattenExpr hsc_env pcs expr
   | not opt_Flatten = return expr       -- skip without -fflatten
   | otherwise       =
   do
+    let dflags = hsc_dflags hsc_env
+
     us <- mkSplitUniqSupply 'l'		-- 'l' as in fLattening
     --
     -- announce vectorisation
@@ -145,7 +149,7 @@ flattenExpr dflags pcs hst expr
     --
     -- vectorise the expression
     --
-    let expr' = fst . runFlatten pcs hst us $ vectorise expr
+    let expr' = fst . runFlatten hsc_env pcs us $ vectorise expr
     --
     -- and dump the result if requested
     --