Skip to content

SpecConstr generating bad specialisations

Try SpecConstr on this code (determ006):

module Lib where

foo :: Int -> Int
foo n =
  go (Just n) (Just (6::Int))
  where
  go Nothing (Just x) = go (Just 10) (Just x)
  go (Just n) (Just x)
    | n <= 0    = 0
    | otherwise = go (Just (n-1)) (Just x)

There are really just two call patterns to go:

(A)    forall (n::Int) (m::Int#).  go (Just n)      (Just (I# m))
(B)    forall (n::Int#) (m::Int#). go (Just (I# n)) (Just (I# m))

If go could be called from somewhere else (which in fact it can't) then the recursive call in the RHS would also give this call pattern

(C)    forall (n::Int#) (m::Int). go (Just (I# n)) (Just m)

In fact GHC makes these three specialisations:

 RULES: "SC:$wgo1" [2]   -- A bit like (B)
            forall (sc_s2wc :: GHC.Prim.Int#).
              $wgo_s2vk (GHC.Maybe.Just @ Int (GHC.Types.I# sc_s2wc))
                        (GHC.Maybe.Just @ Int lvl_s2uv)
              = $s$wgo_s2wh sc_s2wc
        "SC:$wgo2" [2]   -- This is (C)
            forall (sc_s2we :: Int) (sc_s2wd :: GHC.Prim.Int#).
              $wgo_s2vk (GHC.Maybe.Just @ Int (GHC.Types.I# sc_s2wd))
                        (GHC.Maybe.Just @ Int sc_s2we)
              = $s$wgo_s2wi sc_s2we sc_s2wd
        "SC:$wgo0" [2]   -- A bit like (A)
            forall (sc_s2w8 :: Int).
              $wgo_s2vk (GHC.Maybe.Just @ Int sc_s2w8)
                        (GHC.Maybe.Just @ Int lvl_s2uv)
              = $s$wgo_s2wb sc_s2w8]

Notice that the first and last of these mentions the un-forall'd lvl_s2uv on the LHS. Even worse, lvl_s2uv isn't in scope at that point (#16192).

Even if lvl_s2uv is in scope, I'm afraid that during matching we'll only match when the corresponding argument is precisely equal to lvl_s2uv which is terribly over-specialised.

Incidentally, we don't for a particular Int# literal like

   go (Just (I# 6#)) ...

and I think that's right: there are too many such literals.

Here's the code immediately pre-SpecConstr

Rec {
$wgo_s2vk :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
$wgo_s2vk
  = \ (w_s2vf :: Maybe Int) (w_s2vg :: Maybe Int) ->
      case w_s2vf of {
        Nothing ->
          case w_s2vg of wild_X8 [Dmd=<L,A>] {
            Nothing -> case lvl_s2vI of wild_00 { };
            Just x_aY0 -> $wgo_s2vk lvl_s2us wild_X8
          };
        Just n_aY1 [Dmd=<S(S),U(U)>] ->
          case w_s2vg of wild_X9 [Dmd=<L,A>] {
            Nothing -> case lvl_s2vI of wild_00 { };
            Just x_aY2 ->
              case n_aY1 of { GHC.Types.I# x_a2tS [Dmd=<S,U>] ->
              case GHC.Prim.<=# x_a2tS 0# of {
                __DEFAULT ->
                  $wgo_s2vk
                    (GHC.Maybe.Just @ Int (GHC.Types.I# (GHC.Prim.-# x_a2tS 1#)))
                    wild_X9;
                1# -> 0#
              }
              }
          }
      }
end Rec }

lvl_s2uv :: Int
lvl_s2uv = GHC.Types.I# 6#

lvl_s2uw :: Maybe Int
lvl_s2uw = GHC.Maybe.Just @ Int lvl_s2uv

foo :: Int -> Int
foo = \ (n_aX7 :: Int) ->
      case $wgo_s2vk (GHC.Maybe.Just @ Int n_aX7) lvl_s2uw of ww_s2vj
        { __DEFAULT -> GHC.Types.I# ww_s2vj  }

And post-SpecConstr -- note the uses of lvl_s2uv:

Rec {
$wgo_s2vk :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
[RULES: "SC:$wgo1" [2]
            forall (sc_s2wc :: GHC.Prim.Int#).
              $wgo_s2vk (GHC.Maybe.Just @ Int (GHC.Types.I# sc_s2wc))
                        (GHC.Maybe.Just @ Int lvl_s2uv)
              = $s$wgo_s2wh sc_s2wc
        "SC:$wgo2" [2]
            forall (sc_s2we :: Int) (sc_s2wd :: GHC.Prim.Int#).
              $wgo_s2vk (GHC.Maybe.Just @ Int (GHC.Types.I# sc_s2wd))
                        (GHC.Maybe.Just @ Int sc_s2we)
              = $s$wgo_s2wi sc_s2we sc_s2wd
        "SC:$wgo0" [2]
            forall (sc_s2w8 :: Int).
              $wgo_s2vk (GHC.Maybe.Just @ Int sc_s2w8)
                        (GHC.Maybe.Just @ Int lvl_s2uv)
              = $s$wgo_s2wb sc_s2w8]
$wgo_s2vk
  = \ (w_s2vf :: Maybe Int) (w_s2vg :: Maybe Int) ->
      case w_s2vf of {
        Nothing ->
          case w_s2vg of wild_X8 [Dmd=<L,A>] {
            Nothing -> case lvl_s2vI of wild_00 { };
            Just x_aY0 -> $wgo_s2vk lvl_s2us wild_X8
          };
        Just n_aY1 [Dmd=<S(S),U(U)>] ->
          case w_s2vg of wild_X9 [Dmd=<L,A>] {
            Nothing -> case lvl_s2vI of wild_00 { };
            Just x_aY2 ->
              case n_aY1 of { GHC.Types.I# x_a2tS [Dmd=<S,U>] ->
              case GHC.Prim.<=# x_a2tS 0# of {
                __DEFAULT ->
                  $wgo_s2vk
                    (GHC.Maybe.Just @ Int (GHC.Types.I# (GHC.Prim.-# x_a2tS 1#)))
                    wild_X9;
                1# -> 0#
              }
              }
          }
      }
end Rec }

lvl_s2uv :: Int
lvl_s2uv = GHC.Types.I# 6#

lvl_s2uw :: Maybe Int
lvl_s2uw = GHC.Maybe.Just @ Int lvl_s2uv

foo :: Int -> Int
foo
  = \ (n_aX7 :: Int) ->
      case $wgo_s2vk (GHC.Maybe.Just @ Int n_aX7) lvl_s2uw of ww_s2vj
      { __DEFAULT ->
      GHC.Types.I# ww_s2vj
      }
Edited by Ben Gamari
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information