{-# LANGUAGE NoImplicitPrelude #-}

-- |
-- Dead code elimination for `CoreFn`.
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)


-- | Dead code elimination of a list of modules module
--
runDeadCodeElimination
  :: [Qualified Ident]
  -- ^ entry points used to build the graph of
  -- dependencies across module boundaries
  -> [Module Ann]
  -- ^ modules to dce
  -> [Module Ann]
  -- ^ dead code eliminated modules
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
    -- DCE of a single module.
    runModuleDeadCodeElimination
      :: [(DCEVertex, Key, [Key])]
      -- list of qualified names that need to be preserved
      -> 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
          -- | filter declarations preserving the order
          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

    -- | The Vertex set.
    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 -- Module local bindings
          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 -- Foreign bindings
          forall a. [a] -> [a] -> [a]
++ ModuleName
-> Map ModuleName [Ident]
-> [(DCEVertex, Qualified Ident, [Qualified Ident])]
reExportedVertices ModuleName
mn Map ModuleName [Ident]
rexp -- Re-exported bindings
      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

      -- | Find dependencies of an expression.
      deps :: Expr Ann -> [Key]
      deps :: Expr Ann -> [Qualified Ident]
deps = Expr Ann -> [Qualified Ident]
traverseExpr
        where
          -- | Build graph from qualified identifiers.
          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)

          -- @f@ is either 'Expr' or 'Binder'
          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)
_ = []


    -- | Vertices corresponding to the entry points which we want to keep.
    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)

    -- | The list of reachable vertices grouped by module name.
    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


-- | Dead code elimination of local identifiers in `Bind`s, which detects and
-- removes unused bindings.
--
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

    -- | Build list of vertices
    --
    -- Under the assumption that all identifiers are unique, which is
    -- fullfiled by PureScript.
    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
    -- |
    -- Check if an identifier is used in bindings and the resulting
    -- expression.  A binding might shadow an identifier.  The first Boolean
    -- value denotes if i is used in any bind expression, the second if it was
    -- shadowed.
    (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)