From: Ian Lynagh <igloo@earth.li>
Date: Wed, 1 Jun 2011 23:23:27 +0000 (+0100)
Subject: Refactor SrcLoc and SrcSpan
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hp=cba098d7823815baa66bcaff7e4f8b54855ae6eb

Refactor SrcLoc and SrcSpan

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.
---

diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index f2ae963..a2b42a2 100644
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -480,12 +480,14 @@ ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
 -- Prints (if mod information is available) "Defined at <loc>" or 
 --  "Defined in <mod>" information for a Name.
 pprNameLoc :: Name -> SDoc
-pprNameLoc name
-  | isGoodSrcSpan loc = pprDefnLoc loc
-  | isInternalName name || isSystemName name 
-                      = ptext (sLit "<no location info>")
-  | otherwise         = ptext (sLit "Defined in ") <> ppr (nameModule name)
-  where loc = nameSrcSpan name
+pprNameLoc name = case nameSrcSpan name of
+                  RealSrcSpan s ->
+                      pprDefnLoc s
+                  UnhelpfulSpan _
+                   | isInternalName name || isSystemName name ->
+                      ptext (sLit "<no location info>")
+                   | otherwise ->
+                      ptext (sLit "Defined in ") <> ppr (nameModule name)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index c8a510f..355facd 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -677,14 +677,16 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
 -- If we know the exact definition point (which we may do with GHCi)
 -- then show that too.  But not if it's just "imported from X".
 ppr_defn :: SrcLoc -> SDoc
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext (sLit "defined at") <+> ppr loc)
-	     | otherwise	= empty
+ppr_defn (RealSrcLoc loc) = parens (ptext (sLit "defined at") <+> ppr loc)
+ppr_defn (UnhelpfulLoc _) = empty
 
 instance Outputable ImportSpec where
    ppr imp_spec
      = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec) 
-	<+> if isGoodSrcSpan loc then ptext (sLit "at") <+> ppr loc
-				 else empty
+	<+> pprLoc
      where
        loc = importSpecLoc imp_spec
+       pprLoc = case loc of
+                RealSrcSpan s -> ptext (sLit "at") <+> ppr s
+                UnhelpfulSpan _ -> empty
 \end{code}
diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index d2cbd7f..22ab915 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -7,10 +7,11 @@
 -- in source files, and allow tagging of those things with locations
 module SrcLoc (
 	-- * SrcLoc
-	SrcLoc,			-- Abstract
+	RealSrcLoc,			-- Abstract
+	SrcLoc(..),
 
         -- ** Constructing SrcLoc
-	mkSrcLoc, mkGeneralSrcLoc,
+	mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
 
 	noSrcLoc, 		-- "I'm sorry, I haven't a clue"
 	generatedSrcLoc,	-- Code generated within the compiler
@@ -26,22 +27,21 @@ module SrcLoc (
 	
 	-- ** Misc. operations on SrcLoc
 	pprDefnLoc,
-	
-        -- ** Predicates on SrcLoc
-        isGoodSrcLoc,
 
         -- * SrcSpan
-	SrcSpan,		-- Abstract
+	RealSrcSpan,		-- Abstract
+	SrcSpan(..),
 
         -- ** Constructing SrcSpan
-	mkGeneralSrcSpan, mkSrcSpan, 
+	mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
 	noSrcSpan, 
 	wiredInSrcSpan,		-- Something wired into the compiler
-	srcLocSpan,
+	srcLocSpan, realSrcLocSpan,
 	combineSrcSpans,
 	
 	-- ** Deconstructing SrcSpan
 	srcSpanStart, srcSpanEnd,
+	realSrcSpanStart, realSrcSpanEnd,
 	srcSpanFileName_maybe,
 
 	-- ** Unsafely deconstructing SrcSpan
@@ -54,7 +54,9 @@ module SrcLoc (
         isGoodSrcSpan, isOneLineSpan,
 
         -- * Located
-	Located(..), 
+	Located, 
+	RealLocated, 
+	GenLocated(..), 
 	
 	-- ** Constructing Located
 	noLoc,
@@ -89,10 +91,13 @@ We keep information about the {\em definition} point for each entity;
 this is the obvious stuff:
 \begin{code}
 -- | Represents a single point within a file
-data SrcLoc
+data RealSrcLoc
   = SrcLoc	FastString	-- A precise location (file name)
 		{-# UNPACK #-} !Int		-- line number, begins at 1
 		{-# UNPACK #-} !Int		-- column number, begins at 1
+
+data SrcLoc
+  = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
   | UnhelpfulLoc FastString	-- Just a general indication
 \end{code}
 
@@ -104,7 +109,10 @@ data SrcLoc
 
 \begin{code}
 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
-mkSrcLoc x line col = SrcLoc x line col
+mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
+
+mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
+mkRealSrcLoc x line col = SrcLoc x line col
 
 -- | Built-in "bad" 'SrcLoc' values for particular locations
 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
@@ -116,35 +124,26 @@ interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")
 mkGeneralSrcLoc :: FastString -> SrcLoc
 mkGeneralSrcLoc = UnhelpfulLoc 
 
--- | "Good" 'SrcLoc's have precise information about their location
-isGoodSrcLoc :: SrcLoc -> Bool
-isGoodSrcLoc (SrcLoc _ _ _) = True
-isGoodSrcLoc _other         = False
-
--- | Gives the filename of the 'SrcLoc' if it is available, otherwise returns a dummy value
-srcLocFile :: SrcLoc -> FastString
+-- | Gives the filename of the 'RealSrcLoc'
+srcLocFile :: RealSrcLoc -> FastString
 srcLocFile (SrcLoc fname _ _) = fname
-srcLocFile _other	      = (fsLit "<unknown file")
 
 -- | Raises an error when used on a "bad" 'SrcLoc'
-srcLocLine :: SrcLoc -> Int
+srcLocLine :: RealSrcLoc -> Int
 srcLocLine (SrcLoc _ l _) = l
-srcLocLine (UnhelpfulLoc s) = pprPanic "srcLocLine" (ftext s)
 
 -- | Raises an error when used on a "bad" 'SrcLoc'
-srcLocCol :: SrcLoc -> Int
+srcLocCol :: RealSrcLoc -> Int
 srcLocCol (SrcLoc _ _ c) = c
-srcLocCol (UnhelpfulLoc s) = pprPanic "srcLocCol" (ftext s)
 
 -- | Move the 'SrcLoc' down by one line if the character is a newline,
 -- to the next 8-char tabstop if it is a tab, and across by one
 -- character in any other case
-advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
+advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1
 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (((((c - 1) `shiftR` 3) + 1)
                                                   `shiftL` 3) + 1)
 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
-advanceSrcLoc loc            _    = loc -- Better than nothing
 \end{code}
 
 %************************************************************************
@@ -157,21 +156,31 @@ advanceSrcLoc loc            _    = loc -- Better than nothing
 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 instance Eq SrcLoc where
   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
-		   EQ     -> True
-		   _other -> False
+                 EQ     -> True
+                 _other -> False
+
+instance Eq RealSrcLoc where
+  loc1 == loc2 = case loc1 `cmpRealSrcLoc` loc2 of
+                 EQ     -> True
+                 _other -> False
 
 instance Ord SrcLoc where
   compare = cmpSrcLoc
-   
+
+instance Ord RealSrcLoc where
+  compare = cmpRealSrcLoc
+
 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
-cmpSrcLoc (UnhelpfulLoc _)  (SrcLoc _ _ _)    = GT
-cmpSrcLoc (SrcLoc _ _ _)    (UnhelpfulLoc _)  = LT
+cmpSrcLoc (UnhelpfulLoc _)  (RealSrcLoc _)    = GT
+cmpSrcLoc (RealSrcLoc _)    (UnhelpfulLoc _)  = LT
+cmpSrcLoc (RealSrcLoc l1)   (RealSrcLoc l2)   = (l1 `compare` l2)
 
-cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
+cmpRealSrcLoc :: RealSrcLoc -> RealSrcLoc -> Ordering
+cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
 
-instance Outputable SrcLoc where
+instance Outputable RealSrcLoc where
     ppr (SrcLoc src_path src_line src_col)
       = getPprStyle $ \ sty ->
         if userStyle sty || debugStyle sty then
@@ -183,8 +192,16 @@ instance Outputable SrcLoc where
             hcat [text "{-# LINE ", int src_line, space,
                   char '\"', pprFastFilePath src_path, text " #-}"]
 
+instance Outputable SrcLoc where
+    ppr (RealSrcLoc l) = ppr l
     ppr (UnhelpfulLoc s)  = ftext s
 
+instance Data RealSrcSpan where
+  -- don't traverse?
+  toConstr _   = abstractConstr "RealSrcSpan"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "RealSrcSpan"
+
 instance Data SrcSpan where
   -- don't traverse?
   toConstr _   = abstractConstr "SrcSpan"
@@ -209,7 +226,7 @@ The end position is defined to be the column /after/ the end of the
 span.  That is, a span of (1,1)-(1,2) is one character long, and a
 span of (1,1)-(1,1) is zero characters long.
 -}
-data SrcSpan
+data RealSrcSpan
   = SrcSpanOneLine 		-- a common case: a single line
 	{ srcSpanFile     :: !FastString,
 	  srcSpanLine     :: {-# UNPACK #-} !Int,
@@ -230,7 +247,15 @@ data SrcSpan
 	  srcSpanLine	  :: {-# UNPACK #-} !Int,
 	  srcSpanCol      :: {-# UNPACK #-} !Int
 	}
+#ifdef DEBUG
+  deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
+                                -- derive Show for Token
+#else
+  deriving (Eq, Typeable)
+#endif
 
+data SrcSpan =
+    RealSrcSpan !RealSrcSpan
   | UnhelpfulSpan !FastString	-- Just a general indication
 				-- also used to indicate an empty span
 
@@ -253,13 +278,14 @@ mkGeneralSrcSpan = UnhelpfulSpan
 -- | Create a 'SrcSpan' corresponding to a single point
 srcLocSpan :: SrcLoc -> SrcSpan
 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
-srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
+srcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)
+
+realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
+realSrcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 
 -- | Create a 'SrcSpan' between two points in a file
-mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
-mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
-mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
-mkSrcSpan loc1 loc2
+mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
+mkRealSrcSpan loc1 loc2
   | line1 == line2 = if col1 == col2
 			then SrcSpanPoint file line1 col1
 			else SrcSpanOneLine file line1 col1 col2
@@ -271,12 +297,25 @@ mkSrcSpan loc1 loc2
 	col2 = srcLocCol loc2
 	file = srcLocFile loc1
 
+-- | Create a 'SrcSpan' between two points in a file
+mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
+mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
+mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
+mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
+    = RealSrcSpan (mkRealSrcSpan loc1 loc2)
+
 -- | Combines two 'SrcSpan' into one that spans at least all the characters
 -- within both spans. Assumes the "file" part is the same in both inputs
 combineSrcSpans	:: SrcSpan -> SrcSpan -> SrcSpan
 combineSrcSpans	(UnhelpfulSpan _) r = r -- this seems more useful
 combineSrcSpans	l (UnhelpfulSpan _) = l
-combineSrcSpans	span1 span2
+combineSrcSpans	(RealSrcSpan span1) (RealSrcSpan span2)
+    = RealSrcSpan (combineRealSrcSpans span1 span2)
+
+-- | Combines two 'SrcSpan' into one that spans at least all the characters
+-- within both spans. Assumes the "file" part is the same in both inputs
+combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
+combineRealSrcSpans span1 span2
  = if line_start == line_end 
    then if col_start == col_end
         then SrcSpanPoint     file line_start col_start
@@ -299,17 +338,14 @@ combineSrcSpans	span1 span2
 \begin{code}
 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
 isGoodSrcSpan :: SrcSpan -> Bool
-isGoodSrcSpan SrcSpanOneLine{} = True
-isGoodSrcSpan SrcSpanMultiLine{} = True
-isGoodSrcSpan SrcSpanPoint{} = True
-isGoodSrcSpan _ = False
+isGoodSrcSpan (RealSrcSpan _) = True
+isGoodSrcSpan (UnhelpfulSpan _) = False
 
 isOneLineSpan :: SrcSpan -> Bool
 -- ^ True if the span is known to straddle only one line.
 -- For "bad" 'SrcSpan', it returns False
-isOneLineSpan s
-  | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
-  | otherwise	    = False		
+isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
+isOneLineSpan (UnhelpfulSpan _) = False
 
 \end{code}
 
@@ -321,34 +357,26 @@ isOneLineSpan s
 
 \begin{code}
 
--- | Raises an error when used on a "bad" 'SrcSpan'
-srcSpanStartLine :: SrcSpan -> Int
--- | Raises an error when used on a "bad" 'SrcSpan'
-srcSpanEndLine :: SrcSpan -> Int
--- | Raises an error when used on a "bad" 'SrcSpan'
-srcSpanStartCol :: SrcSpan -> Int
--- | Raises an error when used on a "bad" 'SrcSpan'
-srcSpanEndCol :: SrcSpan -> Int
+srcSpanStartLine :: RealSrcSpan -> Int
+srcSpanEndLine :: RealSrcSpan -> Int
+srcSpanStartCol :: RealSrcSpan -> Int
+srcSpanEndCol :: RealSrcSpan -> Int
 
 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
-srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 
 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
-srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 
 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
-srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 
 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
-srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 
 \end{code}
 
@@ -362,26 +390,28 @@ srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 
 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
 srcSpanStart :: SrcSpan -> SrcLoc
+srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
+srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)
+
 -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
 srcSpanEnd :: SrcSpan -> SrcLoc
+srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
+srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)
 
-srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
-srcSpanStart s = mkSrcLoc (srcSpanFile s) 
-			  (srcSpanStartLine s)
-		 	  (srcSpanStartCol s)
+realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
+realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
+                                  (srcSpanStartLine s)
+                                  (srcSpanStartCol s)
 
-srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
-srcSpanEnd s = 
-  mkSrcLoc (srcSpanFile s) 
-	   (srcSpanEndLine s)
- 	   (srcSpanEndCol s)
+realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
+realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
+                                (srcSpanEndLine s)
+                                (srcSpanEndCol s)
 
 -- | Obtains the filename for a 'SrcSpan' if it is "good"
 srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
-srcSpanFileName_maybe (SrcSpanOneLine { srcSpanFile = nm })   = Just nm
-srcSpanFileName_maybe (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
-srcSpanFileName_maybe (SrcSpanPoint { srcSpanFile = nm})      = Just nm
-srcSpanFileName_maybe _                                       = Nothing
+srcSpanFileName_maybe (RealSrcSpan s)   = Just (srcSpanFile s)
+srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
 
 \end{code}
 
@@ -400,17 +430,31 @@ instance Ord SrcSpan where
      (srcSpanEnd   a `compare` srcSpanEnd   b)
 
 
-instance Outputable SrcSpan where
+instance Outputable RealSrcSpan where
     ppr span
       = getPprStyle $ \ sty ->
         if userStyle sty || debugStyle sty then
-           pprUserSpan True span
+           pprUserRealSpan True span
         else
            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
                  char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
 
+instance Outputable SrcSpan where
+    ppr span
+      = getPprStyle $ \ sty ->
+        if userStyle sty || debugStyle sty then
+           pprUserSpan True span
+        else
+           case span of
+           UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
+           RealSrcSpan s -> ppr s
+
 pprUserSpan :: Bool -> SrcSpan -> SDoc
-pprUserSpan show_path (SrcSpanOneLine src_path line start_col end_col)
+pprUserSpan _         (UnhelpfulSpan s) = ftext s
+pprUserSpan show_path (RealSrcSpan s)   = pprUserRealSpan show_path s
+
+pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
+pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
   = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
          , int line, char ':', int start_col
          , ppUnless (end_col - start_col <= 1)
@@ -420,7 +464,7 @@ pprUserSpan show_path (SrcSpanOneLine src_path line start_col end_col)
          ]
 	  
 
-pprUserSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
+pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
   = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
 	 , parens (int sline <> char ',' <>  int scol)
 	 , char '-'
@@ -428,17 +472,13 @@ pprUserSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
 	   	   if ecol == 0 then int ecol else int (ecol-1))
 	 ]
 
-pprUserSpan show_path (SrcSpanPoint src_path line col)
+pprUserRealSpan show_path (SrcSpanPoint src_path line col)
   = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
          , int line, char ':', int col ]
 
-pprUserSpan _ (UnhelpfulSpan s)  = ftext s
-
-pprDefnLoc :: SrcSpan -> SDoc
+pprDefnLoc :: RealSrcSpan -> SDoc
 -- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
-pprDefnLoc loc
-  | isGoodSrcSpan loc = ptext (sLit "Defined at") <+> ppr loc
-  | otherwise	      = ppr loc
+pprDefnLoc loc = ptext (sLit "Defined at") <+> ppr loc
 \end{code}
 
 %************************************************************************
@@ -449,13 +489,16 @@ pprDefnLoc loc
 
 \begin{code}
 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
-data Located e = L SrcSpan e
+data GenLocated l e = L l e
   deriving (Eq, Ord, Typeable, Data)
 
-unLoc :: Located e -> e
+type Located e = GenLocated SrcSpan e
+type RealLocated e = GenLocated RealSrcSpan e
+
+unLoc :: GenLocated l e -> e
 unLoc (L _ e) = e
 
-getLoc :: Located e -> SrcSpan
+getLoc :: GenLocated l e -> l
 getLoc (L l _) = l
 
 noLoc :: e -> Located e
@@ -483,12 +526,16 @@ eqLocated a b = unLoc a == unLoc b
 cmpLocated :: Ord a => Located a -> Located a -> Ordering
 cmpLocated a b = unLoc a `compare` unLoc b
 
-instance Functor Located where
+instance Functor (GenLocated l) where
   fmap f (L l e) = L l (f e)
 
-instance Outputable e => Outputable (Located e) where
-  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) $$ ppr e
-		-- Print spans without the file name etc
+instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
+  ppr (L l e) = -- TODO: We can't do this since Located was refactored into
+                -- GenLocated:
+                -- Print spans without the file name etc
+                -- ifPprDebug (braces (pprUserSpan False l))
+                ifPprDebug (braces (ppr l))
+             $$ ppr e
 \end{code}
 
 %************************************************************************
@@ -506,11 +553,11 @@ leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
                                 `thenCmp`
                        (srcSpanEnd b `compare` srcSpanEnd a)
 
-
 -- | Determines whether a span encloses a given line and column index
 spans :: SrcSpan -> (Int, Int) -> Bool
-spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
-   where loc = mkSrcLoc (srcSpanFile span) l c
+spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
+spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
+   where loc = mkRealSrcLoc (srcSpanFile span) l c
 
 -- | Determines whether a span is enclosed by another one
 isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index 0a19290..9a7b43d 100644
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -173,7 +173,7 @@ data CmmToken
 -- -----------------------------------------------------------------------------
 -- Lexer actions
 
-type Action = SrcSpan -> StringBuffer -> Int -> P (Located CmmToken)
+type Action = RealSrcSpan -> StringBuffer -> Int -> P (RealLocated CmmToken)
 
 begin :: Int -> Action
 begin code _span _str _len = do pushLexState code; lexToken
@@ -268,7 +268,7 @@ tok_string str = CmmT_String (read str)
 setLine :: Int -> Action
 setLine code span buf len = do
   let line = parseUnsignedInteger buf len 10 octDecDigit
-  setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
+  setSrcLoc (mkRealSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
 	-- subtract one: the line number refers to the *following* line
   -- trace ("setLine "  ++ show line) $ do
   popLexState
@@ -278,7 +278,7 @@ setLine code span buf len = do
 setFile :: Int -> Action
 setFile code span buf len = do
   let file = lexemeToFastString (stepOn buf) (len-2)
-  setSrcLoc (mkSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
+  setSrcLoc (mkRealSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
   popLexState
   pushLexState code
   lexToken
@@ -289,16 +289,16 @@ setFile code span buf len = do
 
 cmmlex :: (Located CmmToken -> P a) -> P a
 cmmlex cont = do
-  tok@(L _ tok__) <- lexToken
-  --trace ("token: " ++ show tok__) $ do
-  cont tok
+  (L span tok) <- lexToken
+  --trace ("token: " ++ show tok) $ do
+  cont (L (RealSrcSpan span) tok)
 
-lexToken :: P (Located CmmToken)
+lexToken :: P (RealLocated CmmToken)
 lexToken = do
   inp@(loc1,buf) <- getInput
   sc <- getLexState
   case alexScan inp sc of
-    AlexEOF -> do let span = mkSrcSpan loc1 loc1
+    AlexEOF -> do let span = mkRealSrcSpan loc1 loc1
 		  setLastToken span 0
 		  return (L span CmmT_EOF)
     AlexError (loc2,_) -> do failLocMsgP loc1 loc2 "lexical error"
@@ -307,7 +307,7 @@ lexToken = do
 	lexToken
     AlexToken inp2@(end,buf2) len t -> do
 	setInput inp2
-	let span = mkSrcSpan loc1 end
+	let span = mkRealSrcSpan loc1 end
 	span `seq` setLastToken span len
 	t span buf len
 
@@ -315,7 +315,7 @@ lexToken = do
 -- Monad stuff
 
 -- Stuff that Alex needs to know about our input type:
-type AlexInput = (SrcLoc,StringBuffer)
+type AlexInput = (RealSrcLoc,StringBuffer)
 
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (_,s) = prevChar s '\n'
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 6d14be2..60f3bb5 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -1062,7 +1062,7 @@ parseCmmFile dflags filename = do
   showPass dflags "ParseCmm"
   buf <- hGetStringBuffer filename
   let
-	init_loc = mkSrcLoc (mkFastString filename) 1 1
+	init_loc = mkRealSrcLoc (mkFastString filename) 1 1
 	init_state = (mkPState dflags buf init_loc) { lex_state = [0] }
 		-- reset the lex_state: the Lexer monad leaves some stuff
 		-- in there we don't want.
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 37cbc2d..fbe1ab9 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -846,26 +846,16 @@ allocBinTickBox boxLabel pos m
 allocBinTickBox _boxLabel pos m = do e <- m; return (L pos e)
 
 isGoodSrcSpan' :: SrcSpan -> Bool
-isGoodSrcSpan' pos
-   | not (isGoodSrcSpan pos) = False
-   | start == end            = False
-   | otherwise		     = True
-  where
-   start = srcSpanStart pos
-   end   = srcSpanEnd pos
+isGoodSrcSpan' pos@(RealSrcSpan _) = srcSpanStart pos /= srcSpanEnd pos
+isGoodSrcSpan' (UnhelpfulSpan _) = False
 
 mkHpcPos :: SrcSpan -> HpcPos
-mkHpcPos pos 
-   | not (isGoodSrcSpan' pos) = panic "bad source span; expected such spans to be filtered out"
-   | otherwise		      = hpcPos
-  where
-   start = srcSpanStart pos
-   end   = srcSpanEnd pos
-   hpcPos = toHpcPos ( srcLocLine start
-		     , srcLocCol start
-		     , srcLocLine end
-		     , srcLocCol end - 1
-		     )
+mkHpcPos pos@(RealSrcSpan s)
+   | isGoodSrcSpan' pos = toHpcPos (srcSpanStartLine s,
+                                    srcSpanStartCol s,
+                                    srcSpanEndLine s,
+                                    srcSpanEndCol s)
+mkHpcPos _ = panic "bad source span; expected such spans to be filtered out"
 
 hpcSrcSpan :: SrcSpan
 hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs
index 176182e..7b4c904 100644
--- a/compiler/hsSyn/HsImpExp.lhs
+++ b/compiler/hsSyn/HsImpExp.lhs
@@ -15,7 +15,7 @@ import HsDoc		( HsDocString )
 
 import Outputable
 import FastString
-import SrcLoc           ( Located(..), noLoc )
+import SrcLoc
 
 import Data.Data
 \end{code}
diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs
index 39093f2..ce748eb 100644
--- a/compiler/hsSyn/HsSyn.lhs
+++ b/compiler/hsSyn/HsSyn.lhs
@@ -41,7 +41,7 @@ import HsDoc
 -- others:
 import IfaceSyn		( IfaceBinding )
 import Outputable
-import SrcLoc		( Located(..) )
+import SrcLoc
 import Module		( Module, ModuleName )
 import FastString
 
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 0ecc09b..3a054e1 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -187,7 +187,7 @@ module GHC (
 
 	-- ** Source locations
 	SrcLoc, pprDefnLoc,
-        mkSrcLoc, isGoodSrcLoc, noSrcLoc,
+        mkSrcLoc, noSrcLoc,
 	srcLocFile, srcLocLine, srcLocCol,
         SrcSpan,
         mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
@@ -197,7 +197,7 @@ module GHC (
         srcSpanStartCol, srcSpanEndCol,
 
         -- ** Located
-	Located(..),
+	GenLocated(..), Located,
 
 	-- *** Constructing Located
 	noLoc, mkGeneralLocated,
@@ -1105,7 +1105,7 @@ getModuleSourceAndFlags mod = do
 getTokenStream :: GhcMonad m => Module -> m [Located Token]
 getTokenStream mod = do
   (sourceFile, source, flags) <- getModuleSourceAndFlags mod
-  let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
+  let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
   case lexTokenStream source startLoc flags of
     POk _ ts  -> return ts
     PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
@@ -1116,7 +1116,7 @@ getTokenStream mod = do
 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
 getRichTokenStream mod = do
   (sourceFile, source, flags) <- getModuleSourceAndFlags mod
-  let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
+  let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
   case lexTokenStream source startLoc flags of
     POk _ ts -> return $ addSourceToTokens startLoc source ts
     PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
@@ -1124,21 +1124,22 @@ getRichTokenStream mod = do
 -- | Given a source location and a StringBuffer corresponding to this
 -- location, return a rich token stream with the source associated to the
 -- tokens.
-addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
+addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]
                   -> [(Located Token, String)]
 addSourceToTokens _ _ [] = []
 addSourceToTokens loc buf (t@(L span _) : ts)
-    | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
-    | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
-    where
-      (newLoc, newBuf, str) = go "" loc buf
-      start = srcSpanStart span
-      end = srcSpanEnd span
-      go acc loc buf | loc < start = go acc nLoc nBuf
-                     | start <= loc && loc < end = go (ch:acc) nLoc nBuf
-                     | otherwise = (loc, buf, reverse acc)
-          where (ch, nBuf) = nextChar buf
-                nLoc = advanceSrcLoc loc ch
+    = case span of
+      UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
+      RealSrcSpan s   -> (t,str) : addSourceToTokens newLoc newBuf ts
+        where
+          (newLoc, newBuf, str) = go "" loc buf
+          start = realSrcSpanStart s
+          end = realSrcSpanEnd s
+          go acc loc buf | loc < start = go acc nLoc nBuf
+                         | start <= loc && loc < end = go (ch:acc) nLoc nBuf
+                         | otherwise = (loc, buf, reverse acc)
+              where (ch, nBuf) = nextChar buf
+                    nLoc = advanceSrcLoc loc ch
 
 
 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
@@ -1146,21 +1147,26 @@ addSourceToTokens loc buf (t@(L span _) : ts)
 -- insignificant whitespace.)
 showRichTokenStream :: [(Located Token, String)] -> String
 showRichTokenStream ts = go startLoc ts ""
-    where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
-          startLoc = mkSrcLoc sourceFile 1 1
+    where sourceFile = getFile $ map (getLoc . fst) ts
+          getFile [] = panic "showRichTokenStream: No source file found"
+          getFile (UnhelpfulSpan _ : xs) = getFile xs
+          getFile (RealSrcSpan s : _) = srcSpanFile s
+          startLoc = mkRealSrcLoc sourceFile 1 1
           go _ [] = id
           go loc ((L span _, str):ts)
-              | not (isGoodSrcSpan span) = go loc ts
-              | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
-                                     . (str ++)
-                                     . go tokEnd ts
-              | otherwise = ((replicate (tokLine - locLine) '\n') ++)
-                            . ((replicate tokCol ' ') ++)
-                            . (str ++)
-                            . go tokEnd ts
-              where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
-                    (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
-                    tokEnd = srcSpanEnd span
+              = case span of
+                UnhelpfulSpan _ -> go loc ts
+                RealSrcSpan s
+                 | locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)
+                                       . (str ++)
+                                       . go tokEnd ts
+                 | otherwise -> ((replicate (tokLine - locLine) '\n') ++)
+                              . ((replicate tokCol ' ') ++)
+                              . (str ++)
+                              . go tokEnd ts
+                  where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
+                        (tokLine, tokCol) = (srcSpanStartLine s, srcSpanStartCol s)
+                        tokEnd = realSrcSpanEnd s
 
 -- -----------------------------------------------------------------------------
 -- Interactive evaluation
@@ -1258,7 +1264,7 @@ parser :: String         -- ^ Haskell module source text (full Unicode is suppor
 
 parser str dflags filename = 
    let
-       loc  = mkSrcLoc (mkFastString filename) 1 1
+       loc  = mkRealSrcLoc (mkFastString filename) 1 1
        buf  = stringToStringBuffer str
    in
    case unP Parser.parseModule (mkPState dflags buf loc) of
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index 24a216a..93ce824 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -55,7 +55,7 @@ getImports :: DynFlags
            -> IO ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
               -- ^ The source imports, normal imports, and the module name.
 getImports dflags buf filename source_filename = do
-  let loc  = mkSrcLoc (mkFastString filename) 1 1
+  let loc  = mkRealSrcLoc (mkFastString filename) 1 1
   case unP parseHeader (mkPState dflags buf loc) of
     PFailed span err -> parseError span err
     POk pst rdr_module -> do
@@ -143,7 +143,7 @@ lazyGetToks dflags filename handle = do
   buf <- hGetStringBufferBlock handle blockSize
   unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False
  where
-  loc  = mkSrcLoc (mkFastString filename) 1 1
+  loc  = mkRealSrcLoc (mkFastString filename) 1 1
 
   lazyLexBuf :: Handle -> PState -> Bool -> IO [Located Token]
   lazyLexBuf handle state eof = do
@@ -160,7 +160,7 @@ lazyGetToks dflags filename handle = do
                   _other    -> do rest <- lazyLexBuf handle state' eof
                                   return (t : rest)
       _ | not eof   -> getMore handle state
-        | otherwise -> return [L (last_loc state) ITeof]
+        | otherwise -> return [L (RealSrcSpan (last_loc state)) ITeof]
                          -- parser assumes an ITeof sentinel at the end
 
   getMore :: Handle -> PState -> IO [Located Token]
@@ -175,12 +175,12 @@ lazyGetToks dflags filename handle = do
 getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
 getToks dflags filename buf = lexAll (pragState dflags buf loc)
  where
-  loc  = mkSrcLoc (mkFastString filename) 1 1
+  loc  = mkRealSrcLoc (mkFastString filename) 1 1
 
   lexAll state = case unP (lexer return) state of
                    POk _      t@(L _ ITeof) -> [t]
                    POk state' t -> t : lexAll state'
-                   _ -> [L (last_loc state) ITeof]
+                   _ -> [L (RealSrcSpan (last_loc state)) ITeof]
 
 
 -- | Parse OPTIONS and LANGUAGE pragmas of the source file.
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 3e37f5b..6542a06 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -340,7 +340,7 @@ hscParse' mod_summary
             Just b  -> return b
             Nothing -> liftIO $ hGetStringBuffer src_filename
 
-   let loc  = mkSrcLoc (mkFastString src_filename) 1 1
+   let loc  = mkRealSrcLoc (mkFastString src_filename) 1 1
 
    case unP parseModule (mkPState dflags buf loc) of
      PFailed span err ->
@@ -1186,7 +1186,7 @@ hscParseThingWithLocation source linenumber parser str
       liftIO $ showPass dflags "Parser"
 
       let buf = stringToStringBuffer str
-          loc  = mkSrcLoc (fsLit source) linenumber 1
+          loc  = mkRealSrcLoc (fsLit source) linenumber 1
 
       case unP parser (mkPState dflags buf loc) of
 
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index f3e569b..ea0cd63 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -136,7 +136,7 @@ import CoreSyn		( CoreRule, CoreVect )
 import Maybes		( orElse, expectJust, catMaybes )
 import Outputable
 import BreakArray
-import SrcLoc		( SrcSpan, Located(..) )
+import SrcLoc
 import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply	( UniqSupply )
 import FastString
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index a55a631..76a02d6 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -7,7 +7,8 @@
 -- definition, with some hand-coded bits.
 --
 -- Completely accurate information about token-spans within the source
--- file is maintained.  Every token has a start and end SrcLoc attached to it.
+-- file is maintained.  Every token has a start and end RealSrcLoc
+-- attached to it.
 --
 -----------------------------------------------------------------------------
 
@@ -555,7 +556,7 @@ data Token
   | ITparenEscape		--  $( 
   | ITvarQuote			--  '
   | ITtyQuote			--  ''
-  | ITquasiQuote (FastString,FastString,SrcSpan) --  [:...|...|]
+  | ITquasiQuote (FastString,FastString,RealSrcSpan) --  [:...|...|]
 
   -- Arrow notation extension
   | ITproc
@@ -721,7 +722,7 @@ reservedSymsFM = listToUFM $
 -- -----------------------------------------------------------------------------
 -- Lexer actions
 
-type Action = SrcSpan -> StringBuffer -> Int -> P (Located Token)
+type Action = RealSrcSpan -> StringBuffer -> Int -> P (RealLocated Token)
 
 special :: Token -> Action
 special tok span _buf _len = return (L span tok)
@@ -764,7 +765,7 @@ hopefully_open_brace span buf len
                  Layout prev_off : _ -> prev_off < offset
                  _                   -> True
       if isOK then pop_and open_brace span buf len
-              else failSpanMsgP span (text "Missing block")
+              else failSpanMsgP (RealSrcSpan span) (text "Missing block")
 
 pop_and :: Action -> Action
 pop_and act span buf len = do _ <- popLexState
@@ -846,7 +847,7 @@ lineCommentToken span buf len = do
   nested comments require traversing by hand, they can't be parsed
   using regular expressions.
 -}
-nested_comment :: P (Located Token) -> Action
+nested_comment :: P (RealLocated Token) -> Action
 nested_comment cont span _str _len = do
   input <- getInput
   go "" (1::Int) input
@@ -887,8 +888,8 @@ nested_doc_comment span buf _len = withLexedDocType (go "")
         Just (_,_) -> go ('\123':commentAcc) input docType False
       Just (c,input) -> go (c:commentAcc) input docType False
 
-withLexedDocType :: (AlexInput -> (String -> Token) -> Bool -> P (Located Token))
-                 -> P (Located Token)
+withLexedDocType :: (AlexInput -> (String -> Token) -> Bool -> P (RealLocated Token))
+                 -> P (RealLocated Token)
 withLexedDocType lexDocComment = do
   input@(AI _ buf) <- getInput
   case prevChar buf ' ' of
@@ -925,19 +926,19 @@ endPrag span _buf _len = do
 -- called afterwards, so it can just update the state. 
 
 docCommentEnd :: AlexInput -> String -> (String -> Token) -> StringBuffer ->
-                 SrcSpan -> P (Located Token) 
+                 RealSrcSpan -> P (RealLocated Token) 
 docCommentEnd input commentAcc docType buf span = do
   setInput input
   let (AI loc nextBuf) = input
       comment = reverse commentAcc
-      span' = mkSrcSpan (srcSpanStart span) loc
+      span' = mkRealSrcSpan (realSrcSpanStart span) loc
       last_len = byteDiff buf nextBuf
       
   span `seq` setLastToken span' last_len
   return (L span' (docType comment))
  
-errBrace :: AlexInput -> SrcSpan -> P a
-errBrace (AI end _) span = failLocMsgP (srcSpanStart span) end "unterminated `{-'"
+errBrace :: AlexInput -> RealSrcSpan -> P a
+errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) end "unterminated `{-'"
 
 open_brace, close_brace :: Action
 open_brace span _str _len = do 
@@ -1012,8 +1013,8 @@ varsym, consym :: Action
 varsym = sym ITvarsym
 consym = sym ITconsym
 
-sym :: (FastString -> Token) -> SrcSpan -> StringBuffer -> Int
-    -> P (Located Token)
+sym :: (FastString -> Token) -> RealSrcSpan -> StringBuffer -> Int
+    -> P (RealLocated Token)
 sym con span buf len = 
   case lookupUFM reservedSymsFM fs of
 	Just (keyword,exts) -> do
@@ -1145,7 +1146,7 @@ do_layout_left span _buf _len = do
 setLine :: Int -> Action
 setLine code span buf len = do
   let line = parseUnsignedInteger buf len 10 octDecDigit
-  setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
+  setSrcLoc (mkRealSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
 	-- subtract one: the line number refers to the *following* line
   _ <- popLexState
   pushLexState code
@@ -1154,12 +1155,17 @@ setLine code span buf len = do
 setFile :: Int -> Action
 setFile code span buf len = do
   let file = lexemeToFastString (stepOn buf) (len-2)
-  setAlrLastLoc noSrcSpan
-  setSrcLoc (mkSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
+  setAlrLastLoc $ alrInitialLoc file
+  setSrcLoc (mkRealSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
   _ <- popLexState
   pushLexState code
   lexToken
 
+alrInitialLoc :: FastString -> RealSrcSpan
+alrInitialLoc file = mkRealSrcSpan loc loc
+    where -- This is a hack to ensure that the first line in a file
+          -- looks like it is after the initial location:
+          loc = mkRealSrcLoc file (-1) (-1)
 
 -- -----------------------------------------------------------------------------
 -- Options, includes and language pragmas.
@@ -1170,7 +1176,7 @@ lex_string_prag mkTok span _buf _len
          start <- getSrcLoc
          tok <- go [] input
          end <- getSrcLoc
-         return (L (mkSrcSpan start end) tok)
+         return (L (mkRealSrcSpan start end) tok)
     where go acc input
               = if isString input "#-}"
                    then do setInput input
@@ -1183,7 +1189,7 @@ lex_string_prag mkTok span _buf _len
               = case alexGetChar i of
                   Just (c,i') | c == x    -> isString i' xs
                   _other -> False
-          err (AI end _) = failLocMsgP (srcSpanStart span) end "unterminated options pragma"
+          err (AI end _) = failLocMsgP (realSrcSpanStart span) end "unterminated options pragma"
 
 
 -- -----------------------------------------------------------------------------
@@ -1195,7 +1201,7 @@ lex_string_tok :: Action
 lex_string_tok span _buf _len = do
   tok <- lex_string ""
   end <- getSrcLoc 
-  return (L (mkSrcSpan (srcSpanStart span) end) tok)
+  return (L (mkRealSrcSpan (realSrcSpanStart span) end) tok)
 
 lex_string :: String -> P Token
 lex_string s = do
@@ -1256,7 +1262,7 @@ lex_char_tok :: Action
 -- see if there's a trailing quote
 lex_char_tok span _buf _len = do	-- We've seen '
    i1 <- getInput	-- Look ahead to first character
-   let loc = srcSpanStart span
+   let loc = realSrcSpanStart span
    case alexGetChar' i1 of
 	Nothing -> lit_error  i1
 
@@ -1264,7 +1270,7 @@ lex_char_tok span _buf _len = do	-- We've seen '
 		  th_exts <- extension thEnabled
 		  if th_exts then do
 			setInput i2
-			return (L (mkSrcSpan loc end2)  ITtyQuote)
+			return (L (mkRealSrcSpan loc end2)  ITtyQuote)
 		   else lit_error i1
 
 	Just ('\\', i2@(AI _end2 _)) -> do 	-- We've seen 'backslash
@@ -1290,10 +1296,10 @@ lex_char_tok span _buf _len = do	-- We've seen '
 					-- If TH is on, just parse the quote only
 			th_exts <- extension thEnabled	
 			let (AI end _) = i1
-			if th_exts then return (L (mkSrcSpan loc end) ITvarQuote)
+			if th_exts then return (L (mkRealSrcSpan loc end) ITvarQuote)
 				   else lit_error i2
 
-finish_char_tok :: SrcLoc -> Char -> P (Located Token)
+finish_char_tok :: RealSrcLoc -> Char -> P (RealLocated Token)
 finish_char_tok loc ch	-- We've already seen the closing quote
 			-- Just need to check for trailing #
   = do	magicHash <- extension magicHashEnabled
@@ -1302,11 +1308,11 @@ finish_char_tok loc ch	-- We've already seen the closing quote
 		case alexGetChar' i of
 			Just ('#',i@(AI end _)) -> do
 				setInput i
-				return (L (mkSrcSpan loc end) (ITprimchar ch))
+				return (L (mkRealSrcSpan loc end) (ITprimchar ch))
 			_other ->
-				return (L (mkSrcSpan loc end) (ITchar ch))
+				return (L (mkRealSrcSpan loc end) (ITchar ch))
 	    else do
-		   return (L (mkSrcSpan loc end) (ITchar ch))
+		   return (L (mkRealSrcSpan loc end) (ITchar ch))
 
 isAny :: Char -> Bool
 isAny c | c > '\x7f' = isPrint c
@@ -1441,10 +1447,10 @@ lex_quasiquote_tok span buf len = do
   quoteStart <- getSrcLoc              
   quote <- lex_quasiquote ""
   end <- getSrcLoc 
-  return (L (mkSrcSpan (srcSpanStart span) end)
+  return (L (mkRealSrcSpan (realSrcSpanStart span) end)
            (ITquasiQuote (mkFastString quoter,
                           mkFastString (reverse quote),
-                          mkSrcSpan quoteStart end)))
+                          mkRealSrcSpan quoteStart end)))
 
 lex_quasiquote :: String -> P String
 lex_quasiquote s = do
@@ -1472,12 +1478,12 @@ lex_quasiquote s = do
 
 warn :: DynFlag -> SDoc -> Action
 warn option warning srcspan _buf _len = do
-    addWarning option srcspan warning
+    addWarning option (RealSrcSpan srcspan) warning
     lexToken
 
 warnThen :: DynFlag -> SDoc -> Action -> Action
 warnThen option warning action srcspan buf len = do
-    addWarning option srcspan warning
+    addWarning option (RealSrcSpan srcspan) warning
     action srcspan buf len
 
 -- -----------------------------------------------------------------------------
@@ -1500,22 +1506,22 @@ data PState = PState {
 	buffer	   :: StringBuffer,
         dflags     :: DynFlags,
         messages   :: Messages,
-        last_loc   :: SrcSpan,	-- pos of previous token
+        last_loc   :: RealSrcSpan,	-- pos of previous token
 	last_len   :: !Int,	-- len of previous token
-        loc        :: SrcLoc,   -- current loc (end of prev token + 1)
+        loc        :: RealSrcLoc,   -- current loc (end of prev token + 1)
 	extsBitmap :: !Int,	-- bitmap that determines permitted extensions
 	context	   :: [LayoutContext],
 	lex_state  :: [Int],
         -- Used in the alternative layout rule:
         -- These tokens are the next ones to be sent out. They are
         -- just blindly emitted, without the rule looking at them again:
-        alr_pending_implicit_tokens :: [Located Token],
+        alr_pending_implicit_tokens :: [RealLocated Token],
         -- This is the next token to be considered or, if it is Nothing,
         -- we need to get the next token from the input stream:
-        alr_next_token :: Maybe (Located Token),
+        alr_next_token :: Maybe (RealLocated Token),
         -- This is what we consider to be the locatino of the last token
         -- emitted:
-        alr_last_loc :: SrcSpan,
+        alr_last_loc :: RealSrcSpan,
         -- The stack of layout contexts:
         alr_context :: [ALRContext],
         -- Are we expecting a '{'? If it's Just, then the ALRLayout tells
@@ -1556,13 +1562,13 @@ thenP :: P a -> (a -> P b) -> P b
 		PFailed span err -> PFailed span err
 
 failP :: String -> P a
-failP msg = P $ \s -> PFailed (last_loc s) (text msg)
+failP msg = P $ \s -> PFailed (RealSrcSpan (last_loc s)) (text msg)
 
 failMsgP :: String -> P a
-failMsgP msg = P $ \s -> PFailed (last_loc s) (text msg)
+failMsgP msg = P $ \s -> PFailed (RealSrcSpan (last_loc s)) (text msg)
 
-failLocMsgP :: SrcLoc -> SrcLoc -> String -> P a
-failLocMsgP loc1 loc2 str = P $ \_ -> PFailed (mkSrcSpan loc1 loc2) (text str)
+failLocMsgP :: RealSrcLoc -> RealSrcLoc -> String -> P a
+failLocMsgP loc1 loc2 str = P $ \_ -> PFailed (RealSrcSpan (mkRealSrcSpan loc1 loc2)) (text str)
 
 failSpanMsgP :: SrcSpan -> SDoc -> P a
 failSpanMsgP span msg = P $ \_ -> PFailed span msg
@@ -1587,19 +1593,19 @@ getExts = P $ \s -> POk s (extsBitmap s)
 setExts :: (Int -> Int) -> P ()
 setExts f = P $ \s -> POk s{ extsBitmap = f (extsBitmap s) } ()
 
-setSrcLoc :: SrcLoc -> P ()
+setSrcLoc :: RealSrcLoc -> P ()
 setSrcLoc new_loc = P $ \s -> POk s{loc=new_loc} ()
 
-getSrcLoc :: P SrcLoc
+getSrcLoc :: P RealSrcLoc
 getSrcLoc = P $ \s@(PState{ loc=loc }) -> POk s loc
 
-setLastToken :: SrcSpan -> Int -> P ()
+setLastToken :: RealSrcSpan -> Int -> P ()
 setLastToken loc len = P $ \s -> POk s { 
   last_loc=loc, 
   last_len=len
   } ()
 
-data AlexInput = AI SrcLoc StringBuffer
+data AlexInput = AI RealSrcLoc StringBuffer
 
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (AI _ buf) = prevChar buf '\n'
@@ -1685,7 +1691,7 @@ popLexState = P $ \s@PState{ lex_state=ls:l } -> POk s{ lex_state=l } ls
 getLexState :: P Int
 getLexState = P $ \s@PState{ lex_state=ls:_ } -> POk s ls
 
-popNextToken :: P (Maybe (Located Token))
+popNextToken :: P (Maybe (RealLocated Token))
 popNextToken
     = P $ \s@PState{ alr_next_token = m } ->
               POk (s {alr_next_token = Nothing}) m
@@ -1699,10 +1705,10 @@ activeContext = do
     ([],Nothing) -> return impt
     _other       -> return True
 
-setAlrLastLoc :: SrcSpan -> P ()
+setAlrLastLoc :: RealSrcSpan -> P ()
 setAlrLastLoc l = P $ \s -> POk (s {alr_last_loc = l}) ()
 
-getAlrLastLoc :: P SrcSpan
+getAlrLastLoc :: P RealSrcSpan
 getAlrLastLoc = P $ \s@(PState {alr_last_loc = l}) -> POk s l
 
 getALRContext :: P [ALRContext]
@@ -1719,7 +1725,7 @@ setJustClosedExplicitLetBlock :: Bool -> P ()
 setJustClosedExplicitLetBlock b
  = P $ \s -> POk (s {alr_justClosedExplicitLetBlock = b}) ()
 
-setNextToken :: Located Token -> P ()
+setNextToken :: RealLocated Token -> P ()
 setNextToken t = P $ \s -> POk (s {alr_next_token = Just t}) ()
 
 implicitTokenPending :: P Bool
@@ -1729,14 +1735,14 @@ implicitTokenPending
               [] -> POk s False
               _  -> POk s True
 
-popPendingImplicitToken :: P (Maybe (Located Token))
+popPendingImplicitToken :: P (Maybe (RealLocated Token))
 popPendingImplicitToken
     = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->
               case ts of
               [] -> POk s Nothing
               (t : ts') -> POk (s {alr_pending_implicit_tokens = ts'}) (Just t)
 
-setPendingImplicitTokens :: [Located Token] -> P ()
+setPendingImplicitTokens :: [RealLocated Token] -> P ()
 setPendingImplicitTokens ts = P $ \s -> POk (s {alr_pending_implicit_tokens = ts}) ()
 
 getAlrExpectingOCurly :: P (Maybe ALRLayout)
@@ -1844,20 +1850,20 @@ nondecreasingIndentation flags = testBit flags nondecreasingIndentationBit
 
 -- PState for parsing options pragmas
 --
-pragState :: DynFlags -> StringBuffer -> SrcLoc -> PState
+pragState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
 pragState dynflags buf loc = (mkPState dynflags buf loc) {
                                  lex_state = [bol, option_prags, 0]
                              }
 
 -- create a parse state
 --
-mkPState :: DynFlags -> StringBuffer -> SrcLoc -> PState
+mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
 mkPState flags buf loc =
   PState {
       buffer        = buf,
       dflags        = flags,
       messages      = emptyMessages,
-      last_loc      = mkSrcSpan loc loc,
+      last_loc      = mkRealSrcSpan loc loc,
       last_len      = 0,
       loc           = loc,
       extsBitmap    = fromIntegral bitmap,
@@ -1865,7 +1871,7 @@ mkPState flags buf loc =
       lex_state     = [bol, 0],
       alr_pending_implicit_tokens = [],
       alr_next_token = Nothing,
-      alr_last_loc = noSrcSpan,
+      alr_last_loc = alrInitialLoc (fsLit "<no file>"),
       alr_context = [],
       alr_expecting_ocurly = Nothing,
       alr_justClosedExplicitLetBlock = False
@@ -1921,7 +1927,7 @@ popContext = P $ \ s@(PState{ buffer = buf, context = ctx,
                               last_len = len, last_loc = last_loc }) ->
   case ctx of
 	(_:tl) -> POk s{ context = tl } ()
-	[]     -> PFailed last_loc (srcParseErr buf len)
+	[]     -> PFailed (RealSrcSpan last_loc) (srcParseErr buf len)
 
 -- Push a new layout context at the indentation of the last token read.
 -- This is only used at the outer level of a module when the 'module'
@@ -1960,7 +1966,7 @@ srcParseErr buf len
 srcParseFail :: P a
 srcParseFail = P $ \PState{ buffer = buf, last_len = len, 	
 			    last_loc = last_loc } ->
-    PFailed last_loc (srcParseErr buf len)
+    PFailed (RealSrcSpan last_loc) (srcParseErr buf len)
 
 -- A lexical error is reported at a particular position in the source file,
 -- not over a token range.
@@ -1978,11 +1984,11 @@ lexer :: (Located Token -> P a) -> P a
 lexer cont = do
   alr <- extension alternativeLayoutRule
   let lexTokenFun = if alr then lexTokenAlr else lexToken
-  tok@(L _span _tok__) <- lexTokenFun
-  --trace ("token: " ++ show _tok__) $ do
-  cont tok
+  (L span tok) <- lexTokenFun
+  --trace ("token: " ++ show tok) $ do
+  cont (L (RealSrcSpan span) tok)
 
-lexTokenAlr :: P (Located Token)
+lexTokenAlr :: P (RealLocated Token)
 lexTokenAlr = do mPending <- popPendingImplicitToken
                  t <- case mPending of
                       Nothing ->
@@ -2004,7 +2010,7 @@ lexTokenAlr = do mPending <- popPendingImplicitToken
                      _       -> return ()
                  return t
 
-alternativeLayoutRuleToken :: Located Token -> P (Located Token)
+alternativeLayoutRuleToken :: RealLocated Token -> P (RealLocated Token)
 alternativeLayoutRuleToken t
     = do context <- getALRContext
          lastLoc <- getAlrLastLoc
@@ -2015,8 +2021,7 @@ alternativeLayoutRuleToken t
          let transitional = xopt Opt_AlternativeLayoutRuleTransitional dflags
              thisLoc = getLoc t
              thisCol = srcSpanStartCol thisLoc
-             newLine = (lastLoc == noSrcSpan)
-                    || (srcSpanStartLine thisLoc > srcSpanEndLine lastLoc)
+             newLine = srcSpanStartLine thisLoc > srcSpanEndLine lastLoc
          case (unLoc t, context, mExpectingOCurly) of
              -- This case handles a GHC extension to the original H98
              -- layout rule...
@@ -2076,7 +2081,7 @@ alternativeLayoutRuleToken t
              (ITwhere, ALRLayout _ col : ls, _)
               | newLine && thisCol == col && transitional ->
                  do addWarning Opt_WarnAlternativeLayoutRuleTransitional
-                               thisLoc
+                               (RealSrcSpan thisLoc)
                                (transitionalAlternativeLayoutWarning
                                     "`where' clause at the same depth as implicit layout block")
                     setALRContext ls
@@ -2088,7 +2093,7 @@ alternativeLayoutRuleToken t
              (ITvbar, ALRLayout _ col : ls, _)
               | newLine && thisCol == col && transitional ->
                  do addWarning Opt_WarnAlternativeLayoutRuleTransitional
-                               thisLoc
+                               (RealSrcSpan thisLoc)
                                (transitionalAlternativeLayoutWarning
                                     "`|' at the same depth as implicit layout block")
                     setALRContext ls
@@ -2203,14 +2208,14 @@ topNoLayoutContainsCommas [] = False
 topNoLayoutContainsCommas (ALRLayout _ _ : ls) = topNoLayoutContainsCommas ls
 topNoLayoutContainsCommas (ALRNoLayout b _ : _) = b
 
-lexToken :: P (Located Token)
+lexToken :: P (RealLocated Token)
 lexToken = do
   inp@(AI loc1 buf) <- getInput
   sc <- getLexState
   exts <- getExts
   case alexScanUser exts inp sc of
     AlexEOF -> do
-        let span = mkSrcSpan loc1 loc1
+        let span = mkRealSrcSpan loc1 loc1
         setLastToken span 0
         return (L span ITeof)
     AlexError (AI loc2 buf) ->
@@ -2220,12 +2225,12 @@ lexToken = do
         lexToken
     AlexToken inp2@(AI end buf2) _ t -> do
         setInput inp2
-        let span = mkSrcSpan loc1 end
+        let span = mkRealSrcSpan loc1 end
         let bytes = byteDiff buf buf2
         span `seq` setLastToken span bytes
         t span buf bytes
 
-reportLexError :: SrcLoc -> SrcLoc -> StringBuffer -> [Char] -> P a
+reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> [Char] -> P a
 reportLexError loc1 loc2 buf str
   | atEnd buf = failLocMsgP loc1 loc2 (str ++ " at end of input")
   | otherwise =
@@ -2236,7 +2241,7 @@ reportLexError loc1 loc2 buf str
     then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)")
     else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)
 
-lexTokenStream :: StringBuffer -> SrcLoc -> DynFlags -> ParseResult [Located Token]
+lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
 lexTokenStream buf loc dflags = unP go initState
     where dflags' = dopt_set (dopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream
           initState = mkPState dflags' buf loc
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 102f989..01d768a 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -41,9 +41,7 @@ import ForeignCall	( Safety(..), CExportSpec(..), CLabelString,
 			)
 import OccName		( varName, dataName, tcClsName, tvName )
 import DataCon		( DataCon, dataConName )
-import SrcLoc		( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
-			  SrcSpan, combineLocs, srcLocFile, 
-			  mkSrcLoc, mkSrcSpan )
+import SrcLoc
 import Module
 import StaticFlags	( opt_SccProfilingOn, opt_Hpc )
 import Type		( Kind, liftedTypeKind, unliftedTypeKind )
@@ -1262,7 +1260,7 @@ quasiquote :: { Located (HsQuasiQuote RdrName) }
 	: TH_QUASIQUOTE   { let { loc = getLoc $1
                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
                                 ; quoterId = mkUnqual varName quoter }
-                            in L1 (mkHsQuasiQuote quoterId quoteSpan quote) }
+                            in L1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
 exp   :: { LHsExpr RdrName }
 	: infixexp '::' sigtype		{ LL $ ExprWithTySig $1 $3 }
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index c4ad95a..b333373 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -1053,7 +1053,11 @@ unknownNameSuggestErr where_look tried_rdr_name
   where
     pp_item :: (RdrName, HowInScope) -> SDoc
     pp_item (rdr, Left loc) = quotes (ppr rdr) <+>   -- Locally defined
-                              parens (ptext (sLit "line") <+> int (srcSpanStartLine loc))
+                              parens (ptext (sLit "line") <+> int (srcSpanStartLine loc'))
+        where loc' = case loc of
+                     UnhelpfulSpan _ ->
+                         panic "unknownNameSuggestErr UnhelpfulSpan"
+                     RealSrcSpan l -> l
     pp_item (rdr, Right is) = quotes (ppr rdr) <+>   -- Imported
                               parens (ptext (sLit "imported from") <+> ppr (is_mod is))
 
diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs
index beb45bb..9e53f49 100644
--- a/compiler/rename/RnHsDoc.hs
+++ b/compiler/rename/RnHsDoc.hs
@@ -3,7 +3,7 @@ module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where
 
 import TcRnTypes
 import HsSyn
-import SrcLoc      ( Located(..) )
+import SrcLoc
 
 
 rnMbLHsDoc :: Maybe LHsDocString -> RnM (Maybe LHsDocString)
diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs
index 478ba32..bfbcdc5 100644
--- a/compiler/rename/RnHsSyn.lhs
+++ b/compiler/rename/RnHsSyn.lhs
@@ -22,7 +22,7 @@ import TysWiredIn       ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
 import Name             ( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes       ( Boxity )
-import SrcLoc           ( Located(..), unLoc )
+import SrcLoc
 \end{code}
 
 %************************************************************************
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 46058c4..3867e17 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -1256,7 +1256,9 @@ warnUnusedImportDecls gbl_env
        ; ifDOptM Opt_D_dump_minimal_imports $
          printMinimalImports usage }
   where
-    explicit_import (L loc _) = isGoodSrcSpan loc
+    explicit_import (L loc _) = case loc of
+                                UnhelpfulSpan _ -> False
+                                RealSrcSpan _ -> True
         -- Filter out the implicit Prelude import
         -- which we do not want to bleat about
 \end{code}
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 7e7f117..46624c5 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 3cc2eb5..6da5741 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
 
diff --git a/ghc/GhciTags.hs b/ghc/GhciTags.hs
index fc5cf00..ffec5be 100644
--- a/ghc/GhciTags.hs
+++ b/ghc/GhciTags.hs
@@ -18,6 +18,7 @@ import GHC
 import GhciMonad
 import Outputable
 import Util
+import SrcLoc
 
 -- ToDo: figure out whether we need these, and put something appropriate
 -- into the GHC API instead
@@ -91,13 +92,13 @@ listModuleTags m = do
        let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
        let localNames = filter ((m==) . nameModule) names
        mbTyThings <- mapM GHC.lookupName localNames
-       return $! [ tagInfo unqual exported kind name loc
+       return $! [ tagInfo unqual exported kind name realLoc
                      | tyThing <- catMaybes mbTyThings
                      , let name = getName tyThing
                      , let exported = GHC.modInfoIsExportedName mInfo name
                      , let kind = tyThing2TagKind tyThing
                      , let loc = srcSpanStart (nameSrcSpan name)
-                     , isGoodSrcLoc loc
+                     , RealSrcLoc realLoc <- [loc]
                      ]
 
   where
@@ -120,7 +121,7 @@ data TagInfo = TagInfo
 
 
 -- get tag info, for later translation into Vim or Emacs style
-tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> SrcLoc -> TagInfo
+tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc -> TagInfo
 tagInfo unqual exported kind name loc
     = TagInfo exported kind
         (showSDocForUser unqual $ pprOccName (nameOccName name))
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 757b634..884059a 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -687,7 +687,7 @@ checkInputForLayout stmt getStmt = do
    let dflags = xopt_set dflags' Opt_AlternativeLayoutRule
    st <- lift $ getGHCiState
    let buf =  stringToStringBuffer stmt
-       loc  = mkSrcLoc (fsLit (progname st)) (line_number st) 1
+       loc  = mkRealSrcLoc (fsLit (progname st)) (line_number st) 1
        pstate = Lexer.mkPState dflags buf loc
    case Lexer.unP goToEnd pstate of
      (Lexer.POk _ False) -> return $ Just stmt
@@ -2061,12 +2061,15 @@ stepModuleCmd expression = stepCmd expression
 
 -- | Returns the span of the largest tick containing the srcspan given
 enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
-enclosingTickSpan mod src = do
+enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+enclosingTickSpan mod (RealSrcSpan src) = do
   ticks <- getTickArray mod
   let line = srcSpanStartLine src
   ASSERT (inRange (bounds ticks) line) do
-  let enclosing_spans = [ span | (_,span) <- ticks ! line
-                               , srcSpanEnd span >= srcSpanEnd src]
+  let toRealSrcSpan (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+      toRealSrcSpan (RealSrcSpan s) = s
+      enclosing_spans = [ span | (_,span) <- ticks ! line
+                               , realSrcSpanEnd (toRealSrcSpan span) >= realSrcSpanEnd src]
   return . head . sortBy leftmost_largest $ enclosing_spans
 
 traceCmd :: String -> GHCi ()
@@ -2178,13 +2181,15 @@ breakSwitch (arg1:rest)
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
-        if GHC.isGoodSrcLoc loc
-               then ASSERT( isExternalName name ) 
+        case loc of
+            RealSrcLoc l ->
+               ASSERT( isExternalName name ) 
 	       	    findBreakAndSet (GHC.nameModule name) $ 
-                         findBreakByCoord (Just (GHC.srcLocFile loc))
-                                          (GHC.srcLocLine loc, 
-                                           GHC.srcLocCol loc)
-               else noCanDo name $ text "can't find its location: " <> ppr loc
+                         findBreakByCoord (Just (GHC.srcLocFile l))
+                                          (GHC.srcLocLine l, 
+                                           GHC.srcLocCol l)
+            UnhelpfulLoc _ ->
+                noCanDo name $ text "can't find its location: " <> ppr loc
        where
           noCanDo n why = printForUser $
                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
@@ -2249,10 +2254,12 @@ findBreakByLine line arr
         ticks = arr ! line
 
         starts_here = [ tick | tick@(_,span) <- ticks,
-                               GHC.srcSpanStartLine span == line ]
+                               GHC.srcSpanStartLine (toRealSpan span) == line ]
 
         (complete,incomplete) = partition ends_here starts_here
-            where ends_here (_,span) = GHC.srcSpanEndLine span == line
+            where ends_here (_,span) = GHC.srcSpanEndLine (toRealSpan span) == line
+        toRealSpan (RealSrcSpan span) = span
+        toRealSpan (UnhelpfulSpan _) = panic "findBreakByLine UnhelpfulSpan"
 
 findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
                  -> Maybe (BreakIndex,SrcSpan)
@@ -2269,12 +2276,16 @@ findBreakByCoord mb_file (line, col) arr
                             is_correct_file span ]
 
         is_correct_file span
-                 | Just f <- mb_file = GHC.srcSpanFile span == f
+                 | Just f <- mb_file = GHC.srcSpanFile (toRealSpan span) == f
                  | otherwise         = True
 
         after_here = [ tick | tick@(_,span) <- ticks,
-                              GHC.srcSpanStartLine span == line,
-                              GHC.srcSpanStartCol span >= col ]
+                              let span' = toRealSpan span,
+                              GHC.srcSpanStartLine span' == line,
+                              GHC.srcSpanStartCol span' >= col ]
+
+        toRealSpan (RealSrcSpan span) = span
+        toRealSpan (UnhelpfulSpan _) = panic "findBreakByCoord UnhelpfulSpan"
 
 -- For now, use ANSI bold on terminals that we know support it.
 -- Otherwise, we add a line of carets under the active expression instead.
@@ -2300,9 +2311,9 @@ listCmd' "" = do
    case mb_span of
       Nothing ->
           printForUser $ text "Not stopped at a breakpoint; nothing to list"
-      Just span
-       | GHC.isGoodSrcSpan span -> listAround span True
-       | otherwise ->
+      Just (RealSrcSpan span) ->
+          listAround span True
+      Just span@(UnhelpfulSpan _) ->
           do resumes <- GHC.getResumeContext
              case resumes of
                  [] -> panic "No resumes"
@@ -2328,17 +2339,18 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
-        if GHC.isGoodSrcLoc loc
-               then do
-                  tickArray <- ASSERT( isExternalName name )
+        case loc of
+            RealSrcLoc l ->
+               do tickArray <- ASSERT( isExternalName name )
 		  	       lift $ getTickArray (GHC.nameModule name)
-                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
-                                        (GHC.srcLocLine loc, GHC.srcLocCol loc)
+                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile l))
+                                        (GHC.srcLocLine l, GHC.srcLocCol l)
                                         tickArray
                   case mb_span of
-                    Nothing       -> listAround (GHC.srcLocSpan loc) False
-                    Just (_,span) -> listAround span False
-               else
+                    Nothing       -> listAround (realSrcLocSpan l) False
+                    Just (_, UnhelpfulSpan _) -> panic "list2 UnhelpfulSpan"
+                    Just (_, RealSrcSpan span) -> listAround span False
+            UnhelpfulLoc _ ->
                   noCanDo name $ text "can't find its location: " <>
                                  ppr loc
     where
@@ -2355,8 +2367,8 @@ listModuleLine modl line = do
      [] -> panic "listModuleLine"
      summ:_ -> do
            let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
-               loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
-           listAround (GHC.srcLocSpan loc) False
+               loc = mkRealSrcLoc (mkFastString (filename)) line 0
+           listAround (realSrcLocSpan loc) False
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using
@@ -2367,7 +2379,7 @@ listModuleLine modl line = do
 -- 2) convert the BS to String using utf-string, and write it out.
 -- It would be better if we could convert directly between UTF-8 and the
 -- console encoding, of course.
-listAround :: MonadIO m => SrcSpan -> Bool -> InputT m ()
+listAround :: MonadIO m => RealSrcSpan -> Bool -> InputT m ()
 listAround span do_highlight = do
       contents <- liftIO $ BS.readFile (unpackFS file)
       let 
@@ -2454,11 +2466,14 @@ mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
 mkTickArray ticks
   = accumArray (flip (:)) [] (1, max_line) 
         [ (line, (nm,span)) | (nm,span) <- ticks,
-                              line <- srcSpanLines span ]
+                              let span' = toRealSpan span,
+                              line <- srcSpanLines span' ]
     where
-        max_line = foldr max 0 (map GHC.srcSpanEndLine (map snd ticks))
+        max_line = foldr max 0 (map (GHC.srcSpanEndLine . toRealSpan . snd) ticks)
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
+        toRealSpan (RealSrcSpan span) = span
+        toRealSpan (UnhelpfulSpan _) = panic "mkTickArray UnhelpfulSpan"
 
 lookupModule :: GHC.GhcMonad m => String -> m Module
 lookupModule modName
@@ -2500,3 +2515,4 @@ setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.setBreakOff array index
+