1{-# LANGUAGE ImplicitParams, RankNTypes #-} 2{-# OPTIONS_GHC -dcore-lint #-} 3module Main where 4 5import GHC.Exception 6import GHC.Types 7 8f0 = putStrLn $ showCallStack ?loc 9 -- should just show the location of ?loc 10 11f1 :: (?loc :: CallStack) => IO () 12f1 = putStrLn $ showCallStack ?loc 13 -- should show the location of ?loc *and* f1's call-site 14 15f2 :: (?loc :: CallStack) => IO () 16f2 = do putStrLn $ showCallStack ?loc 17 putStrLn $ showCallStack ?loc 18 -- each ?loc should refer to a different location, but they should 19 -- share f2's call-site 20 21f3 :: ((?loc :: CallStack) => () -> IO ()) -> IO () 22f3 x = x () 23 -- the call-site for the functional argument should be added to the 24 -- stack.. 25 26f4 :: (?loc :: CallStack) => ((?loc :: CallStack) => () -> IO ()) -> IO () 27f4 x = x () 28 -- as should the call-site for f4 itself 29 30f5 :: (?loc1 :: CallStack) => ((?loc2 :: CallStack) => () -> IO ()) -> IO () 31f5 x = x () 32 -- we only push new call-sites onto CallStacks with the name IP name 33 34f6 :: (?loc :: CallStack) => Int -> IO () 35f6 0 = putStrLn $ showCallStack ?loc 36f6 n = f6 (n-1) 37 -- recursive functions add a SrcLoc for each recursive call 38 39main = do f0 40 f1 41 f2 42 f3 (\ () -> putStrLn $ showCallStack ?loc) 43 f4 (\ () -> putStrLn $ showCallStack ?loc) 44 f5 (\ () -> putStrLn $ showCallStack ?loc3) 45 f6 5 46