X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=b5525dcd739dcf24e05254b5194190edd0acf3b4;hp=1eacea9938a66d96effb06f4a1a0e6f771d59718;hb=9a4c93a59e008ddc376fde5f9eb468b762f0d0a7;hpb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 1eacea9..b5525dc 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -345,7 +345,7 @@ 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 = mkInlineRule InlSat wrap_rhs (length dict_args + length id_args)
+    wrap_unf = mkInlineRule needSaturated wrap_rhs (length dict_args + length id_args)
     wrap_rhs = mkLams wrap_tvs $ 
                mkLams eq_args $
                mkLams dict_args $ mkLams id_args $
@@ -467,15 +467,11 @@ mkDictSelId no_unf name clas
 		   -- becuase we use that to generate a top-level binding
 		   -- for the ClassOp
 
-    info | new_tycon = base_info  
-    	   	         -- For newtype dictionaries, just inline the class op
-                         -- See Note [Single-method classes] in TcInstDcls
-         | otherwise = base_info
-	 		`setSpecInfo`       mkSpecInfo [rule]
+    info = base_info    `setSpecInfo`       mkSpecInfo [rule]
 			`setInlinePragInfo` neverInlinePragma
-			-- Otherwise add a magic BuiltinRule, and never inline it
-			-- so that the rule is always available to fire.
-			-- See Note [ClassOp/DFun selection] in TcInstDcls
+		-- Add a magic BuiltinRule, and never inline it
+		-- so that the rule is always available to fire.
+		-- See Note [ClassOp/DFun selection] in TcInstDcls
 
     n_ty_args = length tyvars
 
@@ -520,16 +516,16 @@ mkDictSelId no_unf name clas
              | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
                                 [(DataAlt data_con, eq_ids ++ arg_ids, Var the_arg_id)]
 
-dictSelRule :: Int -> Arity -> [CoreExpr] -> Maybe CoreExpr
+dictSelRule :: Int -> Arity -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
 -- Oh, very clever
 --       op_i t1..tk (df s1..sn d1..dm) = op_i_helper s1..sn d1..dm
 --       op_i t1..tk (D t1..tk op1 ... opm) = opi
 --
 -- NB: the data constructor has the same number of type args as the class op
 
-dictSelRule index n_ty_args args
+dictSelRule index n_ty_args id_unf args
   | (dict_arg : _) <- drop n_ty_args args
-  , Just (_, _, val_args) <- exprIsConApp_maybe dict_arg
+  , Just (_, _, val_args) <- exprIsConApp_maybe id_unf dict_arg
   = Just (val_args !! index)
   | otherwise
   = Nothing
@@ -958,12 +954,12 @@ seqId = pcMiscPrelId seqName ty info
                                 , ru_try   = match_seq_of_cast
                                 }
 
-match_seq_of_cast :: [CoreExpr] -> Maybe CoreExpr
+match_seq_of_cast :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
     -- See Note [Built-in RULES for seq]
-match_seq_of_cast [Type _, Type res_ty, Cast scrut co, expr]
+match_seq_of_cast _ [Type _, Type res_ty, Cast scrut co, expr]
   = Just (Var seqId `mkApps` [Type (fst (coercionKind co)), Type res_ty,
                               scrut, expr])
-match_seq_of_cast _ = Nothing
+match_seq_of_cast _ _ = Nothing
 
 ------------------------------------------------
 lazyId :: Id	-- See Note [lazyId magic]