Skip to content

codeGen: Give proper LFInfo to datacon wrappers

Ben Gamari requested to merge wip/T23146 into master

As noted in Note [Conveying CAF-info and LFInfo between modules], when importing a binding from another module we must ensure that it gets the appropriate LambdaFormInfo if it is in WHNF to ensure that references to it are tagged correctly.

However, the implementation responsible for doing this, GHC.StgToCmm.Closure.mkLFImported, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146 (closed):

module B where

type NP :: [UnliftedType] -> UnliftedType
data NP xs where
  UNil :: NP '[]

module A where
import B

fieldsSam :: NP xs -> NP xs -> Bool
fieldsSam UNil UNil = True

x = fieldsSam UNil UNil

Due to its GADT nature, UNil produces a trivial wrapper

$WUNil :: NP '[]
$WUNil = UNil @'[] @~(<co:1>)

which is referenced in the RHS of A.x. Due to the above-mentioned bug in mkLFImported, the references to $WUNil passed to fieldsSam were not tagged. This is problematic as fieldsSam expected its arguments to be tagged as they are unlifted.

The fix is straightforward: extend the logic in mkLFImported to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant).

Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging.

Fixes #23146 (closed).

Edited by Ben Gamari

Merge request reports