From c5f6a3c65987b467cb64be30abd7a10ea6280b67 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 20 Apr 2007 10:25:36 +0000 Subject: [PATCH] split off :ctags and :etags support into a separate file --- compiler/ghci/GhciTags.hs | 138 ++++++++++++++++++++++++++++++++++ compiler/ghci/InteractiveUI.hs | 161 ++++++---------------------------------- 2 files changed, 160 insertions(+), 139 deletions(-) create mode 100644 compiler/ghci/GhciTags.hs diff --git a/compiler/ghci/GhciTags.hs b/compiler/ghci/GhciTags.hs new file mode 100644 index 0000000..686633e --- /dev/null +++ b/compiler/ghci/GhciTags.hs @@ -0,0 +1,138 @@ +----------------------------------------------------------------------------- +-- +-- GHCi's :ctags and :etags commands +-- +-- (c) The GHC Team 2005-2007 +-- +----------------------------------------------------------------------------- + +module GhciTags (createCTagsFileCmd, createETagsFileCmd) where + +import GHC +import GhciMonad +import Outputable +import Util + +-- ToDo: figure out whether we need these, and put something appropriate +-- into the GHC API instead +import Name (nameOccName) +import OccName (pprOccName) + +import Control.Exception +import Data.List +import Control.Monad +import System.IO +import System.IO.Error as IO + +----------------------------------------------------------------------------- +-- create tags file for currently loaded modules. + +createETagsFileCmd, createCTagsFileCmd :: String -> GHCi () + +createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags" +createCTagsFileCmd file = ghciCreateTagsFile CTags file + +createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS" +createETagsFileCmd file = ghciCreateTagsFile ETags file + +data TagsKind = ETags | CTags + +ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi () +ghciCreateTagsFile kind file = do + session <- getSession + io $ createTagsFile session kind file + +-- ToDo: +-- - remove restriction that all modules must be interpreted +-- (problem: we don't know source locations for entities unless +-- we compiled the module. +-- +-- - extract createTagsFile so it can be used from the command-line +-- (probably need to fix first problem before this is useful). +-- +createTagsFile :: Session -> TagsKind -> FilePath -> IO () +createTagsFile session tagskind tagFile = do + graph <- GHC.getModuleGraph session + let ms = map GHC.ms_mod graph + tagModule m = do + is_interpreted <- GHC.moduleIsInterpreted session m + -- should we just skip these? + when (not is_interpreted) $ + throwDyn (CmdLineError ("module '" + ++ GHC.moduleNameString (GHC.moduleName m) + ++ "' is not interpreted")) + mbModInfo <- GHC.getModuleInfo session m + let unqual + | Just modinfo <- mbModInfo, + Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual + | otherwise = GHC.alwaysQualify + + case mbModInfo of + Just modInfo -> return $! listTags unqual modInfo + _ -> return [] + + mtags <- mapM tagModule ms + either_res <- collateAndWriteTags tagskind tagFile $ concat mtags + case either_res of + Left e -> hPutStrLn stderr $ ioeGetErrorString e + Right _ -> return () + +listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo] +listTags unqual modInfo = + [ tagInfo unqual name loc + | name <- GHC.modInfoExports modInfo + , let loc = nameSrcLoc name + , isGoodSrcLoc loc + ] + +type TagInfo = (String -- tag name + ,String -- file name + ,Int -- line number + ,Int -- column number + ) + +-- get tag info, for later translation into Vim or Emacs style +tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo +tagInfo unqual name loc + = ( showSDocForUser unqual $ pprOccName (nameOccName name) + , showSDocForUser unqual $ ftext (srcLocFile loc) + , srcLocLine loc + , srcLocCol loc + ) + +collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ()) +collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al + let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos + IO.try (writeFile file tags) +collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs + let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2 + groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos + tagGroups <- mapM tagFileGroup groups + IO.try (writeFile file $ concat tagGroups) + where + tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??") + tagFileGroup group@((_,fileName,_,_):_) = do + file <- readFile fileName -- need to get additional info from sources.. + let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2 + sortedGroup = sortLe byLine group + tags = unlines $ perFile sortedGroup 1 0 $ lines file + return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags + perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count = + perFile (tagInfo:tags) (count+1) (pos+length line) lines + perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count = + showETag tagInfo line pos : perFile tags count pos lines + perFile tags count pos lines = [] + +-- simple ctags format, for Vim et al +showTag :: TagInfo -> String +showTag (tag,file,lineNo,colNo) + = tag ++ "\t" ++ file ++ "\t" ++ show lineNo + +-- etags format, for Emacs/XEmacs +showETag :: TagInfo -> String -> Int -> String +showETag (tag,file,lineNo,colNo) line charPos + = take colNo line ++ tag + ++ "\x7f" ++ tag + ++ "\x01" ++ show lineNo + ++ "," ++ show charPos + diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 133ee55..8066aa4 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -14,12 +14,13 @@ module InteractiveUI ( #include "HsVersions.h" import GhciMonad +import GhciTags -- The GHC interface import qualified GHC import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..), Type, Module, ModuleName, TyThing(..), Phase, - BreakIndex ) + BreakIndex, Name, SrcSpan ) import Debugger import DynFlags import Packages @@ -29,11 +30,6 @@ import PprTyThing import Outputable hiding (printForUser) import Module -- for ModuleEnv --- for createtags -import Name -import OccName -import SrcLoc - -- Other random utilities import Digraph import BasicTypes hiding (isTopLevel) @@ -630,9 +626,6 @@ pprInfo exts (thing, fixity, insts) | fix == GHC.defaultFixity = empty | otherwise = ppr fix <+> ppr (GHC.getName thing) ------------------------------------------------------------------------------ --- Commands - runMain :: String -> GHCi () runMain args = do let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args)) @@ -868,118 +861,6 @@ shellEscape :: String -> GHCi Bool shellEscape str = io (system str >> return False) ----------------------------------------------------------------------------- --- create tags file for currently loaded modules. - -createETagsFileCmd, createCTagsFileCmd :: String -> GHCi () - -createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags" -createCTagsFileCmd file = ghciCreateTagsFile CTags file - -createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS" -createETagsFileCmd file = ghciCreateTagsFile ETags file - -data TagsKind = ETags | CTags - -ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi () -ghciCreateTagsFile kind file = do - session <- getSession - io $ createTagsFile session kind file - --- ToDo: --- - remove restriction that all modules must be interpreted --- (problem: we don't know source locations for entities unless --- we compiled the module. --- --- - extract createTagsFile so it can be used from the command-line --- (probably need to fix first problem before this is useful). --- -createTagsFile :: Session -> TagsKind -> FilePath -> IO () -createTagsFile session tagskind tagFile = do - graph <- GHC.getModuleGraph session - let ms = map GHC.ms_mod graph - tagModule m = do - is_interpreted <- GHC.moduleIsInterpreted session m - -- should we just skip these? - when (not is_interpreted) $ - throwDyn (CmdLineError ("module '" - ++ GHC.moduleNameString (GHC.moduleName m) - ++ "' is not interpreted")) - mbModInfo <- GHC.getModuleInfo session m - let unqual - | Just modinfo <- mbModInfo, - Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual - | otherwise = GHC.alwaysQualify - - case mbModInfo of - Just modInfo -> return $! listTags unqual modInfo - _ -> return [] - - mtags <- mapM tagModule ms - either_res <- collateAndWriteTags tagskind tagFile $ concat mtags - case either_res of - Left e -> hPutStrLn stderr $ ioeGetErrorString e - Right _ -> return () - -listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo] -listTags unqual modInfo = - [ tagInfo unqual name loc - | name <- GHC.modInfoExports modInfo - , let loc = nameSrcLoc name - , isGoodSrcLoc loc - ] - -type TagInfo = (String -- tag name - ,String -- file name - ,Int -- line number - ,Int -- column number - ) - --- get tag info, for later translation into Vim or Emacs style -tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo -tagInfo unqual name loc - = ( showSDocForUser unqual $ pprOccName (nameOccName name) - , showSDocForUser unqual $ ftext (srcLocFile loc) - , srcLocLine loc - , srcLocCol loc - ) - -collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ()) -collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al - let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos - IO.try (writeFile file tags) -collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs - let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2 - groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos - tagGroups <- mapM tagFileGroup groups - IO.try (writeFile file $ concat tagGroups) - where - tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??") - tagFileGroup group@((_,fileName,_,_):_) = do - file <- readFile fileName -- need to get additional info from sources.. - let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2 - sortedGroup = sortLe byLine group - tags = unlines $ perFile sortedGroup 1 0 $ lines file - return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags - perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count = - perFile (tagInfo:tags) (count+1) (pos+length line) lines - perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count = - showETag tagInfo line pos : perFile tags count pos lines - perFile tags count pos lines = [] - --- simple ctags format, for Vim et al -showTag :: TagInfo -> String -showTag (tag,file,lineNo,colNo) - = tag ++ "\t" ++ file ++ "\t" ++ show lineNo - --- etags format, for Emacs/XEmacs -showETag :: TagInfo -> String -> Int -> String -showETag (tag,file,lineNo,colNo) line charPos - = take colNo line ++ tag - ++ "\x7f" ++ tag - ++ "\x01" ++ show lineNo - ++ "," ++ show charPos - ------------------------------------------------------------------------------ -- Browsing a module's contents browseCmd :: String -> GHCi () @@ -1544,16 +1425,17 @@ breakSwitch session args@(arg1:rest) case names of [] -> return () (n:_) -> do - let loc = nameSrcLoc n - modl = nameModule n + let loc = GHC.nameSrcLoc n + modl = GHC.nameModule n is_interpreted <- io (GHC.moduleIsInterpreted session modl) if not is_interpreted then noCanDo $ text "module " <> ppr modl <> text " is not interpreted" else do - if isGoodSrcLoc loc - then findBreakAndSet (nameModule n) $ - findBreakByCoord (srcLocLine loc, srcLocCol loc) + if GHC.isGoodSrcLoc loc + then findBreakAndSet (GHC.nameModule n) $ + findBreakByCoord (GHC.srcLocLine loc, + GHC.srcLocCol loc) else noCanDo $ text "can't find its location: " <> ppr loc where @@ -1625,10 +1507,10 @@ findBreakByLine line arr ticks = arr ! line starts_here = [ tick | tick@(nm,span) <- ticks, - srcSpanStartLine span == line ] + GHC.srcSpanStartLine span == line ] (complete,incomplete) = partition ends_here starts_here - where ends_here (nm,span) = srcSpanEndLine span == line + where ends_here (nm,span) = GHC.srcSpanEndLine span == line findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan) findBreakByCoord (line, col) arr @@ -1642,14 +1524,14 @@ findBreakByCoord (line, col) arr contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ] leftmost_smallest (_,a) (_,b) = a `compare` b -leftmost_largest (_,a) (_,b) = (srcSpanStart a `compare` srcSpanStart b) +leftmost_largest (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b) `thenCmp` - (srcSpanEnd b `compare` srcSpanEnd a) + (GHC.srcSpanEnd b `compare` GHC.srcSpanEnd a) rightmost (_,a) (_,b) = b `compare` a spans :: SrcSpan -> (Int,Int) -> Bool -spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span - where loc = mkSrcLoc (srcSpanFile span) l c +spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span + where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c start_bold = BS.pack "\ESC[1m" end_bold = BS.pack "\ESC[0m" @@ -1681,11 +1563,11 @@ listAround span do_highlight = do -- BS.putStrLn (BS.join (BS.pack "\n") prefixed) where - file = srcSpanFile span - line1 = srcSpanStartLine span - col1 = srcSpanStartCol span - line2 = srcSpanEndLine span - col2 = srcSpanEndCol span + file = GHC.srcSpanFile span + line1 = GHC.srcSpanStartLine span + col1 = GHC.srcSpanStartCol span + line2 = GHC.srcSpanEndLine span + col2 = GHC.srcSpanEndCol span pad_before | line1 == 1 = 0 | otherwise = 1 @@ -1731,8 +1613,9 @@ mkTickArray ticks [ (line, (nm,span)) | (nm,span) <- ticks, line <- srcSpanLines span ] where - max_line = maximum (map srcSpanEndLine (map snd ticks)) - srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ] + max_line = maximum (map GHC.srcSpanEndLine (map snd ticks)) + srcSpanLines span = [ GHC.srcSpanStartLine span .. + GHC.srcSpanEndLine span ] getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan) getModBreak mod = do -- 1.7.10.4