X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=fb9ca7f5953ca870dbe2fc17eab44a6e01a93286;hb=27061b5b4008a831eba4784358b040bb1250dcef;hp=77db0bc81d43bebe61cec3d83f64200fecd568b6;hpb=520c30d3ee2afd3bb8b7576e49c7f44d7b36663e;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 77db0bc..fb9ca7f 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -62,16 +62,18 @@ module SetLevels (
 
 import CoreSyn
 
-import DynFlags	( FloatOutSwitches(..) )
+import DynFlags		( FloatOutSwitches(..) )
 import CoreUtils	( exprType, exprIsTrivial, mkPiTypes )
 import CoreFVs		-- all of it
 import CoreSubst	( Subst, emptySubst, extendInScope, extendIdSubst,
 			  cloneIdBndr, cloneRecIdBndrs )
 import Id		( Id, idType, mkSysLocal, isOneShotLambda,
-			  zapDemandIdInfo,
+			  zapDemandIdInfo, transferPolyIdInfo,
 			  idSpecialisation, idWorkerInfo, setIdInfo
 			)
-import IdInfo		( workerExists, vanillaIdInfo, isEmptySpecInfo )
+import IdInfo		( workerExists, vanillaIdInfo, isEmptySpecInfo,
+                          setNewStrictnessInfo, newStrictnessInfo,
+			  setArityInfo, arityInfo )
 import Var
 import VarSet
 import VarEnv
@@ -831,17 +833,18 @@ type LvlM result = UniqSM result
 initLvl		= initUs_
 \end{code}
 
+
 \begin{code}
 newPolyBndrs dest_lvl env abs_vars bndrs = do
     uniqs <- getUniquesM
     let new_bndrs = zipWith mk_poly_bndr bndrs uniqs
     return (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs)
   where
-    mk_poly_bndr bndr uniq = mkSysLocal (mkFastString str) uniq poly_ty
+    mk_poly_bndr bndr uniq = transferPolyIdInfo bndr $ 	-- Note [transferPolyIdInfo] in Id.lhs
+			     mkSysLocal (mkFastString str) uniq poly_ty
 			   where
 			     str     = "poly_" ++ occNameString (getOccName bndr)
 			     poly_ty = mkPiTypes abs_vars (idType bndr)
-	
 
 newLvlVar :: String 
 	  -> [CoreBndr] -> Type 	-- Abstract wrt these bndrs