| ... |
... |
@@ -502,6 +502,7 @@ contIsTrivial _ = False |
|
502
|
502
|
-------------------
|
|
503
|
503
|
contStop :: SimplCont -> SimplCont
|
|
504
|
504
|
-- Get the Stop at the tail of the argument
|
|
|
505
|
+-- Always returns a continuation of form (Stop ...)
|
|
505
|
506
|
contStop stop@(Stop {}) = stop
|
|
506
|
507
|
contStop (CastIt { sc_cont = k }) = contStop k
|
|
507
|
508
|
contStop (StrictBind { sc_cont = k }) = contStop k
|
| ... |
... |
@@ -670,20 +671,26 @@ mkBottomCont ::SimplCont -> SimplCont |
|
670
|
671
|
-- looking like (case <hole> of {}).
|
|
671
|
672
|
-- This is used when we are going to fill in the <hole> with bottom
|
|
672
|
673
|
-- See (TC2,3) in Note [Trimming the continuation for bottoming functions]
|
|
673
|
|
-mkBottomCont cont@(Stop {}) = cont
|
|
674
|
|
-mkBottomCont cont@(Select { sc_alts = [], sc_cont = Stop {} }) = cont
|
|
675
|
|
-mkBottomCont cont
|
|
676
|
|
- | Stop res_ty _ _ <- stop_cont
|
|
677
|
|
- , hole_ty `eqTypeIgnoringMultiplicity` res_ty
|
|
678
|
|
- = stop_cont
|
|
679
|
|
- | otherwise
|
|
680
|
|
- = Select { sc_alts = []
|
|
681
|
|
- , sc_bndr = mkWildValBinder OneTy hole_ty
|
|
682
|
|
- , sc_env = Simplified OkDup
|
|
683
|
|
- , sc_cont = stop_cont }
|
|
|
674
|
+-- But don't bother to trim, making a `case <hole> of {}`, if we have only
|
|
|
675
|
+-- an essentially-trivial continuation; e.g. (<hole> @ty |> co)
|
|
|
676
|
+mkBottomCont cont = go cont
|
|
684
|
677
|
where
|
|
685
|
|
- hole_ty = contHoleType cont
|
|
686
|
|
- stop_cont = contStop cont
|
|
|
678
|
+ go k@(Stop {}) = k
|
|
|
679
|
+ go (TickIt t k') = TickIt t (go k')
|
|
|
680
|
+ go k@(CastIt { sc_cont = k' }) = k { sc_cont = go k' }
|
|
|
681
|
+ go k@(ApplyToTy { sc_cont = k' }) = k { sc_cont = go k' }
|
|
|
682
|
+ go k@(Select { sc_alts = [], sc_cont = Stop {} }) = k -- Optimisation only
|
|
|
683
|
+ go k | Stop res_ty _ _ <- stop_cont
|
|
|
684
|
+ , hole_ty `eqTypeIgnoringMultiplicity` res_ty
|
|
|
685
|
+ = stop_cont
|
|
|
686
|
+ | otherwise
|
|
|
687
|
+ = Select { sc_alts = []
|
|
|
688
|
+ , sc_bndr = mkWildValBinder OneTy hole_ty
|
|
|
689
|
+ , sc_env = Simplified OkDup
|
|
|
690
|
+ , sc_cont = stop_cont }
|
|
|
691
|
+ where
|
|
|
692
|
+ hole_ty = contHoleType k
|
|
|
693
|
+ stop_cont = contStop k
|
|
687
|
694
|
|
|
688
|
695
|
-------------------
|
|
689
|
696
|
mkArgInfo :: SimplEnv -> Id -> [CoreRule] -> SimplCont -> ArgInfo
|