X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FstgSyn%2FCoreToStg.lhs;h=824cabaacbd51c1468cf5ea6d56c8143c3a5edfc;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=781d6ed8d6f561dc330571d549146ab27bfa644a;hpb=a7ecdf96844404b7bc8273d4ff6d85759278427c;p=ghc-hetmet.git

diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index 781d6ed..824caba 100644
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -30,7 +30,7 @@ import VarSet
 import VarEnv
 import Maybes		( maybeToBool )
 import Name		( getOccName, isExternalName, nameOccName )
-import OccName		( occNameUserString, occNameFS )
+import OccName		( occNameString, occNameFS )
 import BasicTypes       ( Arity )
 import Packages		( HomeModules )
 import StaticFlags	( opt_RuntimeTypes )
@@ -175,7 +175,7 @@ coreTopBindToStg
 coreTopBindToStg hmods env body_fvs (NonRec id rhs)
   = let 
 	env' 	  = extendVarEnv env id how_bound
-	how_bound = LetBound TopLet (manifestArity rhs)
+	how_bound = LetBound TopLet $! manifestArity rhs
 
         (stg_rhs, fvs') = 
 	    initLne env (
@@ -194,7 +194,7 @@ coreTopBindToStg hmods env body_fvs (Rec pairs)
   = let 
 	(binders, rhss) = unzip pairs
 
-	extra_env' = [ (b, LetBound TopLet (manifestArity rhs))
+	extra_env' = [ (b, LetBound TopLet $! manifestArity rhs)
 		     | (b, rhs) <- pairs ]
 	env' = extendVarEnvList env extra_env'
 
@@ -688,7 +688,7 @@ coreToStgLet let_no_escape bind body
 is_join_var :: Id -> Bool
 -- A hack (used only for compiler debuggging) to tell if
 -- a variable started life as a join point ($j)
-is_join_var j = occNameUserString (getOccName j) == "$j"
+is_join_var j = occNameString (getOccName j) == "$j"
 \end{code}
 
 \begin{code}