[darcs-devel] Dead code

[Ian Lynagh]

Hi all,

Attached is a nasty hack of a script which should find unused functions
(add -ddump-parsed to GHCFLAGS, rebuild and run the script on stdout).

David, nothing seems to use:
    instance ReadableDirectory SlurpMonad
    instance WriteableDirectory SlurpMonad
Are these now redundant, or are they on the way to being used?

Below is the current script output on my local tree. The ones I've
*ed are ones I think should be kept regardless, because they are part of
a self-contained module, or they complete a set. I haven't done any
digging yet, so there may be others like them. Are there any others we
should keep (or disagreements with keeping the ones I've indicated)?

Note there may be errors as the script is, as I said, a nasty hack  :-)
(better scripts welcomed!).


Thanks
Ian


    Autoconf.darcsconfdir
    DarcsArguments.do_norm
    DarcsArguments.gui_interactive
    DarcsArguments.gui_pipe_interactive
 *  DarcsUtils.putDocLnError
 *  FastPackedString.consPS
 *  FastPackedString.elemPS
 *  FastPackedString.foldlPS
 *  FastPackedString.foldrPS
 *  FastPackedString.gzWriteFilePS
 *  FastPackedString.spanPS
 *  FastPackedString.splitWithPS
 *  FastPackedString.unpackWords
 *  FastPackedString.wordsPS
 *  Lock.appendBinFile
    PatchApply.patchChanges
    PatchBundle.make_context
    PatchCheck.dir_exists
    PatchCheck.do_verbose_check
    PatchChoices.force_matching_last
    PatchCommute.helper_force_commute
    PatchInfo.fix_up_fname
    PatchInfo.make_alt_filename
    PatchInfo.midtrunc
    PatchInfo.munge_char
    PatchInfo.repopatchinfo
    PatchReadMonads.lex_strings
    PatchTest.prop_elegant_merge_good_enough
    PatchTest.prop_glump_order_independent
    PatchTest.prop_glump_seq_merge
    PatchTest.prop_glump_seq_merge_valid
    PatchTest.prop_glump_three_merge
    PatchTest.prop_glump_three_merge_valid
    PatchTest.prop_simple_smart_merge_good_enough
    PatchTest.prop_unravel_order_independent
    PatchTest.simple_smart_merge
    PatchTest.smart_merge
    PatchTest.verbose_check_a_patch
    Population.adjustPopStates
    Population.cleanPop
    Population.getRepoPop
    Population.lookupBy
    Population.popUnfold
    Population.popUnfoldDirty
    PopulationData.notModified
    PopulationData.setPopState
    PopulationData.setState
 *  Printer.newline_p
 *  Printer.putDoc
 *  Printer.putDocWith
 *  Printer.space_p
    Pristine.getPristinePop
    RepoPrefs.set_prefval
    Resolution.hand_resolution
    SlurpDirectory.readFileLinesPS

-------------- next part --------------

import Control.Monad
import Data.Char
import Data.List
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe
import qualified Data.Set as Set
import Data.Set (Set)
import System.Environment (getArgs)

type Function = String
type Module = String
type UsesMap = Map Function (Set Function)
type DefInMap = Map Function (Set Module)
data State = St { st_uses :: UsesMap,
                  st_def_in :: DefInMap,
                  st_mod :: Module,
                  st_fun :: Maybe Function
                }

main :: IO ()
main = do args <- getArgs
          let (file, debug) = case args of
                                  [] -> ("-", False)
                                  ["debug"] -> ("-", True)
                                  [f] -> (f, False)
                                  [f, "debug"] -> (f, True)
                                  ["debug", f] -> (f, True)
                                  _ -> error "Bad arguments"
          xs <- if file == "-" then getContents else readFile file
          let st = foldl do_line init_state (lines xs)
              uses = st_uses st
              uses' = foldr del_from uses ["main", "instance", "class"]
              def_in = st_def_in st
          when debug $ mapM_ print $ Map.assocs uses
          mapM_ (putStrLn . show_unused def_in) $ Map.keys uses'

show_unused :: DefInMap -> Function -> String
show_unused def_in f
 = case Map.lookup f def_in of
       Nothing -> error "Can't happen"
       Just ds -> concat $ intersperse ", " $ map (++ "." ++ f) $ Set.toList ds

del_from :: Function -> UsesMap -> UsesMap
del_from x uses = let xs = Set.toList $ fromMaybe Set.empty $ Map.lookup x uses
                      uses' = Map.delete x uses
                  in foldr del_from uses' xs

init_state :: State
init_state = St { st_uses = Map.empty,
                  st_def_in = Map.empty,
                  st_mod = "",
                  st_fun = Nothing
                }

do_line :: State -> String -> State
do_line st "" = st
do_line st l | "module " `isPrefixOf` l
 = st { st_mod = takeWhile is_fun_char (drop (length "module ") l) }
do_line st l
 | any (`isPrefixOf` l) ["import ", "infixr ", "infix ",
                         "infixl ", "newtype ", "type ", "data "]
    = st { st_fun = Nothing }
do_line st l
 | isLower (head l)
    = let d = takeWhile is_fun_char l
          def_in = st_def_in st
          ms = Set.insert (st_mod st) (Map.findWithDefault Set.empty d def_in)
          def_in' = Map.insert d ms def_in
      in do_line (st { st_fun = Just d,
                       st_def_in = def_in'}) (' ':l)
do_line st l
 | isJust (st_fun st) && isSpace (head l)
    = let fun = fromJust $ st_fun st
          uses = st_uses st
          x' = Set.fromList (get_uses l) `Set.union`
               Map.findWithDefault Set.empty fun uses
          uses' = Map.insert fun x' uses
      in st {st_uses = uses'}
do_line st _ = st { st_fun = Nothing }

is_fun_char :: Char -> Bool
is_fun_char c = isAlphaNum c || c `elem` "_'"

get_uses :: String -> [Function]
get_uses xs = let xs1 = dropWhile (not . is_fun_char) xs
                  (xs2, xs3) = span is_fun_char xs1
              in if null xs2 then []
                 else if isLower (head xs2) then xs2:get_uses xs3
                 else get_uses xs3