summaryrefslogtreecommitdiff
path: root/compiler/typecheck
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/typecheck')
-rw-r--r--compiler/typecheck/TcRnMonad.lhs7
-rw-r--r--compiler/typecheck/TcSplice.lhs18
2 files changed, 15 insertions, 10 deletions
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 7e7f117cdf..46624c5c00 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -494,9 +494,10 @@ getSrcSpanM :: TcRn SrcSpan
getSrcSpanM = do { env <- getLclEnv; return (tcl_loc env) }
setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
-setSrcSpan loc thing_inside
- | isGoodSrcSpan loc = updLclEnv (\env -> env { tcl_loc = loc }) thing_inside
- | otherwise = thing_inside -- Don't overwrite useful info with useless
+setSrcSpan loc@(RealSrcSpan _) thing_inside
+ = updLclEnv (\env -> env { tcl_loc = loc }) thing_inside
+-- Don't overwrite useful info with useless:
+setSrcSpan (UnhelpfulSpan _) thing_inside = thing_inside
addLocM :: (a -> TcM b) -> Located a -> TcM b
addLocM fn (L loc a) = setSrcSpan loc $ fn a
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 3cc2eb5570..6da5741037 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -897,13 +897,17 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
qReport False msg = addReport (text msg) empty
qLocation = do { m <- getModule
- ; l <- getSrcSpanM
- ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile l)
- , TH.loc_module = moduleNameString (moduleName m)
- , TH.loc_package = packageIdString (modulePackageId m)
- , TH.loc_start = (srcSpanStartLine l, srcSpanStartCol l)
- , TH.loc_end = (srcSpanEndLine l, srcSpanEndCol l) }) }
-
+ ; l <- getSrcSpanM
+ ; r <- case l of
+ UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
+ (ppr l)
+ RealSrcSpan s -> return s
+ ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
+ , TH.loc_module = moduleNameString (moduleName m)
+ , TH.loc_package = packageIdString (modulePackageId m)
+ , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r)
+ , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) }
+
qReify v = reify v
qClassInstances = lookupClassInstances