[project @ 2002-09-13 15:02:25 by simonpj]

[ghc-hetmet.git] / ghc / compiler / ndpFlatten / FlattenMonad.hs

diff --git a/ghc/compiler/ndpFlatten/FlattenMonad.hs b/ghc/compiler/ndpFlatten/FlattenMonad.hs
index 1a6955e..beb5f16 100644 (file)
--- a/ghc/compiler/ndpFlatten/FlattenMonad.hs
+++ b/ghc/compiler/ndpFlatten/FlattenMonad.hs
@@ -72,22 +72,22 @@ import OccName          (UserFS)
 import Var          (Var(..))
 import Id          (Id, mkSysLocal)
 import Name        (Name)
-import VarSet       (VarSet, emptyVarSet, unitVarSet, extendVarSet,
-                    varSetElems, unionVarSet)
-import VarEnv       (VarEnv, emptyVarEnv, unitVarEnv, zipVarEnv, plusVarEnv,
+import VarSet       (VarSet, emptyVarSet, extendVarSet, varSetElems )
+import VarEnv       (VarEnv, emptyVarEnv, zipVarEnv, plusVarEnv,
                     elemVarEnv, lookupVarEnv, lookupVarEnv_NF, delVarEnvList)
 import TyCon        (tyConName)
 import Type        (Type, tyConAppTyCon)
-import HscTypes            (HomeSymbolTable, PersistentCompilerState(..),
+import HscTypes            (HomePackageTable, PersistentCompilerState(pcs_EPS), 
+                    ExternalPackageState(eps_PTE), HscEnv(hsc_HPT),
                     TyThing(..), lookupType)
 import PrelNames    (charPrimTyConName, intPrimTyConName, floatPrimTyConName,
                     doublePrimTyConName, fstName, andName, orName,
-                    eqCharName, eqIntName, eqFloatName, eqDoubleName,
-                    neqCharName, neqIntName, neqFloatName, neqDoubleName,
                     lengthPName, replicatePName, mapPName, bpermutePName,
                     bpermuteDftPName, indexOfPName)
-import CoreSyn      (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps,
-                    bindersOfBinds)
+import PrimOp      (eqCharName, eqIntName, eqFloatName, eqDoubleName,
+                    neqIntName)
+                    -- neqCharName, neqFloatName,neqDoubleName,
+import CoreSyn      (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps)
 import CoreUtils    (exprType)
 
 -- friends
@@ -132,10 +132,10 @@ data FlattenState = FlattenState {
 -- initial value of the flattening state
 --
 initialFlattenState :: PersistentCompilerState 
-                   -> HomeSymbolTable 
+                   -> HomePackageTable 
                    -> UniqSupply 
                    -> FlattenState
-initialFlattenState pcs hst us = 
+initialFlattenState pcs hpt us = 
   FlattenState {
     us      = us,
     env      = lookup,
@@ -145,7 +145,7 @@ initialFlattenState pcs hst us =
   }
   where
     lookup n = 
-      case lookupType hst (pcs_PTE pcs) n of
+      case lookupType hpt (eps_PTE (pcs_EPS pcs)) n of
         Just (AnId v) -> v 
        _             -> pprPanic "FlattenMonad: unknown name:" (ppr n)
 
@@ -164,12 +164,13 @@ instance Monad Flatten where
 
 -- execute the given flattening computation (EXPORTED)
 --
-runFlatten :: PersistentCompilerState 
-          -> HomeSymbolTable 
+runFlatten :: HscEnv
+          -> PersistentCompilerState 
           -> UniqSupply 
           -> Flatten a 
           -> a    
-runFlatten pcs hst us m = fst $ unFlatten m (initialFlattenState pcs hst us)
+runFlatten hsc_env pcs us m 
+  = fst $ unFlatten m (initialFlattenState pcs (hsc_HPT hsc_env) us)
 
 
 -- variable generation
@@ -384,10 +385,10 @@ mk'neq ty a1 a2  = mkFunApp neqName [a1, a2]
                   where
                     name = tyConName . tyConAppTyCon $ ty
                     --
-                    neqName | name == charPrimTyConName   = neqCharName
+                    neqName {- | name == charPrimTyConName   = neqCharName -}
                             | name == intPrimTyConName    = neqIntName
-                            | name == floatPrimTyConName  = neqFloatName
-                            | name == doublePrimTyConName = neqDoubleName
+                            {- | name == floatPrimTyConName  = neqFloatName -}
+                            {- | name == doublePrimTyConName = neqDoubleName -}
                             | otherwise                   =
                               pprPanic "FlattenMonad.mk'neq: " (ppr ty)