[project @ 2006-01-06 16:30:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / stgSyn / CoreToStg.lhs

diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index 781d6ed..824caba 100644 (file)
--- 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}