Andreas Klebinger pushed to branch wip/andreask/deep-discounts-2026 at Glasgow Haskell Compiler / GHC
Commits:
-
957eb82e
by Andreas Klebinger at 2026-07-18T16:53:53+00:00
-
651770ba
by Andreas Klebinger at 2026-07-19T06:47:05+00:00
-
58f3327a
by Andreas Klebinger at 2026-07-19T07:12:30+00:00
2 changed files:
Changes:
| ... | ... | @@ -923,12 +923,11 @@ interestingArg env e = |
| 923 | 923 | ConArg con fn_args
|
| 924 | 924 | | isClassTyCon (dataConTyCon con) -> ValueArg
|
| 925 | 925 | | otherwise ->
|
| 926 | - -- fn_args can be non-empty if the head of the application is
|
|
| 927 | - -- a variable whose unfolding is a partially applied constructor
|
|
| 928 | - -- application (see the first clause of go_var). In that case the
|
|
| 929 | - -- args from the unfolding come before the args of this
|
|
| 930 | - -- application, e.g. for `v ys` with `v = (:) x` we get
|
|
| 931 | - -- ConArg (:) [x_summary, ys_summary].
|
|
| 926 | + -- fn_args are the arguments already applied inside `fn`
|
|
| 927 | + -- in case `fn` is a variable representing a partial application.
|
|
| 928 | + -- For example if we have `v xs` with `v` unfolding into `(: x)`.
|
|
| 929 | + -- In that case we will get:
|
|
| 930 | + -- ConArg (:) [x_summary, xs_summary].
|
|
| 932 | 931 | ConArg con (fn_args ++ arg_summaries)
|
| 933 | 932 | _ -> fn_summary
|
| 934 | 933 | |
| ... | ... | @@ -947,7 +946,9 @@ interestingArg env e = |
| 947 | 946 | env' = env `addNewInScopeBndr` b
|
| 948 | 947 | |
| 949 | 948 | go_var depth n v
|
| 950 | - | Just rhs <- maybeUnfoldingTemplate (idUnfolding v)
|
|
| 949 | + | unf <- (idUnfolding v)
|
|
| 950 | + , isConLikeUnfolding unf
|
|
| 951 | + , Just rhs <- maybeUnfoldingTemplate unf
|
|
| 951 | 952 | , Just con_app <- isConApp_maybe rhs
|
| 952 | 953 | = con_app
|
| 953 | 954 |
| ... | ... | @@ -693,7 +693,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr |
| 693 | 693 | | Just v <- is_top_arg e
|
| 694 | 694 | = let
|
| 695 | 695 | -- Compute size of alternatives
|
| 696 | - alt_sizes = map (size_up_alt depth (Just v) arg_comps) alts
|
|
| 696 | + alt_sizes = map (size_up_alt (depth-1) (Just v) arg_comps) alts
|
|
| 697 | 697 | |
| 698 | 698 | -- Apply a discount for a given constructor that brings the size down to just
|
| 699 | 699 | -- the size of the alternative.
|
| ... | ... | @@ -747,7 +747,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr |
| 747 | 747 | |
| 748 | 748 | |
| 749 | 749 | size_up !depth arg_comps (Case e _ _ alts) = size_up depth arg_comps e `addSizeNSD`
|
| 750 | - foldr (addAltSize . (size_up_alt depth Nothing arg_comps) ) case_size alts
|
|
| 750 | + foldr (addAltSize . (size_up_alt (depth-1) Nothing arg_comps) ) case_size alts
|
|
| 751 | 751 | where
|
| 752 | 752 | case_size
|
| 753 | 753 | | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)
|