
JHC has had this for a while, but it calls the pragma 'SRCLOC_ANNOTATE'.
It is actually mentioned on this page: http://hackage.haskell.org/trac/ghc/wiki/ExplicitCallStack
Yes, I know, but the discussion on that page wanted to go beyond this (possibly triggered by your demonstration that one can go beyond plain SRCLOC;-), which is why GHC still has neither of SRCLOC or SRCLOC_ANNOTATE (apart from the various SRCLOC hacks). What is really frustrating is that GHC has the machinery to do this trivially (RULES, soon core2core phase plugins as well), only that this machinery gets applied when source location information is no longer available, so it is useless for this problem:-( One thing that wasn't available when this discussion was last active is 'mapException' (btw, similar to 'catch'/'catches', a 'mapExceptions' would be useful). For instance, appended below is the example from that wiki page, with entirely local transformations to add source locations and to use that info to augment 'ErrorCall' exceptions (we should really augment 'PatternMatchFail' exception messages as well..). $ ghc -e main callstack.hs <interactive>: hd: empty list ("callstack.hs",25) ("callstack.hs",21) ("callstack.hs",16) ("callstack.hs",13) JHC could probably easily adapt its SRCLOC_ANNOTATE scheme to use a mapException-based scheme instead?-) So one could use the original code, and just add {-# SRCLOC_mapException e, f, hd #-} With GHC, I'm always tempted to write something like {-# RULES "hd->loc(hd)" hd = mapError SRCLOC . hd #-} but that uses the source location of the rule and, worse, when the rule is actually applied, 'hd's source location info is no longer available, so one cannot simply augment the 'RULES' mechanism to supply the source location of its main left-hand side symbol.. Claus ------------------------------ {-# LANGUAGE CPP #-} import Control.Exception #define SRCLOC (show (__FILE__,__LINE__)) #define ERRORSRC (\msg->error $ msg++SRCLOC) mapError src = mapException (\(ErrorCall e)->ErrorCall $ e++"\n"++src) errorSrc src = error . (++"\n"++src) main = print d d :: Int d = mapError SRCLOC (e []) {- line 13 -} e :: [Int] -> Int e = mapError SRCLOC . f 10 {- line 16 -} f :: Int -> [Int] -> Int f = \x -> case fac x < 10 of True -> \_ -> 3 False -> mapError SRCLOC . hd {- line 21 -} hd :: [a] -> a hd = \x -> case x of [] -> errorSrc SRCLOC "hd: empty list" {- line 25 -} (x:_) -> x fac :: Int -> Int fac = \n -> case n == 0 of True -> 1 False -> n * fac (n - 1)