{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.DCE.CoreFn
( runDeadCodeElimination
, runBindDeadCodeElimination
) where
import Prelude hiding (mod)
import Control.Arrow ((***))
import Control.Monad ( guard )
import Data.Graph ( graphFromEdges, reachable, Vertex )
import Data.Foldable (foldl', foldr')
import Data.List (groupBy, sortBy)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, mapMaybe)
import qualified Data.Set as S
import Language.PureScript.CoreFn
( Literal(ObjectLiteral, ArrayLiteral),
Ann,
everywhereOnValues,
Binder(VarBinder, LiteralBinder, ConstructorBinder, NamedBinder),
Bind(..),
CaseAlternative(CaseAlternative),
Expr(..),
Module(Module, moduleImports, moduleExports, moduleForeign,
moduleDecls, moduleName, moduleReExports) )
import Language.PureScript.DCE.Utils (bindIdents, unBind)
import Language.PureScript.Names
( getQual,
isQualified,
mkQualified,
Ident(Ident),
ModuleName,
ProperName(runProperName),
Qualified(..),
QualifiedBy(..) )
type Key = Qualified Ident
data DCEVertex
= BindVertex (Bind Ann)
| ForeignVertex (Qualified Ident)
| ReExportedVertex (Qualified Ident)
runDeadCodeElimination
:: [Qualified Ident]
-> [Module Ann]
-> [Module Ann]
runDeadCodeElimination :: [Qualified Ident] -> [Module Ann] -> [Module Ann]
runDeadCodeElimination [Qualified Ident]
entryPoints [Module Ann]
modules = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(DCEVertex, Qualified Ident, [Qualified Ident])]
-> Module Ann -> Module Ann
runModuleDeadCodeElimination forall a b. (a -> b) -> [a] -> [b]
`map` [([(DCEVertex, Qualified Ident, [Qualified Ident])], Module Ann)]
reachableInModule
where
runModuleDeadCodeElimination
:: [(DCEVertex, Key, [Key])]
-> Module Ann
-> Module Ann
runModuleDeadCodeElimination :: [(DCEVertex, Qualified Ident, [Qualified Ident])]
-> Module Ann -> Module Ann
runModuleDeadCodeElimination [(DCEVertex, Qualified Ident, [Qualified Ident])]
vs mod :: Module Ann
mod@Module{ [Bind Ann]
moduleDecls :: [Bind Ann]
moduleDecls :: forall a. Module a -> [Bind a]
moduleDecls
, [Ident]
moduleExports :: [Ident]
moduleExports :: forall a. Module a -> [Ident]
moduleExports
, Map ModuleName [Ident]
moduleReExports :: Map ModuleName [Ident]
moduleReExports :: forall a. Module a -> Map ModuleName [Ident]
moduleReExports
, [(Ann, ModuleName)]
moduleImports :: [(Ann, ModuleName)]
moduleImports :: forall a. Module a -> [(a, ModuleName)]
moduleImports
, ModuleName
moduleName :: ModuleName
moduleName :: forall a. Module a -> ModuleName
moduleName
, [Ident]
moduleForeign :: [Ident]
moduleForeign :: forall a. Module a -> [Ident]
moduleForeign
} =
let
moduleDecls' :: [Bind Ann]
moduleDecls' :: [Bind Ann]
moduleDecls' = Bind Ann -> Bind Ann
runBindDeadCodeElimination forall a b. (a -> b) -> [a] -> [b]
`map` forall a. (a -> Bool) -> [a] -> [a]
filter Bind Ann -> Bool
filterByIdents [Bind Ann]
moduleDecls
where
declIdents :: [Ident]
declIdents :: [Ident]
declIdents = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DCEVertex, Qualified Ident, [Qualified Ident]) -> [Ident]
toIdents [(DCEVertex, Qualified Ident, [Qualified Ident])]
vs
toIdents :: (DCEVertex, Key, [Key]) -> [Ident]
toIdents :: (DCEVertex, Qualified Ident, [Qualified Ident]) -> [Ident]
toIdents (BindVertex Bind Ann
b, Qualified Ident
_, [Qualified Ident]
_) = Bind Ann -> [Ident]
bindIdents Bind Ann
b
toIdents (DCEVertex, Qualified Ident, [Qualified Ident])
_ = []
filterByIdents :: Bind Ann -> Bool
filterByIdents :: Bind Ann -> Bool
filterByIdents = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
declIdents) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bind Ann -> [Ident]
bindIdents
idents :: [Ident]
idents :: [Ident]
idents = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bind Ann -> [Ident]
bindIdents [Bind Ann]
moduleDecls'
moduleExports' :: [Ident]
moduleExports' :: [Ident]
moduleExports' =
forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Ident]
idents forall a. [a] -> [a] -> [a]
++ [Ident]
moduleForeign')) [Ident]
moduleExports
moduleReExports' :: M.Map ModuleName [Ident]
moduleReExports' :: Map ModuleName [Ident]
moduleReExports' =
forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
rexpIdents) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ModuleName [Ident]
moduleReExports
where
toRexpIdents :: (DCEVertex, Key, [Key]) -> [Ident]
toRexpIdents :: (DCEVertex, Qualified Ident, [Qualified Ident]) -> [Ident]
toRexpIdents (ReExportedVertex (Qualified QualifiedBy
_ Ident
i), Qualified Ident
_, [Qualified Ident]
_) = [Ident
i]
toRexpIdents (DCEVertex, Qualified Ident, [Qualified Ident])
_ = []
rexpIdents :: [Ident]
rexpIdents :: [Ident]
rexpIdents = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DCEVertex, Qualified Ident, [Qualified Ident]) -> [Ident]
toRexpIdents [(DCEVertex, Qualified Ident, [Qualified Ident])]
vs
mods :: [ModuleName]
mods :: [ModuleName]
mods = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Qualified a -> Maybe ModuleName
getQual (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(DCEVertex
_, Qualified Ident
_, [Qualified Ident]
ks) -> [Qualified Ident]
ks) [(DCEVertex, Qualified Ident, [Qualified Ident])]
vs)
moduleImports' :: [(Ann, ModuleName)]
moduleImports' :: [(Ann, ModuleName)]
moduleImports' = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
mods) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Ann, ModuleName)]
moduleImports
moduleForeign' :: [Ident]
moduleForeign' :: [Ident]
moduleForeign' = forall a. (a -> Bool) -> [a] -> [a]
filter
((forall a. Ord a => a -> Set a -> Bool
`S.member` Set (Qualified Ident)
reachableSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
moduleName))
[Ident]
moduleForeign
where
reachableSet :: Set (Qualified Ident)
reachableSet = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr'
(\(DCEVertex
_, Qualified Ident
k, [Qualified Ident]
ks) Set (Qualified Ident)
s -> forall a. Ord a => a -> Set a -> Set a
S.insert Qualified Ident
k Set (Qualified Ident)
s forall a. Ord a => Set a -> Set a -> Set a
`S.union` forall a. Ord a => [a] -> Set a
S.fromList [Qualified Ident]
ks)
forall a. Set a
S.empty [(DCEVertex, Qualified Ident, [Qualified Ident])]
vs
in Module Ann
mod { moduleImports :: [(Ann, ModuleName)]
moduleImports = [(Ann, ModuleName)]
moduleImports'
, moduleExports :: [Ident]
moduleExports = [Ident]
moduleExports'
, moduleReExports :: Map ModuleName [Ident]
moduleReExports = Map ModuleName [Ident]
moduleReExports'
, moduleForeign :: [Ident]
moduleForeign = [Ident]
moduleForeign'
, moduleDecls :: [Bind Ann]
moduleDecls = [Bind Ann]
moduleDecls'
}
(Graph
graph, Vertex -> (DCEVertex, Qualified Ident, [Qualified Ident])
keyForVertex, Qualified Ident -> Maybe Vertex
vertexForKey) = forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
graphFromEdges [(DCEVertex, Qualified Ident, [Qualified Ident])]
verts
verts :: [(DCEVertex, Key, [Key])]
verts :: [(DCEVertex, Qualified Ident, [Qualified Ident])]
verts = do
Module SourceSpan
_ [Comment]
_ ModuleName
mn FilePath
_ [(Ann, ModuleName)]
_ [Ident]
_ Map ModuleName [Ident]
rexp [Ident]
mf [Bind Ann]
ds <- [Module Ann]
modules
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModuleName
-> Bind Ann -> [(DCEVertex, Qualified Ident, [Qualified Ident])]
toVertices ModuleName
mn) [Bind Ann]
ds
forall a. [a] -> [a] -> [a]
++ ((\Qualified Ident
q -> (Qualified Ident -> DCEVertex
ForeignVertex Qualified Ident
q, Qualified Ident
q, [])) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> ModuleName -> Qualified a
mkQualified ModuleName
mn) forall a b. (a -> b) -> [a] -> [b]
`map` [Ident]
mf
forall a. [a] -> [a] -> [a]
++ ModuleName
-> Map ModuleName [Ident]
-> [(DCEVertex, Qualified Ident, [Qualified Ident])]
reExportedVertices ModuleName
mn Map ModuleName [Ident]
rexp
where
toVertices :: ModuleName -> Bind Ann -> [(DCEVertex, Key, [Key])]
toVertices :: ModuleName
-> Bind Ann -> [(DCEVertex, Qualified Ident, [Qualified Ident])]
toVertices ModuleName
mn b :: Bind Ann
b@(NonRec Ann
_ Ident
i Expr Ann
e) =
[(Bind Ann -> DCEVertex
BindVertex Bind Ann
b, forall a. a -> ModuleName -> Qualified a
mkQualified Ident
i ModuleName
mn, Expr Ann -> [Qualified Ident]
deps Expr Ann
e)]
toVertices ModuleName
mn b :: Bind Ann
b@(Rec [((Ann, Ident), Expr Ann)]
bs) =
let ks :: [(Key, [Key])]
ks :: [(Qualified Ident, [Qualified Ident])]
ks = forall a b. (a -> b) -> [a] -> [b]
map (\((Ann
_, Ident
i), Expr Ann
e) -> (forall a. a -> ModuleName -> Qualified a
mkQualified Ident
i ModuleName
mn, Expr Ann -> [Qualified Ident]
deps Expr Ann
e)) [((Ann, Ident), Expr Ann)]
bs
in forall a b. (a -> b) -> [a] -> [b]
map (\(Qualified Ident
k, [Qualified Ident]
ks') -> (Bind Ann -> DCEVertex
BindVertex Bind Ann
b, Qualified Ident
k, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Qualified Ident, [Qualified Ident])]
ks forall a. [a] -> [a] -> [a]
++ [Qualified Ident]
ks')) [(Qualified Ident, [Qualified Ident])]
ks
reExportedVertices :: ModuleName -> M.Map ModuleName [Ident] -> [(DCEVertex, Key, [Key])]
reExportedVertices :: ModuleName
-> Map ModuleName [Ident]
-> [(DCEVertex, Qualified Ident, [Qualified Ident])]
reExportedVertices ModuleName
parent Map ModuleName [Ident]
rexp =
forall a. (a -> Bool) -> [a] -> [a]
filter (Map ModuleName [Ident] -> Module Ann -> Bool
isReExported Map ModuleName [Ident]
rexp) [Module Ann]
modules forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Module Ann -> [(DCEVertex, Qualified Ident, [Qualified Ident])]
rexpsFor
where
rexpsFor :: Module Ann -> [(DCEVertex, Key, [Key])]
rexpsFor :: Module Ann -> [(DCEVertex, Qualified Ident, [Qualified Ident])]
rexpsFor (Module SourceSpan
_ [Comment]
_ ModuleName
mn FilePath
_ [(Ann, ModuleName)]
_ [Ident]
_ Map ModuleName [Ident]
_ [Ident]
_ [Bind Ann]
_) = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
mn Map ModuleName [Ident]
rexp of
Maybe [Ident]
Nothing -> []
Just [Ident]
ids -> (\Ident
i -> (Qualified Ident -> DCEVertex
ReExportedVertex (forall a. a -> ModuleName -> Qualified a
mkQualified Ident
i ModuleName
parent)
, forall a. a -> ModuleName -> Qualified a
mkQualified Ident
i ModuleName
parent
, [forall a. a -> ModuleName -> Qualified a
mkQualified Ident
i ModuleName
mn])
) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
ids
isReExported :: M.Map ModuleName [Ident] -> Module Ann -> Bool
isReExported :: Map ModuleName [Ident] -> Module Ann -> Bool
isReExported Map ModuleName [Ident]
rexps (Module SourceSpan
_ [Comment]
_ ModuleName
name FilePath
_ [(Ann, ModuleName)]
_ [Ident]
_ Map ModuleName [Ident]
_ [Ident]
_ [Bind Ann]
_) =
forall k a. Ord k => k -> Map k a -> Bool
M.member ModuleName
name Map ModuleName [Ident]
rexps
deps :: Expr Ann -> [Key]
deps :: Expr Ann -> [Qualified Ident]
deps = Expr Ann -> [Qualified Ident]
traverseExpr
where
onExpr :: Expr Ann -> [Key]
onExpr :: Expr Ann -> [Qualified Ident]
onExpr (Var Ann
_ Qualified Ident
i) = [Qualified Ident
i | forall a. Qualified a -> Bool
isQualified Qualified Ident
i]
onExpr Expr Ann
_ = []
traverseExpr :: Expr Ann -> [Key]
traverseExpr :: Expr Ann -> [Qualified Ident]
traverseExpr v :: Expr Ann
v@(Literal Ann
_ Literal (Expr Ann)
l) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
forall a. [a] -> [a] -> [a]
(++)
(Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v)
(forall a b. (a -> b) -> [a] -> [b]
map Expr Ann -> [Qualified Ident]
traverseExpr (forall (f :: * -> *). Literal (f Ann) -> [f Ann]
extractLiteral Literal (Expr Ann)
l))
traverseExpr v :: Expr Ann
v@Constructor {} = Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v
traverseExpr v :: Expr Ann
v@(Accessor Ann
_ PSString
_ Expr Ann
e1) = Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v forall a. [a] -> [a] -> [a]
++ Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
e1
traverseExpr v :: Expr Ann
v@(ObjectUpdate Ann
_ Expr Ann
obj [(PSString, Expr Ann)]
vs) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
forall a. [a] -> [a] -> [a]
(++)
(Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v forall a. [a] -> [a] -> [a]
++ Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
obj)
(forall a b. (a -> b) -> [a] -> [b]
map (Expr Ann -> [Qualified Ident]
traverseExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(PSString, Expr Ann)]
vs)
traverseExpr v :: Expr Ann
v@(Abs Ann
_ Ident
_ Expr Ann
e1) = Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v forall a. [a] -> [a] -> [a]
++ Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
e1
traverseExpr v :: Expr Ann
v@(App Ann
_ Expr Ann
e1 Expr Ann
e2) =
Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v forall a. [a] -> [a] -> [a]
++ Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
e1 forall a. [a] -> [a] -> [a]
++ Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
e2
traverseExpr v :: Expr Ann
v@(Var Ann
_ Qualified Ident
_) = Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v
traverseExpr v :: Expr Ann
v@(Case Ann
_ [Expr Ann]
vs [CaseAlternative Ann]
alts) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
forall a. [a] -> [a] -> [a]
(++)
(forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. [a] -> [a] -> [a]
(++) (Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v) (forall a b. (a -> b) -> [a] -> [b]
map Expr Ann -> [Qualified Ident]
traverseExpr [Expr Ann]
vs))
(forall a b. (a -> b) -> [a] -> [b]
map CaseAlternative Ann -> [Qualified Ident]
onCaseAlternative [CaseAlternative Ann]
alts)
traverseExpr v :: Expr Ann
v@(Let Ann
_ [Bind Ann]
ds Expr Ann
e1) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
forall a. [a] -> [a] -> [a]
(++)
(Expr Ann -> [Qualified Ident]
onExpr Expr Ann
v)
(forall a b. (a -> b) -> [a] -> [b]
map Bind Ann -> [Qualified Ident]
onBind [Bind Ann]
ds)
forall a. [a] -> [a] -> [a]
++
Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
e1
onBind :: Bind Ann -> [Key]
onBind :: Bind Ann -> [Qualified Ident]
onBind (NonRec Ann
_ Ident
_ Expr Ann
e) = Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
e
onBind (Rec [((Ann, Ident), Expr Ann)]
es) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Expr Ann -> [Qualified Ident]
traverseExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [((Ann, Ident), Expr Ann)]
es
onBinder :: Binder Ann -> [Key]
onBinder :: Binder Ann -> [Qualified Ident]
onBinder b :: Binder Ann
b@(LiteralBinder Ann
_ Literal (Binder Ann)
l) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
forall a. [a] -> [a] -> [a]
(++)
(Binder Ann -> [Qualified Ident]
onBinder' Binder Ann
b)
(forall a b. (a -> b) -> [a] -> [b]
map Binder Ann -> [Qualified Ident]
onBinder (forall (f :: * -> *). Literal (f Ann) -> [f Ann]
extractLiteral Literal (Binder Ann)
l))
onBinder b :: Binder Ann
b@(ConstructorBinder Ann
_ Qualified (ProperName 'TypeName)
_ Qualified (ProperName 'ConstructorName)
_ [Binder Ann]
bs) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
forall a. [a] -> [a] -> [a]
(++)
(Binder Ann -> [Qualified Ident]
onBinder' Binder Ann
b)
(forall a b. (a -> b) -> [a] -> [b]
map Binder Ann -> [Qualified Ident]
onBinder [Binder Ann]
bs)
onBinder b :: Binder Ann
b@(NamedBinder Ann
_ Ident
_ Binder Ann
b1) = Binder Ann -> [Qualified Ident]
onBinder' Binder Ann
b forall a. [a] -> [a] -> [a]
++ Binder Ann -> [Qualified Ident]
onBinder Binder Ann
b1
onBinder Binder Ann
b = Binder Ann -> [Qualified Ident]
onBinder' Binder Ann
b
onBinder' :: Binder Ann -> [Key]
onBinder' :: Binder Ann -> [Qualified Ident]
onBinder' (ConstructorBinder Ann
_ Qualified (ProperName 'TypeName)
_ Qualified (ProperName 'ConstructorName)
c [Binder Ann]
_) =
[forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Ident
Ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> Text
runProperName) Qualified (ProperName 'ConstructorName)
c]
onBinder' Binder Ann
_ = []
onCaseAlternative :: CaseAlternative Ann -> [Key]
onCaseAlternative :: CaseAlternative Ann -> [Qualified Ident]
onCaseAlternative (CaseAlternative [Binder Ann]
bs (Right Expr Ann
val)) =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Binder Ann -> [Qualified Ident]
onBinder [Binder Ann]
bs forall a. [a] -> [a] -> [a]
++ Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
val
onCaseAlternative (CaseAlternative [Binder Ann]
bs (Left [(Expr Ann, Expr Ann)]
gs)) =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(forall a b. (a -> b) -> [a] -> [b]
map
Binder Ann -> [Qualified Ident]
onBinder
[Binder Ann]
bs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\(Expr Ann
grd, Expr Ann
val) ->
[Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
grd, Expr Ann -> [Qualified Ident]
traverseExpr Expr Ann
val]) [(Expr Ann, Expr Ann)]
gs)
extractLiteral :: Literal (f Ann) -> [f Ann]
extractLiteral :: forall (f :: * -> *). Literal (f Ann) -> [f Ann]
extractLiteral (ArrayLiteral [f Ann]
xs) = [f Ann]
xs
extractLiteral (ObjectLiteral [(PSString, f Ann)]
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(PSString, f Ann)]
xs
extractLiteral Literal (f Ann)
_ = []
entryPointVertices :: [Vertex]
entryPointVertices :: [Vertex]
entryPointVertices = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ do
(DCEVertex
_, Qualified Ident
k, [Qualified Ident]
_) <- [(DCEVertex, Qualified Ident, [Qualified Ident])]
verts
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Qualified Ident
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Qualified Ident]
entryPoints
forall (m :: * -> *) a. Monad m => a -> m a
return (Qualified Ident -> Maybe Vertex
vertexForKey Qualified Ident
k)
reachableList :: [[(DCEVertex, Key, [Key])]]
reachableList :: [[(DCEVertex, Qualified Ident, [Qualified Ident])]]
reachableList
= forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(DCEVertex
_, Qualified Ident
k1, [Qualified Ident]
_) (DCEVertex
_, Qualified Ident
k2, [Qualified Ident]
_) -> forall a. Qualified a -> Maybe ModuleName
getQual Qualified Ident
k1 forall a. Eq a => a -> a -> Bool
== forall a. Qualified a -> Maybe ModuleName
getQual Qualified Ident
k2)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(DCEVertex
_, Qualified Ident
k1, [Qualified Ident]
_) (DCEVertex
_, Qualified Ident
k2, [Qualified Ident]
_) -> forall a. Qualified a -> Maybe ModuleName
getQual Qualified Ident
k1 forall a. Ord a => a -> a -> Ordering
`compare` forall a. Qualified a -> Maybe ModuleName
getQual Qualified Ident
k2)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Vertex -> (DCEVertex, Qualified Ident, [Qualified Ident])
keyForVertex (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Graph -> Vertex -> [Vertex]
reachable Graph
graph) [Vertex]
entryPointVertices)
reachableInModule :: [([(DCEVertex, Key, [Key])], Module Ann)]
reachableInModule :: [([(DCEVertex, Qualified Ident, [Qualified Ident])], Module Ann)]
reachableInModule = do
[(DCEVertex, Qualified Ident, [Qualified Ident])]
vs <- [[(DCEVertex, Qualified Ident, [Qualified Ident])]]
reachableList
Module Ann
m <- [Module Ann]
modules
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([(DCEVertex, Qualified Ident, [Qualified Ident])]
-> Maybe ModuleName
getModuleName [(DCEVertex, Qualified Ident, [Qualified Ident])]
vs forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall a. Module a -> ModuleName
moduleName Module Ann
m))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DCEVertex, Qualified Ident, [Qualified Ident])]
vs, Module Ann
m)
getModuleName :: [(DCEVertex, Key, [Key])] -> Maybe ModuleName
getModuleName :: [(DCEVertex, Qualified Ident, [Qualified Ident])]
-> Maybe ModuleName
getModuleName [] = forall a. Maybe a
Nothing
getModuleName ((DCEVertex
_, Qualified Ident
k, [Qualified Ident]
_) : [(DCEVertex, Qualified Ident, [Qualified Ident])]
_) = forall a. Qualified a -> Maybe ModuleName
getQual Qualified Ident
k
runBindDeadCodeElimination :: Bind Ann -> Bind Ann
runBindDeadCodeElimination :: Bind Ann -> Bind Ann
runBindDeadCodeElimination = Bind Ann -> Bind Ann
go
where
(Bind Ann -> Bind Ann
go, Expr Ann -> Expr Ann
_, Binder Ann -> Binder Ann
_) = forall a.
(Bind a -> Bind a)
-> (Expr a -> Expr a)
-> (Binder a -> Binder a)
-> (Bind a -> Bind a, Expr a -> Expr a, Binder a -> Binder a)
everywhereOnValues forall a. a -> a
id Expr Ann -> Expr Ann
exprFn forall a. a -> a
id
exprFn :: Expr Ann -> Expr Ann
exprFn :: Expr Ann -> Expr Ann
exprFn (Let Ann
ann [Bind Ann]
bs Expr Ann
ex) =
let nbs :: [Bind Ann]
nbs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Bind Ann -> [Bind Ann] -> [Bind Ann]
bindFn [] [Bind Ann]
bs
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bind Ann]
nbs
then Expr Ann
ex
else forall a. a -> [Bind a] -> Expr a -> Expr a
Let Ann
ann [Bind Ann]
nbs Expr Ann
ex
where
bindFn :: Bind Ann -> [Bind Ann] -> [Bind Ann]
bindFn :: Bind Ann -> [Bind Ann] -> [Bind Ann]
bindFn b :: Bind Ann
b@(NonRec Ann
_ Ident
i Expr Ann
_) [Bind Ann]
r | Ident
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
reachableIdents = Bind Ann
b forall a. a -> [a] -> [a]
: [Bind Ann]
r
| Bool
otherwise = [Bind Ann]
r
bindFn (Rec [((Ann, Ident), Expr Ann)]
l) [Bind Ann]
r =
let l' :: [((Ann, Ident), Expr Ann)]
l' = forall a. (a -> Bool) -> [a] -> [a]
filter (\((Ann
_, Ident
i), Expr Ann
_) -> Ident
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
reachableIdents) [((Ann, Ident), Expr Ann)]
l
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((Ann, Ident), Expr Ann)]
l'
then [Bind Ann]
r
else forall a. [((a, Ident), Expr a)] -> Bind a
Rec [((Ann, Ident), Expr Ann)]
l' forall a. a -> [a] -> [a]
: [Bind Ann]
r
(Graph
graph, Vertex -> (Ident, Ident, [Ident])
keyForVertex, Ident -> Maybe Vertex
vertexForKey) = forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
graphFromEdges [(Ident, Ident, [Ident])]
verts
verts :: [(Ident, Ident, [Ident])]
verts :: [(Ident, Ident, [Ident])]
verts = do
let bes :: [(Ident, Expr Ann)]
bes = Bind Ann -> [(Ident, Expr Ann)]
unBind forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [Bind Ann]
bs
(Ident
i, Expr Ann
e) <- [(Ident, Expr Ann)]
bes
let deps :: [Ident]
deps = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> [a] -> [b]
`map` forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (Ident, b) -> Bool
fn [(Ident, Expr Ann)]
bes
where
fn :: (Ident, b) -> Bool
fn (Ident
i', b
_) = Ident
i' forall a. Eq a => a -> a -> Bool
/= Ident
i Bool -> Bool -> Bool
&& Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i' Expr Ann
e
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident
i, Ident
i, [Ident]
deps)
entryPointVertices :: [Vertex]
entryPointVertices :: [Vertex]
entryPointVertices = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ do
(Ident
_, Ident
i, [Ident]
_) <- [(Ident, Ident, [Ident])]
verts
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
ex
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Maybe Vertex
vertexForKey Ident
i)
reachableIdents :: [Ident]
reachableIdents = forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Ident
fn forall a b. (a -> b) -> a -> b
$ Graph -> Vertex -> [Vertex]
reachable Graph
graph forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [Vertex]
entryPointVertices
where
fn :: Vertex -> Ident
fn Vertex
v = case Vertex -> (Ident, Ident, [Ident])
keyForVertex Vertex
v of (Ident
_, Ident
i, [Ident]
_) -> Ident
i
exprFn Expr Ann
e = Expr Ann
e
isUsedInExpr :: Ident -> Expr Ann -> Bool
isUsedInExpr :: Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i (Literal Ann
_ (ArrayLiteral [Expr Ann]
es))
= forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i) [Expr Ann]
es
isUsedInExpr Ident
i (Literal Ann
_ (ObjectLiteral [(PSString, Expr Ann)]
es))
= forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(PSString, Expr Ann)]
es
isUsedInExpr Ident
_ (Literal Ann
_ Literal (Expr Ann)
_) = Bool
False
isUsedInExpr Ident
i (Constructor Ann
_ ProperName 'TypeName
_ ProperName 'ConstructorName
_ [Ident]
is) = Ident
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
is
isUsedInExpr Ident
i (Accessor Ann
_ PSString
_ Expr Ann
e) = Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e
isUsedInExpr Ident
i (ObjectUpdate Ann
_ Expr Ann
e [(PSString, Expr Ann)]
ups)
= Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(PSString, Expr Ann)]
ups
isUsedInExpr Ident
i (App Ann
_ (Abs Ann
_ Ident
i' Expr Ann
e) Expr Ann
r)
= if Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
r
then Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i' Expr Ann
e
else Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e
isUsedInExpr Ident
i (App Ann
_ Expr Ann
l Expr Ann
r) = Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
l Bool -> Bool -> Bool
|| Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
r
isUsedInExpr Ident
i (Abs Ann
_ Ident
i' Expr Ann
e) = Ident
i forall a. Eq a => a -> a -> Bool
/= Ident
i' Bool -> Bool -> Bool
&& Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e
isUsedInExpr Ident
i (Var Ann
_ qi :: Qualified Ident
qi@(Qualified QualifiedBy
by Ident
_)) = Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
by Ident
i
isUsedInExpr Ident
i (Case Ann
_ [Expr Ann]
es [CaseAlternative Ann]
alts)
= forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i) [Expr Ann]
es Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Ident -> CaseAlternative Ann -> Bool
isUsedInCaseAlternative Ident
i) [CaseAlternative Ann]
alts
isUsedInExpr Ident
i (Let Ann
_ [Bind Ann]
bs Expr Ann
e) =
if Bool
shadowed
then Bool
used
else Bool
used Bool -> Bool -> Bool
|| Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e
where
(Bool
used, Bool
shadowed) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool, Bool) -> (Ident, Expr Ann) -> (Bool, Bool)
fn (Bool
False, Bool
False) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bind Ann -> [(Ident, Expr Ann)]
unBind [Bind Ann]
bs)
fn :: (Bool, Bool) -> (Ident, Expr Ann) -> (Bool, Bool)
fn (Bool
u, Bool
s) (Ident
i', Expr Ann
e')
| Bool
s Bool -> Bool -> Bool
|| Ident
i forall a. Eq a => a -> a -> Bool
== Ident
i' = (Bool
u, Bool
True)
| Bool
otherwise = (Bool
u Bool -> Bool -> Bool
|| Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e', Bool
False)
isUsedInCaseAlternative :: Ident -> CaseAlternative Ann -> Bool
isUsedInCaseAlternative Ident
i (CaseAlternative [Binder Ann]
bs Either [(Expr Ann, Expr Ann)] (Expr Ann)
ee) =
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Binder Ann
b -> case Binder Ann
b of
VarBinder Ann
_ Ident
i' -> Ident
i forall a. Eq a => a -> a -> Bool
== Ident
i'
Binder Ann
_ -> Bool
False) [Binder Ann]
bs
)
Bool -> Bool -> Bool
&&
(case Either [(Expr Ann, Expr Ann)] (Expr Ann)
ee of
Right Expr Ann
e -> Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i Expr Ann
e
Left [(Expr Ann, Expr Ann)]
es
-> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Ident -> Expr Ann -> Bool
isUsedInExpr Ident
i)) [(Expr Ann, Expr Ann)]
es)