From b78303a8d1b21a562b344fd0c4754969948d2419 Mon Sep 17 00:00:00 2001 From: Peter Hercek Date: Mon, 17 Aug 2009 18:41:00 +0000 Subject: [PATCH] FIX #3434 (improve vi tags: add non-exported symbols, kinds, regex tags) --- ghc/GhciTags.hs | 197 +++++++++++++++++++++++++++++++++----------------- ghc/InteractiveUI.hs | 6 +- 2 files changed, 133 insertions(+), 70 deletions(-) diff --git a/ghc/GhciTags.hs b/ghc/GhciTags.hs index d5d40ad..c4b52f3 100644 --- a/ghc/GhciTags.hs +++ b/ghc/GhciTags.hs @@ -7,7 +7,11 @@ ----------------------------------------------------------------------------- {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -module GhciTags (createCTagsFileCmd, createETagsFileCmd) where +module GhciTags ( + createCTagsWithLineNumbersCmd, + createCTagsWithRegExesCmd, + createETagsFileCmd +) where import GHC import GhciMonad @@ -30,15 +34,23 @@ import System.IO.Error as IO ----------------------------------------------------------------------------- -- create tags file for currently loaded modules. -createETagsFileCmd, createCTagsFileCmd :: String -> GHCi () +createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd, + createETagsFileCmd :: String -> GHCi () -createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags" -createCTagsFileCmd file = ghciCreateTagsFile CTags file +createCTagsWithLineNumbersCmd "" = + ghciCreateTagsFile CTagsWithLineNumbers "tags" +createCTagsWithLineNumbersCmd file = + ghciCreateTagsFile CTagsWithLineNumbers file + +createCTagsWithRegExesCmd "" = + ghciCreateTagsFile CTagsWithRegExes "tags" +createCTagsWithRegExesCmd file = + ghciCreateTagsFile CTagsWithRegExes file createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS" createETagsFileCmd file = ghciCreateTagsFile ETags file -data TagsKind = ETags | CTags +data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi () ghciCreateTagsFile kind file = do @@ -53,89 +65,138 @@ ghciCreateTagsFile kind file = do -- (probably need to fix first problem before this is useful). -- createTagsFile :: TagsKind -> FilePath -> GHCi () -createTagsFile tagskind tagFile = do +createTagsFile tagskind tagsFile = do graph <- GHC.getModuleGraph - let ms = map GHC.ms_mod graph - tagModule m = do - is_interpreted <- GHC.moduleIsInterpreted m - -- should we just skip these? - when (not is_interpreted) $ - ghcError (CmdLineError ("module '" - ++ GHC.moduleNameString (GHC.moduleName m) - ++ "' is not interpreted")) - mbModInfo <- GHC.getModuleInfo m - unqual <- - case mbModInfo of - Just minf -> do - mb_print_unqual <- GHC.mkPrintUnqualifiedForModule minf - return (fromMaybe GHC.alwaysQualify mb_print_unqual) - Nothing -> - return GHC.alwaysQualify - case mbModInfo of - Just modInfo -> return $! listTags unqual modInfo - _ -> return [] - - mtags <- mapM tagModule ms - either_res <- liftIO $ collateAndWriteTags tagskind tagFile $ concat mtags + mtags <- mapM listModuleTags (map GHC.ms_mod graph) + either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags case either_res of Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e Right _ -> return () -listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo] -listTags unqual modInfo = - [ tagInfo unqual name loc - | name <- GHC.modInfoExports modInfo - , let loc = srcSpanStart (nameSrcSpan name) - , isGoodSrcLoc loc - ] -type TagInfo = (String -- tag name - ,String -- file name - ,Int -- line number - ,Int -- column number - ) +listModuleTags :: GHC.Module -> GHCi [TagInfo] +listModuleTags m = do + is_interpreted <- GHC.moduleIsInterpreted m + -- should we just skip these? + when (not is_interpreted) $ + let mName = GHC.moduleNameString (GHC.moduleName m) in + ghcError (CmdLineError ("module '" ++ mName ++ "' is not interpreted")) + mbModInfo <- GHC.getModuleInfo m + case mbModInfo of + Nothing -> return [] + Just mInfo -> do + mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo + let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual + let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo + let localNames = filter ((m==) . nameModule) names + mbTyThings <- mapM GHC.lookupName localNames + return $! [ tagInfo unqual exported kind name loc + | tyThing <- catMaybes mbTyThings + , let name = getName tyThing + , let exported = GHC.modInfoIsExportedName mInfo name + , let kind = tyThing2TagKind tyThing + , let loc = srcSpanStart (nameSrcSpan name) + , isGoodSrcLoc loc + ] + + where + tyThing2TagKind (AnId _) = 'v' + tyThing2TagKind (ADataCon _) = 'd' + tyThing2TagKind (ATyCon _) = 't' + tyThing2TagKind (AClass _) = 'c' + + +data TagInfo = TagInfo + { tagExported :: Bool -- is tag exported + , tagKind :: Char -- tag kind + , tagName :: String -- tag name + , tagFile :: String -- file name + , tagLine :: Int -- line number + , tagCol :: Int -- column number + , tagSrcInfo :: Maybe (String,Integer) -- source code line and char offset + } + -- 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 - ) +tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> SrcLoc -> TagInfo +tagInfo unqual exported kind name loc + = TagInfo exported kind + (showSDocForUser unqual $ pprOccName (nameOccName name)) + (showSDocForUser unqual $ ftext (srcLocFile loc)) + (srcLocLine loc) (srcLocCol loc) Nothing + 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 +-- ctags style with the Ex exresion being just the line number, Vim et al +collateAndWriteTags CTagsWithLineNumbers file tagInfos = do + let tags = unlines $ sortLe (<=) $ map showCTag tagInfos + IO.try (writeFile file tags) + +-- ctags style with the Ex exresion being a regex searching the line, Vim et al +collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al + tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos + let tags = unlines $ sortLe (<=) $ map showCTag $concat tagInfoGroups 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 + tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos + let tagGroups = map processGroup tagInfoGroups IO.try (writeFile file $ concat tagGroups) + where - tagFileGroup [] = ghcError (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 + processGroup [] = ghcError (CmdLineError "empty tag file group??") + processGroup group@(tagInfo:_) = + let tags = unlines $ map showETag group in + "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags + + +makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]] +makeTagGroupsWithSrcInfo tagInfos = do + let byFile op ti0 ti1 = tagFile ti0 `op` tagFile ti1 + groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos + mapM addTagSrcInfo groups + + where + addTagSrcInfo [] = ghcError (CmdLineError "empty tag file group??") + addTagSrcInfo group@(tagInfo:_) = do + file <- readFile $tagFile tagInfo + let byLine ti0 ti1 = tagLine ti0 <= tagLine ti1 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 lines@(line:lines') - | lNo > count = perFile (tagInfo:tags) (count+1) (pos+length line) lines' - | lNo == count = showETag tagInfo line pos : perFile tags count pos lines + return $ perFile sortedGroup 1 0 $ lines file + + perFile allTags@(tag:tags) cnt pos allLs@(l:ls) + | tagLine tag > cnt = + perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls + | tagLine tag == cnt = + tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs perFile _ _ _ _ = [] --- simple ctags format, for Vim et al -showTag :: TagInfo -> String -showTag (tag, file, lineNo, _colNo) - = tag ++ "\t" ++ file ++ "\t" ++ show lineNo + +-- ctags format, for Vim et al +showCTag :: TagInfo -> String +showCTag ti = + tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++ + tagKind ti : ( if tagExported ti then "" else "\tfile:" ) + + where + tagCmd = + case tagSrcInfo ti of + Nothing -> show $tagLine ti + Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/" + + where + escapeSlashes '/' r = '\\' : '/' : r + escapeSlashes '\\' r = '\\' : '\\' : r + escapeSlashes c r = c : r + -- etags format, for Emacs/XEmacs -showETag :: TagInfo -> String -> Int -> String -showETag (tag, _file, lineNo, colNo) line charPos - = take colNo line ++ tag +showETag :: TagInfo -> String +showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo, + tagSrcInfo = Just (srcLine,charPos) } + = take colNo srcLine ++ tag ++ "\x7f" ++ tag ++ "\x01" ++ show lineNo ++ "," ++ show charPos +showETag _ = ghcError (CmdLineError "missing source file info in showETag") diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 6722722..a5a1ba4 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -123,7 +123,8 @@ builtin_commands = [ ("check", keepGoing' checkModule, completeHomeModule), ("continue", keepGoing continueCmd, noCompletion), ("cmd", keepGoing cmdCmd, completeExpression), - ("ctags", keepGoing createCTagsFileCmd, completeFilename), + ("ctags", keepGoing createCTagsWithLineNumbersCmd, completeFilename), + ("ctags!", keepGoing createCTagsWithRegExesCmd, completeFilename), ("def", keepGoing (defineMacro False), completeExpression), ("def!", keepGoing (defineMacro True), completeExpression), ("delete", keepGoing deleteCmd, noCompletion), @@ -202,7 +203,8 @@ helpText = " (!: more details; *: all top-level names)\n" ++ " :cd change directory to \n" ++ " :cmd run the commands returned by ::IO String\n" ++ - " :ctags [] create tags file for Vi (default: \"tags\")\n" ++ + " :ctags[!] [] create tags file for Vi (default: \"tags\")\n" ++ + " (!: use regex instead of line number)\n" ++ " :def define a command :\n" ++ " :edit edit file\n" ++ " :edit edit last module\n" ++ -- 1.7.10.4