From: simonmar Date: Mon, 13 Jun 2005 14:12:59 +0000 (+0000) Subject: [project @ 2005-06-13 14:12:59 by simonmar] X-Git-Tag: Initial_conversion_from_CVS_complete~434 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f96c7c1a9b509839a452815aa678a66c62a3cfc5;p=ghc-hetmet.git [project @ 2005-06-13 14:12:59 by simonmar] Implement :tags command Patch supplied by Claus Reinke, with some modifications by me. Ideally we'd like this to be a command line option too, and we'd like to drop the restriction that all the source files must be interpreted, but that needs some work elsewhere (interface files have to store definition source locations). --- diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index b33bd95..5f74551 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -22,6 +22,12 @@ import GHC ( Session, verbosity, dopt, DynFlag(..), CheckedModule(..) ) import Outputable +-- for createtags (should these come via GHC?) +import Module( moduleUserString ) +import Name( nameSrcLoc, nameModule, nameOccName ) +import OccName( pprOccName ) +import SrcLoc( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol ) + -- following all needed for :info... ToDo: remove import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..), IfaceConDecl(..), IfaceType, @@ -38,11 +44,10 @@ import Config import StaticFlags ( opt_IgnoreDotGhci ) import Linker ( showLinkerState ) import Util ( removeSpaces, handle, global, toArgs, - looksLikeModuleName, prefixMatch ) + looksLikeModuleName, prefixMatch, sortLe ) import ErrUtils ( printErrorsAndWarnings ) #ifndef mingw32_HOST_OS -import Util ( handle ) import System.Posix #if __GLASGOW_HASKELL__ > 504 hiding (getEnv) @@ -110,6 +115,7 @@ builtin_commands = [ ("check", keepGoing checkModule), ("set", keepGoing setCmd), ("show", keepGoing showCmd), + ("tags", keepGoing createTagsFileCmd), ("type", keepGoing typeOfExpr), ("kind", keepGoing kindOfType), ("unset", keepGoing unsetOptions), @@ -147,6 +153,7 @@ helpText = " :show modules show the currently loaded modules\n" ++ " :show bindings show the current bindings made at the prompt\n" ++ "\n" ++ + " :tags -e|-c create tags file for Vi (-c) or Emacs (-e)\n" ++ " :type show the type of \n" ++ " :kind show the kind of \n" ++ " :undef undefine user-defined command :\n" ++ @@ -476,9 +483,6 @@ specialCommand str = do foldr1 (\a b -> a ++ ',':b) (map fst cs) ++ ")") >> return False) -noArgs c = throwDyn (CmdLineError ("command '" ++ c ++ "' takes no arguments")) - - ----------------------------------------------------------------------------- -- To flush buffers for the *interpreted* computation we need -- to refer to *its* stdout/stderr handles @@ -840,6 +844,114 @@ shellEscape :: String -> GHCi Bool shellEscape str = io (system str >> return False) ----------------------------------------------------------------------------- +-- create tags file for currently loaded modules. + +createTagsFileCmd :: String -> GHCi () +createTagsFileCmd "-c" = ghciCreateTagsFile CTags "tags" +createTagsFileCmd "-e" = ghciCreateTagsFile ETags "TAGS" +createTagsFileCmd _ = throwDyn (CmdLineError "syntax: :tags -c|-e") + +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 '" ++ moduleUserString 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 ()