Store a SrcSpan instead of a SrcLoc inside a Name

This has been a long-standing ToDo.

compiler/basicTypes/Id.lhs

@@ -154,7 +154,7 @@ mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
 
 
 -- UserLocal: an Id with a name the user might recognize...
-mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
+mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
 
 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
@@ -175,7 +175,7 @@ mkWorkerId :: Unique -> Id -> Type -> Id
 mkWorkerId uniq unwrkr ty
   = mkLocalId wkr_name ty
   where
-    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
+    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr)
 
 -- "Template locals" typically used in unfoldings
 mkTemplateLocals :: [Type] -> [Id]

compiler/basicTypes/Name.lhs

@@ -23,7 +23,7 @@ module Name (
 	tidyNameOcc, 
 	hashName, localiseName,
 
-	nameSrcLoc,
+	nameSrcLoc, nameSrcSpan,
 
 	isSystemName, isInternalName, isExternalName,
 	isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
@@ -32,7 +32,7 @@ module Name (
 	
 	-- Class NamedThing and overloaded friends
 	NamedThing(..),
-	getSrcLoc, getOccString
+	getSrcLoc, getSrcSpan, getOccString
     ) where
 
 #include "HsVersions.h"
@@ -66,7 +66,7 @@ data Name = Name {
 		n_sort :: NameSort,	-- What sort of name it is
 		n_occ  :: !OccName,	-- Its occurrence name
 		n_uniq :: Int#,         -- UNPACK doesn't work, recursive type
-		n_loc  :: !SrcLoc	-- Definition site
+		n_loc  :: !SrcSpan	-- Definition site
 	    }
 
 -- NOTE: we make the n_loc field strict to eliminate some potential
@@ -127,10 +127,12 @@ nameUnique		:: Name -> Unique
 nameOccName		:: Name -> OccName 
 nameModule		:: Name -> Module
 nameSrcLoc		:: Name -> SrcLoc
+nameSrcSpan		:: Name -> SrcSpan
 
 nameUnique  name = mkUniqueGrimily (I# (n_uniq name))
 nameOccName name = n_occ  name
-nameSrcLoc  name = n_loc  name
+nameSrcLoc  name = srcSpanStart (n_loc name)
+nameSrcSpan name = n_loc  name
 \end{code}
 
 \begin{code}
@@ -183,7 +185,7 @@ isSystemName other		      = False
 %************************************************************************
 
 \begin{code}
-mkInternalName :: Unique -> OccName -> SrcLoc -> Name
+mkInternalName :: Unique -> OccName -> SrcSpan -> Name
 mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
 	-- NB: You might worry that after lots of huffing and
 	-- puffing we might end up with two local names with distinct
@@ -194,7 +196,7 @@ mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n
 	--	* for interface files we tidyCore first, which puts the uniques
 	--	  into the print name (see setNameVisibility below)
 
-mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name
+mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
 mkExternalName uniq mod occ loc 
   = Name { n_uniq = getKey# uniq, n_sort = External mod,
            n_occ = occ, n_loc = loc }
@@ -204,11 +206,11 @@ mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax
 mkWiredInName mod occ uniq thing built_in
   = Name { n_uniq = getKey# uniq,
 	   n_sort = WiredIn mod thing built_in,
-	   n_occ = occ, n_loc = wiredInSrcLoc }
+	   n_occ = occ, n_loc = wiredInSrcSpan }
 
 mkSystemName :: Unique -> OccName -> Name
 mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System, 
-			       n_occ = occ, n_loc = noSrcLoc }
+			       n_occ = occ, n_loc = noSrcSpan }
 
 mkSystemVarName :: Unique -> FastString -> Name
 mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
@@ -219,19 +221,19 @@ mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
 mkFCallName :: Unique -> String -> Name
 	-- The encoded string completely describes the ccall
 mkFCallName uniq str =  Name { n_uniq = getKey# uniq, n_sort = Internal, 
-			       n_occ = mkVarOcc str, n_loc = noSrcLoc }
+			       n_occ = mkVarOcc str, n_loc = noSrcSpan }
 
 mkTickBoxOpName :: Unique -> String -> Name
 mkTickBoxOpName uniq str 
    = Name { n_uniq = getKey# uniq, n_sort = Internal, 
-	    n_occ = mkVarOcc str, n_loc = noSrcLoc }
+	    n_occ = mkVarOcc str, n_loc = noSrcSpan }
 
 mkIPName :: Unique -> OccName -> Name
 mkIPName uniq occ
   = Name { n_uniq = getKey# uniq,
 	   n_sort = Internal,
 	   n_occ  = occ,
-	   n_loc = noSrcLoc }
+	   n_loc = noSrcSpan }
 \end{code}
 
 \begin{code}
@@ -406,9 +408,11 @@ class NamedThing a where
 
 \begin{code}
 getSrcLoc	    :: NamedThing a => a -> SrcLoc
+getSrcSpan	    :: NamedThing a => a -> SrcSpan
 getOccString	    :: NamedThing a => a -> String
 
 getSrcLoc	    = nameSrcLoc	   . getName
+getSrcSpan	    = nameSrcSpan	   . getName
 getOccString 	    = occNameString	   . getOccName
 \end{code}
 

compiler/basicTypes/SrcLoc.lhs

@@ -11,7 +11,6 @@ module SrcLoc (
 	advanceSrcLoc,
 
 	importedSrcLoc,		-- Unknown place in an interface
-	wiredInSrcLoc,		-- Something wired into the compiler
 	generatedSrcLoc,	-- Code generated within the compiler
 	interactiveSrcLoc,	-- Code from an interactive session
 
@@ -22,6 +21,8 @@ module SrcLoc (
 
 	SrcSpan,		-- Abstract
 	noSrcSpan, 
+	wiredInSrcSpan,		-- Something wired into the compiler
+	importedSrcSpan,	-- Unknown place in an interface
 	mkGeneralSrcSpan, 
 	isGoodSrcSpan, isOneLineSpan,
 	mkSrcSpan, srcLocSpan,
@@ -60,7 +61,7 @@ data SrcLoc
 		-- Don't ask me why lines start at 1 and columns start at
 		-- zero.  That's just the way it is, so there.  --SDM
 
-  | ImportedLoc	String		-- Module name
+  | ImportedLoc	FastString	-- Module name
 
   | UnhelpfulLoc FastString	-- Just a general indication
 \end{code}
@@ -81,13 +82,12 @@ Things to make 'em:
 mkSrcLoc x line col = SrcLoc x line col
 noSrcLoc	  = UnhelpfulLoc FSLIT("<no location info>")
 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
-wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
 
 mkGeneralSrcLoc :: FastString -> SrcLoc
 mkGeneralSrcLoc = UnhelpfulLoc 
 
-importedSrcLoc :: String -> SrcLoc
+importedSrcLoc :: FastString -> SrcLoc
 importedSrcLoc mod_name = ImportedLoc mod_name
 
 isGoodSrcLoc (SrcLoc _ _ _) = True
@@ -150,7 +150,7 @@ instance Outputable SrcLoc where
 	   hcat [text "{-# LINE ", int src_line, space,
 		 char '\"', ftext src_path, text " #-}"]
 
-    ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> text mod
+    ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod
     ppr (UnhelpfulLoc s)  = ftext s
 \end{code}
 
@@ -193,7 +193,7 @@ data SrcSpan
 	  srcSpanCol      :: !Int
 	}
 
-  | ImportedSpan String		-- Module name
+  | ImportedSpan FastString	-- Module name
 
   | UnhelpfulSpan FastString	-- Just a general indication
 				-- also used to indicate an empty span
@@ -206,7 +206,9 @@ instance Ord SrcSpan where
      (srcSpanStart a `compare` srcSpanStart b) `thenCmp` 
      (srcSpanEnd   a `compare` srcSpanEnd   b)
 
-noSrcSpan  = UnhelpfulSpan FSLIT("<no location info>")
+noSrcSpan      = UnhelpfulSpan FSLIT("<no location info>")
+wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
+importedSrcSpan = ImportedSpan
 
 mkGeneralSrcSpan :: FastString -> SrcSpan
 mkGeneralSrcSpan = UnhelpfulSpan
@@ -306,11 +308,11 @@ combineSrcSpans	start end
 	col2  = srcSpanEndCol end
 	file  = srcSpanFile start
 
-pprDefnLoc :: SrcLoc -> SDoc
+pprDefnLoc :: SrcSpan -> SDoc
 -- "defined at ..." or "imported from ..."
 pprDefnLoc loc
-  | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
-  | otherwise	     = ppr loc
+  | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
+  | otherwise	      = ppr loc
 
 instance Outputable SrcSpan where
     ppr span
@@ -347,7 +349,7 @@ pprUserSpan (SrcSpanPoint src_path line col)
 	   char ':', int col
 	 ]
 
-pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> text mod
+pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod
 pprUserSpan (UnhelpfulSpan s)  = ftext s
 \end{code}
 

compiler/codeGen/CodeGen.lhs

@@ -350,7 +350,7 @@ maybeExternaliseId dflags id
     name    = idName id
     uniq    = nameUnique name
     new_occ = mkLocalOcc uniq (nameOccName name)
-    loc     = nameSrcLoc name
+    loc     = nameSrcSpan name
 	-- We want to conjure up a name that can't clash with any
 	-- existing name.  So we generate
 	--	Mod_$L243foo

compiler/coreSyn/CoreTidy.lhs

@@ -176,7 +176,7 @@ tidyIdBndr env@(tidy_env, var_env) id
 	-- which should save some space.
 	-- But note that tidyLetBndr puts some of it back.
         ty'          	  = tidyType env (idType id)
-	id'          	  = mkUserLocal occ' (idUnique id) ty' noSrcLoc
+	id'          	  = mkUserLocal occ' (idUnique id) ty' noSrcSpan
 				`setIdInfo` vanillaIdInfo
 	var_env'	  = extendVarEnv var_env id id'
     in

compiler/coreSyn/CoreUtils.lhs

@@ -734,7 +734,7 @@ dataConInstPat arg_fun fss uniqs con inst_tys
          co_kind  = substTy subst (mkPredTy eq_pred)
 
       -- make value vars, instantiating types
-    mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrcLoc
+    mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrcSpan
     id_bndrs = zipWith3 mk_id_var id_uniqs id_fss arg_tys
 
 exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])

compiler/deSugar/Check.lhs

@@ -378,7 +378,7 @@ make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
 
 hash_x = mkInternalName unboundKey {- doesn't matter much -}
 		     (mkVarOccFS FSLIT("#x"))
-		     noSrcLoc
+		     noSrcSpan
 
 make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
 make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats}) 

compiler/deSugar/DsUtils.lhs

@@ -948,7 +948,7 @@ mkTickBox ix vars e = do
                 | otherwise = mkBreakPointOpId uq mod ix
        uq2 <- newUnique 	
        let occName = mkVarOcc "tick"
-       let name = mkInternalName uq2 occName noSrcLoc   -- use mkSysLocal?
+       let name = mkInternalName uq2 occName noSrcSpan   -- use mkSysLocal?
        let var  = Id.mkLocalId name realWorldStatePrimTy
        scrut <- 
           if opt_Hpc 

compiler/ghci/Debugger.hs

@@ -203,7 +203,7 @@ newGrimName cms userName  = do
     us <- mkSplitUniqSupply 'b'
     let unique  = uniqFromSupply us
         occname = mkOccName varName userName
-        name    = mkInternalName unique occname noSrcLoc
+        name    = mkInternalName unique occname noSrcSpan
     return name
 
 skolemSubst subst = subst `setTvSubstEnv` 

compiler/ghci/GhciTags.hs

@@ -81,7 +81,7 @@ listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
 listTags unqual modInfo =
 	   [ tagInfo unqual name loc 
            | name <- GHC.modInfoExports modInfo
-           , let loc = nameSrcLoc name
+           , let loc = srcSpanStart (nameSrcSpan name)
            , isGoodSrcLoc loc
            ]
 

compiler/ghci/InteractiveUI.hs

@@ -1556,7 +1556,7 @@ breakSwitch session args@(arg1:rest)
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))
@@ -1678,7 +1678,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
         listModuleLine mod (read arg2)
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do
-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then do
                   tickArray <- getTickArray (GHC.nameModule name)

compiler/hsSyn/Convert.lhs

@@ -573,7 +573,7 @@ thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
 -- 
 -- The strict applications ensure that any buried exceptions get forced
 thRdrName ctxt_ns occ (TH.NameG th_ns pkg mod) = (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! (mk_occ (mk_ghc_ns th_ns) occ)
-thRdrName ctxt_ns occ (TH.NameL uniq)      = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrcLoc)
+thRdrName ctxt_ns occ (TH.NameL uniq)      = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrcSpan)
 thRdrName ctxt_ns occ (TH.NameQ mod)       = (mkRdrQual  $! (mk_mod mod)) $! (mk_occ ctxt_ns occ)
 thRdrName ctxt_ns occ (TH.NameU uniq)      = mkRdrUnqual $! (mk_uniq_occ ctxt_ns occ uniq)
 thRdrName ctxt_ns occ TH.NameS

compiler/iface/BinIface.hs

@@ -216,7 +216,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) =
         let 
                 us        = nsUniqs nc
                 uniq      = uniqFromSupply us
-                name      = mkExternalName uniq mod occ noSrcLoc
+                name      = mkExternalName uniq mod occ noSrcSpan
                 new_cache = extendNameCache cache mod occ name
         in        
         case splitUniqSupply us of { (us',_) -> 

compiler/iface/IfaceEnv.lhs

@@ -46,7 +46,7 @@ import Outputable
 %*********************************************************
 
 \begin{code}
-newGlobalBinder :: Module -> OccName -> SrcLoc -> TcRnIf a b Name
+newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
 -- Used for source code and interface files, to make the
 -- Name for a thing, given its Module and OccName
 --
@@ -66,7 +66,7 @@ newGlobalBinder mod occ loc
 
 allocateGlobalBinder
   :: NameCache 
-  -> Module -> OccName -> SrcLoc 
+  -> Module -> OccName -> SrcSpan
   -> (NameCache, Name)
 allocateGlobalBinder name_supply mod occ loc
   = case lookupOrigNameCache (nsNames name_supply) mod occ of
@@ -114,7 +114,7 @@ newImplicitBinder :: Name			-- Base name
 newImplicitBinder base_name mk_sys_occ
   = newGlobalBinder (nameModule base_name)
 		    (mk_sys_occ (nameOccName base_name))
-		    (nameSrcLoc base_name)    
+		    (nameSrcSpan base_name)    
 
 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
 ifaceExportNames exports = do
@@ -155,7 +155,7 @@ lookupOrig mod occ
               let
                 us        = nsUniqs name_cache
                 uniq      = uniqFromSupply us
-                name      = mkExternalName uniq mod occ noSrcLoc
+                name      = mkExternalName uniq mod occ noSrcSpan
                 new_cache = extendNameCache (nsNames name_cache) mod occ name
               in
               case splitUniqSupply us of { (us',_) -> do
@@ -292,11 +292,11 @@ lookupIfaceTop occ
 newIfaceName :: OccName -> IfL Name
 newIfaceName occ
   = do	{ uniq <- newUnique
-	; return $! mkInternalName uniq occ noSrcLoc }
+	; return $! mkInternalName uniq occ noSrcSpan }
 
 newIfaceNames :: [OccName] -> IfL [Name]
 newIfaceNames occs
   = do	{ uniqs <- newUniqueSupply
-	; return [ mkInternalName uniq occ noSrcLoc
+	; return [ mkInternalName uniq occ noSrcSpan
 		 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
 \end{code}

compiler/iface/LoadIface.lhs

@@ -367,8 +367,7 @@ loadDecl ignore_prags mod (_version, decl)
 	--	* location
 	-- imported name, to fix the module correctly in the cache
     mk_new_bndr mod occ 
-	= newGlobalBinder mod occ 
-			  (importedSrcLoc (showSDoc (ppr (moduleName mod))))
+	= newGlobalBinder mod occ (importedSrcSpan (moduleNameFS (moduleName mod)))
 			-- ToDo: qualify with the package name if necessary
 
     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)

compiler/iface/TcIface.lhs

@@ -1032,7 +1032,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
 newExtCoreBndr :: IfaceLetBndr -> IfL Id
 newExtCoreBndr (IfLetBndr var ty _)	-- Ignoring IdInfo for now
   = do	{ mod <- getIfModule
-	; name <- newGlobalBinder mod (mkVarOccFS var) noSrcLoc
+	; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
 	; ty' <- tcIfaceType ty
 	; return (mkLocalId name ty') }
 

compiler/main/GHC.hs

@@ -110,7 +110,7 @@ module GHC (
 
 	-- ** Names
 	Name, 
-	nameModule, pprParenSymName, nameSrcLoc,
+	nameModule, pprParenSymName, nameSrcSpan,
 	NamedThing(..),
 	RdrName(Qual,Unqual),
 	
@@ -175,7 +175,7 @@ module GHC (
         mkSrcLoc, isGoodSrcLoc,
 	srcLocFile, srcLocLine, srcLocCol,
         SrcSpan,
-        mkSrcSpan, srcLocSpan,
+        mkSrcSpan, srcLocSpan, isGoodSrcSpan,
         srcSpanStart, srcSpanEnd,
 	srcSpanFile, 
         srcSpanStartLine, srcSpanEndLine, 

compiler/main/InteractiveEval.hs

@@ -451,7 +451,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
    -- _result in scope at any time.
    let result_fs = FSLIT("_result")
        result_name = mkInternalName (getUnique result_fs)
-                          (mkVarOccFS result_fs) (srcSpanStart span)
+                          (mkVarOccFS result_fs) span
        result_id   = Id.mkLocalId result_name result_ty
 
    -- for each Id we're about to bind in the local envt:
@@ -478,7 +478,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
    mkNewId :: OccName -> Id -> IO Id
    mkNewId occ id = do
      let uniq = idUnique id
-         loc = nameSrcLoc (idName id)
+         loc = nameSrcSpan (idName id)
          name = mkInternalName uniq occ loc
          ty = idType id
          new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)

compiler/main/PprTyThing.hs

@@ -20,7 +20,7 @@ import qualified GHC
 
 import TyCon	( tyConFamInst_maybe )