git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #520 from purescript/dce-fix

Fix DCE for classes

commitdce3cda10d5536b5bc0a97e7cea4e9bc5c8a213d authorPhil Freeman <paf31@cantab.net> dateSun 27 Jul 2014, 16:15 (12 years ago) parent3fa1d04613716c
1 file changed+12−6
src/Language/PureScript/DeadCodeElimination.hs+12−6
src/Language/PureScript/DeadCodeElimination.hs+12−6
@@ -39,7 +39,8 @@ eliminateDeadCode entryPoints ms = map go ms
3939 entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
4040
4141 filterExport :: [Declaration] -> DeclarationRef -> Maybe DeclarationRef
42− filterExport decls r@(TypeRef name _) | (any $ typeExists name) decls = Just r
42+ filterExport decls r@(TypeRef name _) | (any $ typeOrClassExists name) decls = Just r
43+ filterExport decls r@(TypeClassRef name) | (any $ typeOrClassExists name) decls = Just r
4344 filterExport decls r@(ValueRef name) | (any $ valueExists name) decls = Just r
4445 filterExport decls r@(TypeInstanceRef name) | (any $ valueExists name) decls = Just r
4546 filterExport _ _ = Nothing
@@ -51,11 +52,12 @@ eliminateDeadCode entryPoints ms = map go ms
5152 valueExists name (PositionedDeclaration _ d) = valueExists name d
5253 valueExists _ _ = False
5354
54− typeExists :: ProperName -> Declaration -> Bool
55− typeExists name (DataDeclaration _ name' _ _) = name == name'
56− typeExists name (DataBindingGroupDeclaration decls) = any (typeExists name) decls
57− typeExists name (PositionedDeclaration _ d) = typeExists name d
58− typeExists _ _ = False
55+ typeOrClassExists :: ProperName -> Declaration -> Bool
56+ typeOrClassExists name (DataDeclaration _ name' _ _) = name == name'
57+ typeOrClassExists name (TypeClassDeclaration name' _ _ _) = name == name'
58+ typeOrClassExists name (DataBindingGroupDeclaration decls) = any (typeOrClassExists name) decls
59+ typeOrClassExists name (PositionedDeclaration _ d) = typeOrClassExists name d
60+ typeOrClassExists _ _ = False
5961
6062type Key = (ModuleName, Either Ident ProperName)
6163
@@ -68,6 +70,7 @@ declarationsByModule (Module moduleName ds _) = concatMap go ds
6870 go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]
6971 go d@(BindingGroupDeclaration names') = map (\(name, _, _) -> ((moduleName, Left name), dependencies moduleName d)) names'
7072 go (DataBindingGroupDeclaration ds') = concatMap go ds'
73+ go (TypeClassDeclaration name _ _ _) = [((moduleName, Right name), [])]
7174 go (PositionedDeclaration _ d) = go d
7275 go _ = []
7376
@@ -102,6 +105,9 @@ isUsed moduleName graph vertexFor entryPointVertices (BindingGroupDeclaration ds
102105 in any (\v -> path graph v v') entryPointVertices) ds
103106isUsed moduleName graph vertexFor entryPointVertices (DataBindingGroupDeclaration ds) =
104107 any (isUsed moduleName graph vertexFor entryPointVertices) ds
108+isUsed moduleName graph vertexFor entryPointVertices (TypeClassDeclaration name _ _ _) =
109+ let Just v' = vertexFor (moduleName, Right name)
110+ in any (\v -> path graph v v') entryPointVertices
105111isUsed moduleName graph vertexFor entryPointVertices (PositionedDeclaration _ d) =
106112 isUsed moduleName graph vertexFor entryPointVertices d
107113isUsed _ _ _ _ _ = True