[project @ 2005-02-25 13:06:31 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / MkId.lhs

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 7dabf46..50e981b 100644 (file)
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -51,7 +51,7 @@ import TcType         ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy,
                          tcSplitFunTys, tcSplitForAllTys
                        )
 import CoreUtils       ( exprType )
-import CoreUnfold      ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
+import CoreUnfold      ( mkTopUnfolding, mkCompulsoryUnfolding )
 import Literal         ( nullAddrLit, mkStringLit )
 import TyCon           ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
                           tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
@@ -64,8 +64,7 @@ import PrimOp         ( PrimOp, primOpSig, primOpOcc, primOpTag )
 import ForeignCall     ( ForeignCall )
 import DataCon         ( DataCon, DataConIds(..), dataConTyVars,
                          dataConFieldLabels, dataConRepArity, 
-                         dataConRepArgTys, dataConRepType, 
-                         dataConStupidTheta, dataConOrigArgTys,
+                         dataConRepArgTys, dataConRepType, dataConStupidTheta, 
                          dataConSig, dataConStrictMarks, dataConExStricts, 
                          splitProductType, isVanillaDataCon
                        )
@@ -86,7 +85,6 @@ import CoreSyn
 import Unique          ( mkBuiltinUnique, mkPrimOpIdUnique )
 import Maybes
 import PrelNames
-import Maybe            ( isJust )
 import Util             ( dropList, isSingleton )
 import Outputable
 import FastString
@@ -215,6 +213,8 @@ mkDataConIds wrap_name wkr_name data_con
     wkr_info  = noCafIdInfo
                `setArityInfo`          wkr_arity
                `setAllStrictnessInfo`  Just wkr_sig
+               `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,
+                                                       -- even if arity = 0
 
     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
        -- Notice that we do *not* say the worker is strict
@@ -305,15 +305,15 @@ mkDataConIds wrap_name wkr_name data_con
                MarkedStrict 
                   | isUnLiftedType (idType arg) -> body i (arg:rep_args)
                   | otherwise ->
--- gaw 2004
                        Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))]
 
                MarkedUnboxed
                   -> case splitProductType "do_unbox" (idType arg) of
                           (tycon, tycon_args, con, tys) ->
--- gaw 2004
-                                  Case (Var arg) arg result_ty  [(DataAlt con, con_args,
-                                       body i' (reverse con_args ++ rep_args))]
+                                  Case (Var arg) arg result_ty  
+                                       [(DataAlt con, 
+                                         con_args,
+                                         body i' (reverse con_args ++ rep_args))]
                              where 
                                (con_args, i') = mkLocals i tys
 
@@ -454,7 +454,7 @@ mkRecordSelId tycon field_label field_ty
     arg_base       = dict_id_base + 1
 
     alts      = map mk_maybe_alt data_cons
-    the_alts  = catMaybes alts
+    the_alts  = catMaybes alts         -- Already sorted by data-con
 
     no_default = all isJust alts       -- No default needed
     default_alt | no_default = []
@@ -734,7 +734,7 @@ It's OK for dfuns to be LocalIds, because we form the instance-env to
 pass on to the next module (md_insts) in CoreTidy, afer tidying
 and globalising the top-level Ids.
 
-BUT make sure they are *exported* LocalIds (setIdLocalExported) so 
+BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
 that they aren't discarded by the occurrence analyser.
 
 \begin{code}
@@ -892,8 +892,8 @@ This comes up in strictness analysis
 \begin{code}
 realWorldPrimId        -- :: State# RealWorld
   = pcMiscPrelId realWorldName realWorldStatePrimTy
-                (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
-       -- The mkOtherCon makes it look that realWorld# is evaluated
+                (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
+       -- The evaldUnfolding makes it look that realWorld# is evaluated
        -- which in turn makes Simplify.interestingArg return True,
        -- which in turn makes INLINE things applied to realWorld# likely
        -- to be inlined