diff options
| author | Ian Lynagh <igloo@earth.li> | 2011-06-02 00:23:27 +0100 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2011-06-09 13:01:09 +0100 |
| commit | 5f8f1f244f49543cda309303f065c5bdcf961ea4 (patch) | |
| tree | b6640c1a7838a53904077e6448ddb0fcb6476242 /compiler/typecheck | |
| parent | 1d746841aafe38044dd9f0de1a8d686ea554a3c7 (diff) | |
| download | haskell-srcloc.tar.gz | |
Refactor SrcLoc and SrcSpansrcloc
The "Unhelpful" cases are now in a separate type. This allows us to
improve various things, e.g.:
* Most of the panic's in SrcLoc are now gone
* The Lexer now works with RealSrcSpans rather than SrcSpans, i.e. it
knows that it has real locations and thus can assume that the line
number etc really exists
* Some of the more suspicious cases are no longer necessary, e.g.
we no longer need this case in advanceSrcLoc:
advanceSrcLoc loc _ = loc -- Better than nothing
More improvements can probably be made, e.g. tick locations can
probably use RealSrcSpans too.
Diffstat (limited to 'compiler/typecheck')
| -rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 7 | ||||
| -rw-r--r-- | compiler/typecheck/TcSplice.lhs | 18 |
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 |