@@ -30,11 +30,33 @@ import Language.PureScript.Declarations
3030-- Eliminate all declarations which are not a transitive dependency of the entry point module
3131--
3232eliminateDeadCode :: [ModuleName] -> [Module] -> [Module]
33−eliminateDeadCode entryPoints ms =
34− let declarations = concatMap declarationsByModule ms
35− (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
36− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
37− in flip map ms $ \(Module moduleName ds exps) -> Module moduleName (filter (isUsed moduleName graph vertexFor entryPointVertices) ds) exps
33+eliminateDeadCode entryPoints ms = map go ms
34+ where
35+ go (Module moduleName ds (Just exps)) = Module moduleName ds' (Just exps')
36+ where
37+ ds' = filter (isUsed moduleName graph vertexFor entryPointVertices) ds
38+ exps' = mapMaybe (filterExport ds') exps
39+ go _ = error "Exports should have been elaborated in name desugaring"
40+ declarations = concatMap declarationsByModule ms
41+ (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
42+ entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
43+
44+ filterExport :: [Declaration] -> DeclarationRef -> Maybe DeclarationRef
45+ filterExport decls r@(TypeRef name _) | (any $ typeExists name) decls = Just r
46+ filterExport decls r@(ValueRef name) | (any $ valueExists name) decls = Just r
47+ filterExport decls r@(TypeInstanceRef name _ _) | (any $ valueExists name) decls = Just r
48+ filterExport _ _ = Nothing
49+
50+ valueExists :: Ident -> Declaration -> Bool
51+ valueExists name (ValueDeclaration name' _ _ _ _) = name == name'
52+ valueExists name (ExternDeclaration _ name' _ _) = name == name'
53+ valueExists name (BindingGroupDeclaration decls) = any (\(name', _, _) -> name == name') decls
54+ valueExists _ _ = False
55+
56+ typeExists :: ProperName -> Declaration -> Bool
57+ typeExists name (DataDeclaration name' _ _) = name == name'
58+ typeExists name (DataBindingGroupDeclaration decls) = any (typeExists name) decls
59+ typeExists _ _ = False
3860
3961type Key = (ModuleName, Either Ident ProperName)
4062