Clean up getSymbolTable a bit more

This commit is contained in:
Daniel Gröber 2014-07-24 00:08:47 +02:00
parent 24633f04e4
commit c98eb23bdf

View File

@ -54,7 +54,8 @@ import qualified Data.Map as M
-- | Type of function and operation names. -- | Type of function and operation names.
type Symbol = String type Symbol = String
-- | Database from 'Symbol' to \['ModuleString'\]. -- | Database from 'Symbol' to \['ModuleString'\].
newtype SymbolDb = SymbolDb (Map Symbol [ModuleString]) deriving (Show) newtype SymbolDb = SymbolDb (Map Symbol [ModuleString])
deriving (Show)
---------------------------------------------------------------- ----------------------------------------------------------------
@ -158,21 +159,28 @@ isNewerThan ref file = do
-- | Browsing all functions in all system/user modules. -- | Browsing all functions in all system/user modules.
getSymbolTable :: IOish m => GhcModT m [(Symbol,[ModuleString])] getSymbolTable :: IOish m => GhcModT m [(Symbol,[ModuleString])]
getSymbolTable = do getSymbolTable = do
ms <- G.packageDbModules True ghcModules <- G.packageDbModules True
let ns = map (G.moduleNameString . G.moduleName) ms moduleInfos <- mapM G.getModuleInfo ghcModules
is <- mapM G.getModuleInfo ms let modules = do
let symbols = concatMap toNameModule (zip is ns) m <- ghcModules
return $ uniquefy symbols let moduleName = G.moduleNameString $ G.moduleName m
-- modulePkg = G.packageIdString $ G.modulePackageId m
return moduleName
toNameModule :: (Maybe G.ModuleInfo,ModuleString) -> [(Symbol,ModuleString)] return $ collectModules
toNameModule (Nothing,_) = [] $ extractBindings `concatMap` (moduleInfos `zip` modules)
toNameModule (Just inf,mdlname) =
extractBindings :: (Maybe G.ModuleInfo, ModuleString)
-> [(Symbol, ModuleString)]
extractBindings (Nothing,_) = []
extractBindings (Just inf,mdlname) =
map (\name -> (getOccString name, mdlname)) names map (\name -> (getOccString name, mdlname)) names
where where
names = G.modInfoExports inf names = G.modInfoExports inf
uniquefy :: [(Symbol,ModuleString)] -> [(Symbol,[ModuleString])] collectModules :: [(Symbol,ModuleString)]
uniquefy = map tieup . groupBy ((==) `on` fst) . sort -> [(Symbol,[ModuleString])]
collectModules = map tieup . groupBy ((==) `on` fst) . sort
where where
tieup x = (head (map fst x), map snd x) tieup x = (head (map fst x), map snd x)