Skip to content

Join point CPR signature should be zapped after case-of-join

In !4229 (comment 305982) I noticed that we don't zap the CPR signature of a join point when we perform case-of-join. Here's a reproducer for HEAD:

{-# OPTIONS_GHC -O2 -fforce-recomp #-}
{-# LANGUAGE DeriveFunctor #-}
module Lib where

import Control.Applicative

data Box a = Box a
  deriving Functor

instance Applicative Box where
  pure = Box
  Box f <*> Box a = Box (f a)

data X = X
  (Maybe String)
  (Maybe String)

mb :: (String -> Box a) -> String -> Box (Maybe a)
mb _ ""  = Box Nothing
mb _ "-" = Box Nothing
mb p xs  = Just <$> p xs

run :: [String] -> Box X
run
  [ x1
  , x2
  ] = X
  <$> mb pure x1
  <*> mb pure x2

Here's the Core post-WW for $wrun:

$wrun_sKu
  = \ (w_sKq :: [String]) ->
      case w_sKq of {
        [] -> case lvl_sH3 of wild_00 { };
        : x1_akR [Dmd=<S,U>] ds_dEP [Dmd=<S,U>] ->
          case ds_dEP of {
            [] -> case lvl_sH4 of wild_00 { };
            : x2_akS [Dmd=<S,U>] ds_dEQ [Dmd=<S,U>] ->
              case ds_dEQ of {
                [] ->
                  join {
                    $j_sHu :: Maybe String -> (# X #)
                    [LclId[JoinId(1)],
                     Arity=1,
                     Str=<L,U>,
                     Cpr=m1,
                     Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
                             WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 130 40}]
                    $j_sHu (a1_als [OS=OneShot] :: Maybe String)
                      = case x2_akS of wild_X6 {
                          [] -> (# Lib.X a1_als (GHC.Maybe.Nothing @String) #);
                          : ds_dEl [Dmd=<S(S),U(U)>] ds_dEm ->
                            case ds_dEl of { GHC.Types.C# ds_dEn [Dmd=<S,U>] ->
                            case ds_dEn of {
                              __DEFAULT -> (# Lib.X a1_als (GHC.Maybe.Just @String wild_X6) #);
                              '-'# ->
                                case ds_dEm of {
                                  [] -> (# Lib.X a1_als (GHC.Maybe.Nothing @String) #);
                                  : ipv_sFM [Dmd=<L,A>] ipv_sFN [Dmd=<L,A>] ->
                                    (# Lib.X a1_als (GHC.Maybe.Just @String wild_X6) #)
                                }
                            }
                            }
                        } } in
                  case x1_akR of wild_X4 {
                    [] -> jump $j_sHu (GHC.Maybe.Nothing @String);
                    : ds_dEl [Dmd=<S(S),U(U)>] ds_dEm ->
                      case ds_dEl of { GHC.Types.C# ds_dEn [Dmd=<S,U>] ->
                      case ds_dEn of {
                        __DEFAULT -> jump $j_sHu (GHC.Maybe.Just @String wild_X4);
                        '-'# ->
                          case ds_dEm of {
                            [] -> jump $j_sHu (GHC.Maybe.Nothing @String);
                            : ipv_sFM [Dmd=<L,A>] ipv_sFN [Dmd=<L,A>] ->
                              jump $j_sHu (GHC.Maybe.Just @String wild_X4)
                          }
                      }
                      }
                  };
                : ipv_sG6 [Dmd=<B,A>] ipv_sG9 [Dmd=<B,A>] ->
                  case lvl_sH5 of wild_00 { }
              }
          }
      }

Note the Cpr=m1, which was correctly given by CPR analysis. The simplifier should zap that signature when doing case-of-join. Alternatively, we could teach CPR analysis just not to annotate join points at all (but still internally pretend that join points have the CPR property). We don't WW them anyway (Note [Don't w/w join points for CPR]).

To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information