[project @ 2003-01-23 11:22:50 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 e1139b9..f6033c2 100644 (file)
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -32,7 +32,7 @@ import DataCon                ( dataConWrapId )
 import Maybes          ( maybeToBool )
 import Name            ( getOccName, isExternalName, isDllName )
 import OccName         ( occNameUserString )
-import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, Arity )
+import BasicTypes       ( Arity )
 import CmdLineOpts     ( DynFlags, opt_RuntimeTypes )
 import FastTypes       hiding ( fastOr )
 import Util             ( listLengthCmp, mapAndUnzip )
@@ -538,7 +538,7 @@ coreToStgArgs (arg : args)  -- Non-type argument
        fvs = args_fvs `unionFVInfo` arg_fvs
        stg_arg = case arg' of
                       StgApp v []      -> StgVarArg v
-                      StgConApp con [] -> StgVarArg (dataConWrapId con)
+                      StgConApp con [] -> StgVarArg (dataConWorkId con)
                       StgLit lit       -> StgLitArg lit
                       _                -> pprPanic "coreToStgArgs" (ppr arg)
     in
@@ -718,8 +718,16 @@ mkStgRhs env rhs_fvs binder_info rhs
                  (getFVs rhs_fvs)               
                  upd_flag [] rhs
   where
+   upd_flag = Updatable
+  {-
+    SDM: disabled.  Eval/Apply can't handle functions with arity zero very
+    well; and making these into simple non-updatable thunks breaks other
+    assumptions (namely that they will be entered only once).
+
     upd_flag | isPAP env rhs  = ReEntrant
             | otherwise      = Updatable
+  -}
+
 {- ToDo:
           upd = if isOnceDem dem
                    then (if isNotTop toplev 
@@ -1185,7 +1193,8 @@ rhsIsNonUpd p other_expr
 idAppIsNonUpd :: IdEnv HowBound -> Id -> Int -> [CoreExpr] -> Bool
 idAppIsNonUpd p id n_val_args args
   | Just con <- isDataConId_maybe id = not (isCrossDllConApp con args)
-  | otherwise                       = n_val_args < stgArity id (lookupBinding p id)
+  | otherwise = False  -- SDM: disbled.  See comment with isPAP above.
+                       -- n_val_args < stgArity id (lookupBinding p id)
 
 stgArity :: Id -> HowBound -> Arity
 stgArity f (LetBound _ arity) = arity