X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=be838351baba97022d94d7f55c3b5e6bc4ad0d91;hp=1cb91099300536aa054ddb428dd5394c987a56bc;hb=a15972f1b72500a0bf0edca948314ea9fbc46ec3;hpb=2378b2325df64a5ccc5b2e038ac3dbb848dea5f7

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 1cb9109..be83835 100644
--- 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
@@ -1162,7 +1165,7 @@ patErrorName             = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "patErr
 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}