Rollback INLINE patches

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

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 2262bbc..be83835 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -188,7 +188,7 @@ tyConFamInst_maybe). A coercion allows you to move between
 representation and family type.  It is accessible from :R123Map via
 tyConFamilyCoercion_maybe and has kind
 
-  Co123Map a b v :: {Map (a, b) v :=: :R123Map a b v}
+  Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
 
 The wrapper and worker of MapPair get the types
 
@@ -294,7 +294,8 @@ mkDataConIds wrap_name wkr_name data_con
 
     id_arg1 = mkTemplateLocal 1 
                 (if null orig_arg_tys
-                    then ASSERT(not (null $ dataConDictTheta data_con)) mkPredTy $ head (dataConDictTheta data_con)
+                    then ASSERT(not (null $ dataConDictTheta data_con)) 
+                        mkPredTy $ head (dataConDictTheta data_con)
                     else head orig_arg_tys
                 )
 
@@ -334,13 +335,13 @@ mkDataConIds wrap_name wkr_name data_con
         --      ...(let w = C x in ...(w p q)...)...
         -- we want to see that w is strict in its two arguments
 
-    wrap_unf = mkTopUnfolding $ Note InlineMe $
-              mkLams wrap_tvs $ 
-              mkLams eq_args $
-              mkLams dict_args $ mkLams id_args $
-              foldr mk_case con_app 
-                    (zip (dict_args ++ id_args) all_strict_marks)
-                    i3 []
+    wrap_unf = mkImplicitUnfolding $ Note InlineMe $
+               mkLams wrap_tvs $ 
+               mkLams eq_args $
+               mkLams dict_args $ mkLams id_args $
+               foldr mk_case con_app 
+                     (zip (dict_args ++ id_args) all_strict_marks)
+                     i3 []
 
     con_app _ rep_ids = wrapFamInstBody tycon res_ty_args $
                           Var wrk_id `mkTyApps`  res_ty_args
@@ -602,9 +603,11 @@ mkRecordSelId tycon field_label
     info = noCafIdInfo
            `setCafInfo`           caf_info
            `setArityInfo`         arity
-           `setUnfoldingInfo`     mkTopUnfolding rhs_w_str
+           `setUnfoldingInfo`     unfolding
            `setAllStrictnessInfo` Just strict_sig
 
+    unfolding = mkImplicitUnfolding rhs_w_str
+
         -- Allocate Ids.  We do it a funny way round because field_dict_tys is
         -- almost always empty.  Also note that we use max_dict_tys
         -- rather than n_dict_tys, because the latter gives an infinite loop:
@@ -862,7 +865,7 @@ mkDictSelId no_unf name clas
                 `setArityInfo`          1
                 `setAllStrictnessInfo`  Just strict_sig
                 `setUnfoldingInfo`      (if no_unf then noUnfolding
-                                                  else mkTopUnfolding rhs)
+                                                  else mkImplicitUnfolding rhs)
 
         -- We no longer use 'must-inline' on record selectors.  They'll
         -- inline like crazy if they scrutinise a constructor
@@ -1154,15 +1157,15 @@ realWorldName    = mkWiredInIdName gHC_PRIM (fsLit "realWorld#")    realWorldPri
 lazyIdName       = mkWiredInIdName gHC_BASE (fsLit "lazy")         lazyIdKey           lazyId
 
 errorName                = mkWiredInIdName gHC_ERR (fsLit "error")            errorIdKey eRROR_ID
-recSelErrorName          = mkWiredInIdName cONTROL_EXCEPTION (fsLit "recSelError")     recSelErrorIdKey rEC_SEL_ERROR_ID
-runtimeErrorName         = mkWiredInIdName cONTROL_EXCEPTION (fsLit "runtimeError")    runtimeErrorIdKey rUNTIME_ERROR_ID
-irrefutPatErrorName      = mkWiredInIdName cONTROL_EXCEPTION (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
-recConErrorName          = mkWiredInIdName cONTROL_EXCEPTION (fsLit "recConError")     recConErrorIdKey rEC_CON_ERROR_ID
-patErrorName             = mkWiredInIdName cONTROL_EXCEPTION (fsLit "patError")         patErrorIdKey pAT_ERROR_ID
-noMethodBindingErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "noMethodBindingError")
+recSelErrorName          = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "recSelError")     recSelErrorIdKey rEC_SEL_ERROR_ID
+runtimeErrorName         = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "runtimeError")    runtimeErrorIdKey rUNTIME_ERROR_ID
+irrefutPatErrorName      = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
+recConErrorName          = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "recConError")     recConErrorIdKey rEC_CON_ERROR_ID
+patErrorName             = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "patError")         patErrorIdKey pAT_ERROR_ID
+noMethodBindingErrorName = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "noMethodBindingError")
                                            noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
 nonExhaustiveGuardsErrorName 
-  = mkWiredInIdName gHC_ERR (fsLit "nonExhaustiveGuardsError") 
+  = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "nonExhaustiveGuardsError") 
                     nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
 \end{code}