git.iko.soy/rowtype-yoga/purescript-native
on 7b5ab61 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/DeadCodeElimination.hs
102 lines 3.4 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.DeadCodeElimination
4-- Copyright : (c) 2014 Phil Freeman
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- | Dead code elimination.
12--
13-----------------------------------------------------------------------------
15module Language.PureScript.DeadCodeElimination (
16 eliminateDeadCode
17) where
19import Data.Graph
20import Data.List
21import Data.Maybe (mapMaybe)
23import Language.PureScript.CoreFn
24import Language.PureScript.Names
26-- |
27-- Eliminate all declarations which are not a transitive dependency of the entry point module
28--
29eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
30eliminateDeadCode entryPoints ms = map go ms
31 where
32 go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'
33 where
34 ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
35 foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
36 names = concatMap bindIdents ds' ++ map foreignIdent foreigns'
37 exps' = filter (`elem` names) exps
38 declarations = concatMap declarationsByModule ms
39 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
40 entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
42-- |
43-- Extract declaration names for a binding group.
44--
45bindIdents :: Bind a -> [Ident]
46bindIdents (NonRec name _) = [name]
47bindIdents (Rec names) = map fst names
49-- |
50-- Extract the ident for a foreign declaration.
51--
52foreignIdent :: ForeignDecl -> Ident
53foreignIdent = fst
55-- |
56-- Key type to use in graph
57--
58type Key = (ModuleName, Ident)
60-- |
61-- Find dependencies for each member in a module.
62--
63declarationsByModule :: Module a -> [(Key, [Key])]
64declarationsByModule (Module _ mn _ _ fs ds) =
65 let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
66 in fs' ++ concatMap go ds
67 where
68 go :: Bind a -> [(Key, [Key])]
69 go d@(NonRec name _) = [((mn, name), dependencies d)]
70 go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'
72-- |
73-- Find all referenced values within a binding group.
74--
75dependencies :: Bind a -> [Key]
76dependencies =
77 let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])
78 in nub . f
79 where
80 values :: Expr a -> [Key]
81 values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]
82 values _ = []
83 binders :: Binder a -> [Key]
84 binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]
85 binders _ = []
87-- |
88-- Check whether a binding group is used.
89--
90isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool
91isUsed mn graph vertexFor entryPointVertices (NonRec name _) =
92 isUsed' mn graph vertexFor entryPointVertices name
93isUsed mn graph vertexFor entryPointVertices (Rec ds) =
94 any (isUsed' mn graph vertexFor entryPointVertices . fst) ds
96-- |
97-- Check whether a named declaration is used.
98--
99isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool
100isUsed' mn graph vertexFor entryPointVertices name =
101 let Just v' = vertexFor (mn, name)
102 in any (\v -> path graph v v') entryPointVertices