X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplEnv.lhs;h=127e8cbef933c55ed9bd484879a82ec93cc029ab;hb=00fe4381668528eb2f60496eea97e433528d2bb8;hp=462a697da36dc4cfea89151a7ea32e0fe0f17c9c;hpb=eb80228b1f96ae3a739ef06728713eeec02f4c3e;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 462a697..127e8cb 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -66,6 +66,7 @@ import DynFlags
 import Util
 import MonadUtils
 import Outputable
+import FastString
 
 import Data.List
 \end{code}
@@ -127,8 +128,8 @@ data SimplEnv
 pprSimplEnv :: SimplEnv -> SDoc
 -- Used for debugging; selective
 pprSimplEnv env
-  = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
- 	  ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
+  = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
+ 	  ptext (sLit "IdSubst:") <+> ppr (seIdSubst env) ]
 
 type SimplIdSubst = IdEnv SimplSR	-- IdId |--> OutExpr
 	-- See Note [Extending the Subst] in CoreSubst
@@ -141,9 +142,9 @@ data SimplSR
 	   InExpr 	 
 
 instance Outputable SimplSR where
-  ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
-  ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
-  ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
+  ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
+  ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
+  ppr (ContEx tv id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
 				ppr (filter_env tv), ppr (filter_env id) -}]
 	-- where
 	-- fvs = exprFreeVars e
@@ -344,9 +345,9 @@ instance Outputable Floats where
   ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
 
 instance Outputable FloatFlag where
-  ppr FltLifted = ptext SLIT("FltLifted")
-  ppr FltOkSpec = ptext SLIT("FltOkSpec")
-  ppr FltCareful = ptext SLIT("FltCareful")
+  ppr FltLifted = ptext (sLit "FltLifted")
+  ppr FltOkSpec = ptext (sLit "FltOkSpec")
+  ppr FltCareful = ptext (sLit "FltCareful")
    
 andFF :: FloatFlag -> FloatFlag -> FloatFlag
 andFF FltCareful _ 	    = FltCareful
@@ -390,15 +391,13 @@ addNonRec env id rhs
   = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
 	  seInScope = extendInScopeSet (seInScope env) id }
 
-extendFloats :: SimplEnv -> [OutBind] -> SimplEnv
+extendFloats :: SimplEnv -> OutBind -> SimplEnv
 -- Add these bindings to the floats, and extend the in-scope env too
-extendFloats env binds
-  = env { seFloats  = seFloats env `addFlts` new_floats,
+extendFloats env bind
+  = env { seFloats  = seFloats env `addFlts` unitFloat bind,
 	  seInScope = extendInScopeSetList (seInScope env) bndrs }
   where
-    bndrs = bindersOfBinds binds
-    new_floats = Floats (toOL binds) 
-			(foldr (andFF . classifyFF) FltLifted binds)
+    bndrs = bindersOf bind
 
 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
 -- Add the floats for env2 to env1;