Lint error when solving CallStack constraints
This bug is spun out of this comment in #25671.
This code
{-# LANGUAGE ImplicitParams #-}
import Data.Maybe
import Debug.Trace
import GHC.IsList
import GHC.Stack
what :: (HasCallStack) => Int
what =
let cs = getCallStack callStack
in srcLocStartCol (snd (head cs))
main :: IO ()
main =
let ?callStack = fromList []
in print (what + what)
when compiled with -dcore-lint gives
*** Core Lint errors : in result of Desugar (before optimization) ***
T25671.hs:16:1: warning:
The value variable ‘$dIP_a1dg’ is out of scope
In the RHS of main :: IO ()
In the body of a let with binder $dIP_a192 :: ?callStack::CallStack
In the body of a let with binder $dIP_a1di :: HasCallStack
In the body of a let with binder $dIP_a19h :: HasCallStack
In an occurrence of $dIP_a1dg :: HasCallStack
Substitution: <InScope = {}
IdSubst = []
TvSubst = []
CvSubst = []>
*** Offending Program ***
Rec {
$dIsList_a194 :: IsList CallStack
[LclId]
$dIsList_a194 = $fIsListCallStack
what :: HasCallStack => Int
[LclIdX]
what
= \ ($dIP_a18D :: HasCallStack) ->
let {
$dIP_a1df :: HasCallStack
[LclId]
$dIP_a1df = $dIP_a18D } in
let {
$dIP_a18V :: HasCallStack
[LclId]
$dIP_a18V
= (pushCallStack
(unpackCString# "head"#,
$WSrcLoc
(unpackCString# "main"#)
(unpackCString# "T25671"#)
(unpackCString# "T25671.hs"#)
(I# 13#)
(I# 28#)
(I# 13#)
(I# 32#))
($dIP_a1df
`cast` (N:IP <"callStack">_N <CallStack>_N
:: (?callStack::CallStack) ~R# CallStack)))
`cast` (Sym (N:IP <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)) } in
let {
cs_ayl :: [([Char], SrcLoc)]
[LclId]
cs_ayl
= let {
$dIP_a18M :: HasCallStack
[LclId]
$dIP_a18M = $dIP_a18D } in
let {
$dIP_a18I :: HasCallStack
[LclId]
$dIP_a18I
= (pushCallStack
(unpackCString# "callStack"#,
$WSrcLoc
(unpackCString# "main"#)
(unpackCString# "T25671"#)
(unpackCString# "T25671.hs"#)
(I# 12#)
(I# 25#)
(I# 12#)
(I# 34#))
($dIP_a18M
`cast` (N:IP <"callStack">_N <CallStack>_N
:: (?callStack::CallStack) ~R# CallStack)))
`cast` (Sym (N:IP <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)) } in
letrec {
cs_a18K :: [([Char], SrcLoc)]
[LclId]
cs_a18K = getCallStack (callStack $dIP_a18I); } in
cs_a18K } in
srcLocStartCol
(snd @[Char] @SrcLoc (head @([Char], SrcLoc) $dIP_a18V cs_ayl))
main :: IO ()
[LclIdX]
main
= let {
$dIP_a192 :: ?callStack::CallStack
[LclId]
$dIP_a192
= (fromList
@CallStack
$dIsList_a194
((\ (@a_11) -> [] @a_11) @(Item CallStack)))
`cast` (Sym (N:IP <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)) } in
let {
$dIP_a1di :: HasCallStack
[LclId]
$dIP_a1di = $dIP_a192 } in
let {
$dIP_a19h :: HasCallStack
[LclId]
$dIP_a19h
= (pushCallStack
(unpackCString# "what"#,
$WSrcLoc
(unpackCString# "main"#)
(unpackCString# "T25671"#)
(unpackCString# "T25671.hs"#)
(I# 18#)
(I# 21#)
(I# 18#)
(I# 25#))
($dIP_a1di
`cast` (N:IP <"callStack">_N <CallStack>_N
:: (?callStack::CallStack) ~R# CallStack)))
`cast` (Sym (N:IP <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)) } in
let {
$dIP_a19f :: HasCallStack
[LclId]
$dIP_a19f
= (pushCallStack
(unpackCString# "what"#,
$WSrcLoc
(unpackCString# "main"#)
(unpackCString# "T25671"#)
(unpackCString# "T25671.hs"#)
(I# 18#)
(I# 14#)
(I# 18#)
(I# 18#))
($dIP_a1dg
`cast` (N:IP <"callStack">_N <CallStack>_N
:: (?callStack::CallStack) ~R# CallStack)))
`cast` (Sym (N:IP <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)) } in
let {
$dNum_a19d :: Num Int
[LclId]
$dNum_a19d = $fNumInt } in
let {
$dShow_a19a :: Show Int
[LclId]
$dShow_a19a = $fShowInt } in
print
@Int
$dShow_a19a
(+ @Int $dNum_a19d (what $dIP_a19f) (what $dIP_a19h))
end Rec }
*** End of Offense ***
Edited by sheaf