module Language.PureScript.DeadCodeElimination (
eliminateDeadCode
) where
import Data.Graph
import Data.List
import Data.Maybe (mapMaybe)
import Language.PureScript.CoreFn
import Language.PureScript.Names
eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
eliminateDeadCode entryPoints ms = map go ms
where
go (Module mn imps exps foreigns ds) = Module mn imps exps' foreigns' ds'
where
ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
names = concatMap bindIdents ds' ++ map foreignIdent foreigns'
exps' = filter (`elem` names) exps
declarations = concatMap declarationsByModule ms
(graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
bindIdents :: Bind a -> [Ident]
bindIdents (NonRec name _) = [name]
bindIdents (Rec names) = map fst names
foreignIdent :: ForeignDecl -> Ident
foreignIdent (name, _, _) = name
type Key = (ModuleName, Ident)
declarationsByModule :: Module a -> [(Key, [Key])]
declarationsByModule (Module mn _ _ fs ds) =
let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
in fs' ++ concatMap go ds
where
go :: Bind a -> [(Key, [Key])]
go d@(NonRec name _) = [((mn, name), dependencies d)]
go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'
dependencies :: Bind a -> [Key]
dependencies =
let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])
in nub . f
where
values :: Expr a -> [Key]
values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]
values _ = []
binders :: Binder a -> [Key]
binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]
binders _ = []
isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool
isUsed mn graph vertexFor entryPointVertices (NonRec name _) =
isUsed' mn graph vertexFor entryPointVertices name
isUsed mn graph vertexFor entryPointVertices (Rec ds) =
any (isUsed' mn graph vertexFor entryPointVertices . fst) ds
isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool
isUsed' mn graph vertexFor entryPointVertices name =
let Just v' = vertexFor (mn, name)
in any (\v -> path graph v v') entryPointVertices