| ... |
... |
@@ -569,6 +569,7 @@ sizeExpr :: UnfoldingOpts |
|
569
|
569
|
|
|
570
|
570
|
-- Forcing bOMB_OUT_SIZE early prevents repeated
|
|
571
|
571
|
-- unboxing of the Int argument.
|
|
|
572
|
+-- {-# NOINLINE sizeExpr #-}
|
|
572
|
573
|
sizeExpr opts !bOMB_OUT_SIZE top_args expr
|
|
573
|
574
|
= size_up sizeZero expr
|
|
574
|
575
|
where
|
| ... |
... |
@@ -596,12 +597,12 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr |
|
596
|
597
|
| otherwise = size_up s e
|
|
597
|
598
|
|
|
598
|
599
|
size_up s (Let (NonRec binder rhs) body)
|
|
599
|
|
- = let rhs_s = size_up_rhs s (binder, rhs)
|
|
600
|
|
- in size_up (stripDiscounts $ rhs_s `addSizeN` size_up_alloc binder) body
|
|
|
600
|
+ = let rhs_s = size_up_let s (binder, rhs)
|
|
|
601
|
+ in size_up (stripDiscounts $ rhs_s) body
|
|
601
|
602
|
|
|
602
|
603
|
|
|
603
|
604
|
size_up s (Let (Rec pairs) body)
|
|
604
|
|
- = size_up (stripDiscounts (foldr (flip size_up_rhs) s pairs))
|
|
|
605
|
+ = size_up (stripDiscounts (foldr (flip size_up_let) s pairs))
|
|
605
|
606
|
body
|
|
606
|
607
|
|
|
607
|
608
|
size_up s (Case e _ _ alts) = case nonEmpty alts of
|
| ... |
... |
@@ -637,8 +638,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr |
|
637
|
638
|
-- that may eliminate allocation in the caller
|
|
638
|
639
|
-- And it eliminates the case itself
|
|
639
|
640
|
|
|
640
|
|
- | otherwise -> let case_s = size_up s e `addSizeNSD` case_size
|
|
641
|
|
- in foldr (addAltSize . size_up_alt case_s) case_s alts
|
|
|
641
|
+ | otherwise -> foldr (addAltSize . size_up_alt s)
|
|
|
642
|
+ (size_up s e `addSizeNSD` case_size)
|
|
|
643
|
+ alts
|
|
642
|
644
|
|
|
643
|
645
|
where
|
|
644
|
646
|
is_top_arg (Var v) | v `elem` top_args = Just v
|
| ... |
... |
@@ -647,6 +649,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr |
|
647
|
649
|
is_top_arg _ = Nothing
|
|
648
|
650
|
|
|
649
|
651
|
where
|
|
|
652
|
+
|
|
650
|
653
|
case_size
|
|
651
|
654
|
| is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)
|
|
652
|
655
|
| otherwise = sizeZero
|
| ... |
... |
@@ -682,14 +685,14 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr |
|
682
|
685
|
| otherwise
|
|
683
|
686
|
= False
|
|
684
|
687
|
|
|
685
|
|
- size_up_rhs :: ExprSize -> (Id, CoreExpr) -> ExprSize
|
|
686
|
|
- size_up_rhs s (bndr, rhs)
|
|
|
688
|
+ size_up_let :: ExprSize -> (Id, CoreExpr) -> ExprSize
|
|
|
689
|
+ size_up_let s (bndr, rhs)
|
|
687
|
690
|
| JoinPoint join_arity <- idJoinPointHood bndr
|
|
688
|
691
|
-- Skip arguments to join point
|
|
689
|
692
|
, (_bndrs, body) <- collectNBinders join_arity rhs
|
|
690
|
693
|
= size_up s body
|
|
691
|
694
|
| otherwise
|
|
692
|
|
- = size_up s rhs
|
|
|
695
|
+ = size_up s rhs `addSizeN` size_up_alloc bndr
|
|
693
|
696
|
|
|
694
|
697
|
------------
|
|
695
|
698
|
-- size_up_app is used when there's ONE OR MORE value args
|
| ... |
... |
@@ -725,8 +728,8 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr |
|
725
|
728
|
-- size_up_alt returns on the alternatives size, not including the accumulated size passed in unless we reach TooBig
|
|
726
|
729
|
size_up_alt TooBig _ = TooBig
|
|
727
|
730
|
size_up_alt (SizeIs {_es_size_is=s}) (Alt _con _bndrs rhs) =
|
|
728
|
|
- size_up (sizeN $ s + 10) rhs
|
|
729
|
|
- `addSizeN` (-s) -- Why add and then subtract s? If the expression is already large we will bomb out early this way.
|
|
|
731
|
+ size_up (sizeN s) rhs
|
|
|
732
|
+ `addSizeN` (10 -s) -- Why add and then subtract s? If the expression is already large we will bomb out early this way.
|
|
730
|
733
|
|
|
731
|
734
|
-- Don't charge for args, so that wrappers look cheap
|
|
732
|
735
|
-- (See comments about wrappers with Case)
|
| ... |
... |
@@ -780,6 +783,8 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr |
|
780
|
783
|
isZeroBitExpr (Tick _ e) = isZeroBitExpr e
|
|
781
|
784
|
isZeroBitExpr _ = False
|
|
782
|
785
|
|
|
|
786
|
+-- pprSizeCont txt s r = pprTrace txt (ppr (s,r,_es_size_is r - _es_size_is s)) r
|
|
|
787
|
+
|
|
783
|
788
|
-- | Finds a nominal size of a string literal.
|
|
784
|
789
|
litSize :: Literal -> Int
|
|
785
|
790
|
-- Used by GHC.Core.Unfold.sizeExpr
|