X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=74879f39b01b736d24758b14162cd4dd26992a92;hb=3517c53d8a66149dcc3f971cf0577719e99d6d70;hp=7d3b0120e03871e8ff220cc3474203b645fe2e96;hpb=9ffadf219cbc4f8ec57264786df936a3cee88aec;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 7d3b012..74879f3 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -138,7 +138,7 @@ Running example: inline df_i in it, and that in turn means that (since it'll be a loop-breaker because df_i isn't), op1_i will ironically never be inlined. We need to fix this somehow -- perhaps allowing inlining - of INLINE funcitons inside other INLINE functions. + of INLINE functions inside other INLINE functions. Note [Subtle interaction of recursion and overlap] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,8 +637,8 @@ tc_inst_decl2 dfun_id (NewTypeDerived coi) ; sc_dicts <- newDictBndrs sc_loc sc_theta' ; inst_loc <- getInstLoc origin ; dfun_dicts <- newDictBndrs inst_loc theta - ; this_dict <- newDictBndr inst_loc (mkClassPred cls cls_inst_tys) ; rep_dict <- newDictBndr inst_loc rep_pred + ; this_dict <- newDictBndr inst_loc (mkClassPred cls cls_inst_tys) -- Figure out bindings for the superclass context from dfun_dicts -- Don't include this_dict in the 'givens', else @@ -716,11 +716,12 @@ tc_inst_decl2 dfun_id (VanillaInst monobinds uprags) origin = SigOrigin rigid_info -- Create dictionary Ids from the specified instance contexts. - ; sc_loc <- getInstLoc InstScOrigin - ; sc_dicts <- newDictOccs sc_loc sc_theta' -- These are wanted - ; inst_loc <- getInstLoc origin - ; dfun_dicts <- newDictBndrs inst_loc dfun_theta' -- Includes equalities - ; this_dict <- newDictBndr inst_loc (mkClassPred clas inst_tys') + ; sc_loc <- getInstLoc InstScOrigin + ; sc_dicts <- newDictOccs sc_loc sc_theta' -- These are wanted + ; inst_loc <- getInstLoc origin + ; dfun_dicts <- newDictBndrs inst_loc dfun_theta' -- Includes equalities + ; this_dict <- newDictBndr inst_loc (mkClassPred clas inst_tys') + -- Default-method Ids may be mentioned in synthesised RHSs, -- but they'll already be in the environment. @@ -754,7 +755,7 @@ tc_inst_decl2 dfun_id (VanillaInst monobinds uprags) -- Create the result bindings ; let dict_constr = classDataCon clas inline_prag | null dfun_dicts = [] - | otherwise = [L loc (InlinePrag (Inline AlwaysActive True))] + | otherwise = [L loc (InlinePrag (alwaysInlineSpec FunLike))] -- Always inline the dfun; this is an experimental decision -- because it makes a big performance difference sometimes. -- Often it means we can do the method selection, and then