| ... |
... |
@@ -42,7 +42,7 @@ import GHC.Core.Utils |
|
42
|
42
|
import GHC.Core.DataCon
|
|
43
|
43
|
import GHC.Core.Type
|
|
44
|
44
|
import GHC.Core.Class( Class )
|
|
45
|
|
-import GHC.Core.Predicate( isUnaryClass )
|
|
|
45
|
+import GHC.Core.Predicate( isUnaryClass, isDictId )
|
|
46
|
46
|
|
|
47
|
47
|
import GHC.Types.Id
|
|
48
|
48
|
import GHC.Types.Literal
|
| ... |
... |
@@ -782,16 +782,26 @@ classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize |
|
782
|
782
|
classOpSize _opts _cls _top_args []
|
|
783
|
783
|
= sizeZero -- A non-applied classop
|
|
784
|
784
|
classOpSize opts cls top_args (dict_arg:other_val_args)
|
|
785
|
|
- = SizeIs size (arg_discount dict_arg) 0
|
|
|
785
|
+ = SizeIs size dict_arg_discount 0
|
|
786
|
786
|
where
|
|
787
|
|
- size | isUnaryClass cls = 0 -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon
|
|
788
|
|
- | otherwise = 20 + (10 * length other_val_args)
|
|
|
787
|
+ -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon
|
|
|
788
|
+ op_app_size = if isUnaryClass cls then 0 else 20
|
|
|
789
|
+
|
|
|
790
|
+ -- Size penalty for applying the extracted class method to it's
|
|
|
791
|
+ -- arguments.
|
|
|
792
|
+ method_app_size
|
|
|
793
|
+ | null other_val_args = 0
|
|
|
794
|
+ | otherwise = callSize (length other_val_args)
|
|
|
795
|
+
|
|
|
796
|
+ size = op_app_size + method_app_size
|
|
789
|
797
|
|
|
790
|
798
|
-- If the class op is scrutinising a lambda bound dictionary then
|
|
791
|
799
|
-- give it a discount, to encourage the inlining of this function
|
|
792
|
|
- arg_discount (Cast arg _co) = arg_discount arg
|
|
793
|
|
- arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount)
|
|
794
|
|
- arg_discount _ = emptyBag
|
|
|
800
|
+ dict_arg_discount = case getIdFromTrivialExpr_maybe dict_arg of
|
|
|
801
|
+ Nothing -> emptyBag
|
|
|
802
|
+ Just dict
|
|
|
803
|
+ | dict `elem` top_args -> unitBag (dict, dict_discount)
|
|
|
804
|
+ | otherwise -> emptyBag
|
|
795
|
805
|
|
|
796
|
806
|
-- If we have (class-op d arg1 .. argn) then it's super-good to inline
|
|
797
|
807
|
-- to expose `d`; not only can we do the dictionary selection
|
| ... |
... |
@@ -802,6 +812,12 @@ classOpSize opts cls top_args (dict_arg:other_val_args) |
|
802
|
812
|
| null other_val_args = unfoldingDictDiscount opts
|
|
803
|
813
|
| otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts
|
|
804
|
814
|
|
|
|
815
|
+ isTopArgDict expr
|
|
|
816
|
+ | Just v <- getIdFromTrivialExpr_maybe expr
|
|
|
817
|
+ = v `elem` top_args
|
|
|
818
|
+ | otherwise
|
|
|
819
|
+ = False
|
|
|
820
|
+
|
|
805
|
821
|
-- | The size of a function call
|
|
806
|
822
|
callSize
|
|
807
|
823
|
:: Int -- ^ number of value args
|