Skip to content

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
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information