Commit 1004a5a3 authored by simonpj's avatar simonpj
Browse files

[project @ 2004-07-21 10:07:29 by simonpj]

Add location information to :i command
parent 10ab808b
......@@ -95,6 +95,7 @@ import BasicTypes ( Fixity )
import Linker ( HValue, unload, extendLinkEnv )
import GHC.Exts ( unsafeCoerce# )
import Foreign
import SrcLoc ( SrcLoc )
import Control.Exception as Exception ( Exception, try )
#endif
......@@ -219,7 +220,7 @@ cmSetDFlags cm_state dflags
-- A string may refer to more than one TyThing (eg. a constructor,
-- and type constructor), so we return a list of all the possible TyThings.
cmInfoThing :: CmState -> String -> IO [(IfaceDecl,Fixity)]
cmInfoThing :: CmState -> String -> IO [(IfaceDecl,Fixity,SrcLoc)]
cmInfoThing cmstate id
= hscThing (cm_hsc cmstate) (cm_ic cmstate) id
......
{-# OPTIONS -#include "Linker.h" #-}
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.167 2004/07/21 09:25:42 simonpj Exp $
-- $Id: InteractiveUI.hs,v 1.168 2004/07/21 10:07:33 simonpj Exp $
--
-- GHC Interactive User Interface
--
......@@ -37,6 +37,7 @@ import CmdLineOpts ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
restoreDynFlags, dopt_unset )
import Panic hiding ( showException )
import Config
import SrcLoc ( SrcLoc, isGoodSrcLoc )
#ifndef mingw32_HOST_OS
import DriverUtil( handle )
......@@ -481,15 +482,20 @@ info s = do { let names = words s
; io (putStrLn (showSDocForUser (cmGetPrintUnqual cms) $
vcat (intersperse (text "") (map (showThing name) stuff)))) }
showThing :: String -> (IfaceDecl, Fixity) -> SDoc
showThing name (thing, fixity)
showThing :: String -> (IfaceDecl, Fixity, SrcLoc) -> SDoc
showThing name (thing, fixity, src_loc)
= vcat [ showDecl (\occ -> name == occNameUserString occ) thing,
showFixity fixity ]
showFixity fixity,
showLoc src_loc]
where
showFixity fix
| fix == defaultFixity = empty
| otherwise = ppr fix <+> text name
showLoc loc -- The ppr function for SrcLocs is a bit wonky
| isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
| otherwise = ppr loc
-- Now there is rather a lot of goop just to print declarations in a civilised way
-- with "..." for the parts we are less interested in.
......@@ -560,16 +566,6 @@ ppr_bndr :: OccName -> SDoc
ppr_bndr occ | isSymOcc occ = parens (ppr occ)
| otherwise = ppr occ
{-
-- also print out the source location for home things
showSrcLoc name
| isHomePackageName name && isGoodSrcLoc loc
= hsep [ text ", defined at", ppr loc ]
| otherwise
= empty
where loc = nameSrcLoc name
-}
-----------------------------------------------------------------------------
-- Commands
......
......@@ -29,7 +29,7 @@ import RdrName ( RdrName )
import Type ( Type )
import PrelNames ( iNTERACTIVE )
import StringBuffer ( stringToStringBuffer )
import SrcLoc ( noSrcLoc, Located(..) )
import SrcLoc ( SrcLoc, noSrcLoc, Located(..) )
import Kind ( Kind )
import Var ( Id )
import CoreLint ( lintUnfolding )
......@@ -631,7 +631,7 @@ hscThing -- like hscStmt, but deals with a single identifier
:: HscEnv
-> InteractiveContext -- Context for compiling
-> String -- The identifier
-> IO [(IfaceDecl, Fixity)]
-> IO [(IfaceDecl, Fixity, SrcLoc)]
hscThing hsc_env ic str
= do maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
......
......@@ -56,10 +56,10 @@ import Id ( mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
import Module ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
import OccName ( mkVarOcc )
import Name ( Name, isExternalName, getSrcLoc, getOccName )
import Name ( Name, isExternalName, getSrcLoc, getOccName, nameSrcLoc )
import NameSet
import TyCon ( tyConHasGenerics )
import SrcLoc ( srcLocSpan, Located(..), noLoc )
import SrcLoc ( SrcLoc, srcLocSpan, Located(..), noLoc )
import Outputable
import HscTypes ( ModGuts(..), HscEnv(..),
GhciMode(..), Dependencies(..), noDependencies,
......@@ -461,7 +461,7 @@ tcRnType hsc_env ictxt rdr_type
tcRnThing :: HscEnv
-> InteractiveContext
-> RdrName
-> IO (Maybe [(IfaceDecl, Fixity)])
-> IO (Maybe [(IfaceDecl, Fixity, SrcLoc)])
-- Look up a RdrName and return all the TyThings it might be
-- A capitalised RdrName is given to us in the DataName namespace,
-- but we want to treat it as *both* a data constructor
......@@ -501,8 +501,11 @@ tcRnThing hsc_env ictxt rdr_name
let { do_one name = do { thing <- tcLookupGlobal name
; let decl = toIfaceDecl ictxt thing
; fixity <- lookupFixityRn name
; return (decl, fixity) } ;
cmp (d1,_) (d2,_) = ifName d1 `compare` ifName d2 } ;
; return (decl, fixity, getSrcLoc thing) } ;
-- For the SrcLoc, the 'thing' has better info than
-- the 'name' because getting the former forced the
-- declaration to be loaded into the cache
cmp (d1,_,_) (d2,_,_) = ifName d1 `compare` ifName d2 } ;
results <- mapM do_one good_names ;
return (fst (removeDups cmp results))
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment