Skip to content

HEAD regression: Core Lint error/panic due to out-of-scope dictionary

(Originally discovered in a head.hackage CI job here.)

The futhark-0.24.2 Hackage library will emit a Core Lint error if you build it with GHC HEAD. Here is a minimized example:

{-# LANGUAGE Haskell2010 #-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# LANGUAGE NoMonoLocalBinds #-}
module Futhark.Optimise.Fusion.GraphRep (emptyGraph) where

import qualified Data.IntMap.Strict as IM
import qualified Data.Kind
import Data.Map.Strict (Map)

data NodeT = FreeNode VName

emptyGraph :: Stms SOACS -> [(Int, NodeT)]
emptyGraph stms = labelNodes inputnodes
  where
    labelNodes = zip [0 ..]
    inputnodes = map FreeNode $ namesToList consumed
    (_aliased, consumed) = analyseStms stms

data Aliases (rep :: Data.Kind.Type)

class RepTypes l where
  type OpC l :: Data.Kind.Type -> Data.Kind.Type
instance RepTypes SOACS where
  type OpC SOACS = SOAC

class Aliased rep where
instance AliasedOp (OpC rep (Aliases rep)) => Aliased (Aliases rep) where

class AliasedOp op where
instance Aliased rep => AliasedOp (SOAC rep) where

analyseStms ::
  AliasedOp (OpC rep (Aliases rep)) =>
  Stms rep ->
  (Map VName Names, Names)
analyseStms = undefined

newtype Names = Names (IM.IntMap VName)

namesIntMap :: Names -> IM.IntMap VName
namesIntMap (Names m) = m

namesToList :: Names -> [VName]
namesToList = IM.elems . namesIntMap

data SOAC rep
data SOACS
data Stms rep
data VName

This will pass -dcore-lint with GHC 9.6 and earlier, but fail with GHC HEAD:

$ ~/Software/ghc-9.7.20230620/bin/ghc Bug.hs -dcore-lint -dno-typeable-binds
[1 of 1] Compiling Futhark.Optimise.Fusion.GraphRep ( Bug.hs, Bug.o )
*** Core Lint errors : in result of Desugar (before optimization) ***
Bug.hs:17:12: warning:
    Out of scope: $dAliased_a1oc :: Aliased (Aliases SOACS)
                  [LclId]
    In the RHS of emptyGraph :: Stms SOACS -> [(Int, NodeT)]
    In the body of lambda with binder stms_a10c :: Stms SOACS
    In an occurrence of $dAliased_a1oc :: Aliased (Aliases SOACS)
    Substitution: <InScope = {}
                   IdSubst   = []
                   TvSubst   = []
                   CvSubst   = []>
*** Offending Program ***
Rec {
namesIntMap :: Names -> IntMap VName
[LclId]
namesIntMap
  = \ (ds_d1xW :: Names) ->
      let {
        m_a12O :: IntMap VName
        [LclId]
        m_a12O = ds_d1xW `cast` (N:Names[0] :: Names ~R# IntMap VName) } in
      m_a12O

namesToList :: Names -> [VName]
[LclId]
namesToList
  = . @(IntMap VName) @[VName] @Names (elems @VName) namesIntMap

analyseStms
  :: forall rep.
     AliasedOp (OpC rep (Aliases rep)) =>
     Stms rep -> (Map VName Names, Names)
[LclId]
analyseStms
  = \ (@rep_a1cf)
      ($dAliasedOp_a1cg
         :: AliasedOp (OpC rep_a1cf (Aliases rep_a1cf))) ->
      let {
        $dIP_a1xk :: HasCallStack
        [LclId]
        $dIP_a1xk
          = emptyCallStack
            `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N)
                    :: CallStack ~R# (?callStack::CallStack)) } in
      let {
        $dIP_a1nY :: HasCallStack
        [LclId]
        $dIP_a1nY
          = (pushCallStack
               (unpackCString# "undefined"#,
                SrcLoc
                  (unpackCString# "main"#)
                  (unpackCString# "Futhark.Optimise.Fusion.GraphRep"#)
                  (unpackCString# "Bug.hs"#)
                  (I# 40#)
                  (I# 15#)
                  (I# 40#)
                  (I# 24#))
               ($dIP_a1xk
                `cast` (N:IP[0] <"callStack">_N <CallStack>_N
                        :: (?callStack::CallStack) ~R# CallStack)))
            `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N)
                    :: CallStack ~R# (?callStack::CallStack)) } in
      undefined
        @LiftedRep @(Stms rep_a1cf -> (Map VName Names, Names)) $dIP_a1nY

emptyGraph :: Stms SOACS -> [(Int, NodeT)]
[LclIdX]
emptyGraph
  = \ (stms_a10c :: Stms SOACS) ->
      let {
        $dAliasedOp_a1ob :: AliasedOp (SOAC (Aliases SOACS))
        [LclId]
        $dAliasedOp_a1ob
          = $fAliasedOpSOAC @(Aliases SOACS) $dAliased_a1oc } in
      let {
        $dAliased_a1oc :: Aliased (Aliases SOACS)
        [LclId]
        $dAliased_a1oc = $fAliasedAliases @SOACS $dAliasedOp_a1od } in
      let {
        $dAliasedOp_a1od :: AliasedOp (OpC SOACS (Aliases SOACS))
        [LclId]
        $dAliasedOp_a1od
          = $dAliasedOp_a1ob
            `cast` (Sub (Sym (AliasedOp (D:R:OpCSOACS[0] <Aliases SOACS>_N))_N)
                    :: AliasedOp (SOAC (Aliases SOACS))
                       ~R# AliasedOp (OpC SOACS (Aliases SOACS))) } in
      let {
        $dAliasedOp_a1o5 :: AliasedOp (OpC SOACS (Aliases SOACS))
        [LclId]
        $dAliasedOp_a1o5
          = $dAliasedOp_a1ob
            `cast` (Sub (Sym (AliasedOp (D:R:OpCSOACS[0] <Aliases SOACS>_N))_N)
                    :: AliasedOp (SOAC (Aliases SOACS))
                       ~R# AliasedOp (OpC SOACS (Aliases SOACS))) } in
      let {
        ds_d1y2 :: (Map VName Names, Names)
        [LclId]
        ds_d1y2 = analyseStms @SOACS $dAliasedOp_a1o5 stms_a10c } in
      let {
        _aliased_a1o8 :: Map VName Names
        [LclId]
        _aliased_a1o8
          = case ds_d1y2 of wild_00 { (_aliased_a1o8, consumed_a1o9) ->
            _aliased_a1o8
            } } in
      let {
        consumed_a1o9 :: Names
        [LclId]
        consumed_a1o9
          = case ds_d1y2 of wild_00 { (_aliased_a1o8, consumed_a1o9) ->
            consumed_a1o9
            } } in
      let {
        _aliased_a10f :: Map VName Names
        [LclId]
        _aliased_a10f = _aliased_a1o8 } in
      let {
        consumed_a10g :: Names
        [LclId]
        consumed_a10g = consumed_a1o9 } in
      let {
        inputnodes_a10e :: [NodeT]
        [LclId]
        inputnodes_a10e
          = letrec {
              inputnodes_a1ov :: [NodeT]
              [LclId]
              inputnodes_a1ov
                = $ @LiftedRep
                    @LiftedRep
                    @[VName]
                    @[NodeT]
                    (map @VName @NodeT (\ (ds_d1y1 :: VName) -> FreeNode ds_d1y1))
                    (namesToList consumed_a10g); } in
            inputnodes_a1ov } in
      let {
        labelNodes_a10d :: forall {b}. [b] -> [(Int, b)]
        [LclId]
        labelNodes_a10d
          = \ (@b_a1oC) ->
              let {
                $dEnum_a1wN :: Enum Int
                [LclId]
                $dEnum_a1wN = $fEnumInt } in
              let {
                $dNum_a1s2 :: Num Int
                [LclId]
                $dNum_a1s2 = $fNumInt } in
              letrec {
                labelNodes_a1wO :: [b_a1oC] -> [(Int, b_a1oC)]
                [LclId]
                labelNodes_a1wO
                  = zip @Int @b_a1oC (enumFrom @Int $dEnum_a1wN (I# 0#)); } in
              labelNodes_a1wO } in
      labelNodes_a10d @NodeT inputnodes_a10e

$fRepTypesSOACS [InlPrag=CONLIKE] :: RepTypes SOACS
[LclIdX[DFunId], Unf=DFun: \ -> C:RepTypes TYPE: SOACS]
$fRepTypesSOACS = C:RepTypes @SOACS

$fAliasedOpSOAC [InlPrag=CONLIKE]
  :: forall rep. Aliased rep => AliasedOp (SOAC rep)
[LclIdX[DFunId],
 Unf=DFun: \ (@rep_a109) (v_B1 :: Aliased rep_a109) ->
       C:AliasedOp TYPE: SOAC rep_a109]
$fAliasedOpSOAC
  = \ (@rep_a1xa) ($dAliased_a1xb :: Aliased rep_a1xa) ->
      C:AliasedOp @(SOAC rep_a1xa)

$fAliasedAliases [InlPrag=CONLIKE]
  :: forall rep.
     AliasedOp (OpC rep (Aliases rep)) =>
     Aliased (Aliases rep)
[LclIdX[DFunId],
 Unf=DFun: \ (@rep_a10a)
             (v_B1 :: AliasedOp (OpC rep_a10a (Aliases rep_a10a))) ->
       C:Aliased TYPE: Aliases rep_a10a]
$fAliasedAliases
  = \ (@rep_a1xf)
      ($dAliasedOp_a1xg
         :: AliasedOp (OpC rep_a1xf (Aliases rep_a1xf))) ->
      C:Aliased @(Aliases rep_a1xf)
end Rec }

*** End of Offense ***

<no location info>: error: 
Compilation had errors



<no location info>: error: ExitFailure 1

If you omit -dcore-lint, then GHC will panic:

$ ~/Software/ghc-9.7.20230620/bin/ghc Bug.hs
[1 of 1] Compiling Futhark.Optimise.Fusion.GraphRep ( Bug.hs, Bug.o )

<no location info>: error:
    panic! (the 'impossible' happened)
  GHC version 9.7.20230620:
        lookupIdSubst
  $dAliased_a1oc
  InScope {stms_a10c b_a1oC analyseStms namesToList $fAliasedAliases
           $fAliasedOpSOAC $fRepTypesSOACS}
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/GHC/Utils/Panic.hs:191:37 in ghc-9.7-inplace:GHC.Utils.Panic
        pprPanic, called at compiler/GHC/Core/Subst.hs:197:17 in ghc-9.7-inplace:GHC.Core.Subst
  CallStack (from HasCallStack):
    panic, called at compiler/GHC/Utils/Error.hs:503:29 in ghc-9.7-inplace:GHC.Utils.Error


Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug

I was able to trigger these bug using a GHC HEAD build at commit 1464a2a8.

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