git.iko.soy/rowtype-yoga/purescript-native
on d3f368b help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/DeadCodeElimination.hs
76 lines 3.5 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-- |
12--
13-----------------------------------------------------------------------------
15module Language.PureScript.DeadCodeElimination (
16 eliminateDeadCode
17) where
19import Data.Data
20import Data.List
21import Data.Graph
22import Data.Generics
23import Data.Maybe (mapMaybe)
25import Language.PureScript.Names
26import Language.PureScript.Values
27import Language.PureScript.Declarations
28import Language.PureScript.TypeChecker.Monad
30-- |
31-- Eliminate all declarations which are not a transitive dependency of the entry point module
32--
33eliminateDeadCode :: Environment -> [ModuleName] -> [Module] -> [Module]
34eliminateDeadCode env entryPoints ms =
35 let declarations = concatMap (declarationsByModule env) ms
36 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
37 entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
38 in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (moduleName) graph vertexFor entryPointVertices) ds)
40type Key = (ModuleName, Either Ident ProperName)
42declarationsByModule :: Environment -> Module -> [(Key, [Key])]
43declarationsByModule env (Module moduleName ds) = concatMap go $ ds
44 where
45 go :: Declaration -> [(Key, [Key])]
46 go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies env (moduleName) d)]
47 go (DataDeclaration _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors
48 go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]
49 go d@(BindingGroupDeclaration names) = map (\(name, _) -> ((moduleName, Left name), dependencies env moduleName d)) names
50 go (DataBindingGroupDeclaration ds) = concatMap go ds
51 go _ = []
53dependencies :: (Data d) => Environment -> ModuleName -> d -> [Key]
54dependencies env moduleName = nub . everything (++) (mkQ [] values)
55 where
56 values :: Value -> [Key]
57 values (Var ident) = let (mn, name) = canonicalize moduleName env ident in [(mn, Left name)]
58 values (Constructor pn) = let (mn, name) = canonicalizeDataConstructor moduleName env pn in [(mn, Right name)]
59 values _ = []
61isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Declaration -> Bool
62isUsed moduleName graph vertexFor entryPointVertices (ValueDeclaration name _ _ _) =
63 let Just v' = vertexFor (moduleName, Left name)
64 in any (\v -> path graph v v') entryPointVertices
65isUsed moduleName graph vertexFor entryPointVertices (DataDeclaration _ _ dctors) =
66 any (\(pn, _) -> let Just v' = vertexFor (moduleName, Right pn)
67 in any (\v -> path graph v v') entryPointVertices) dctors
68isUsed moduleName graph vertexFor entryPointVertices (ExternDeclaration _ name _ _) =
69 let Just v' = vertexFor (moduleName, Left name)
70 in any (\v -> path graph v v') entryPointVertices
71isUsed moduleName graph vertexFor entryPointVertices (BindingGroupDeclaration ds) =
72 any (\(name, _) -> let Just v' = vertexFor (moduleName, Left name)
73 in any (\v -> path graph v v') entryPointVertices) ds
74isUsed moduleName graph vertexFor entryPointVertices (DataBindingGroupDeclaration ds) =
75 any (isUsed moduleName graph vertexFor entryPointVertices) ds
76isUsed _ _ _ _ _ = True