{-# LANGUAGE BangPatterns #-}
module Language.PureScript.DCE.Foreign
( runForeignModuleDeadCodeElimination
) where
import Prelude.Compat
import Control.Monad
import Data.Graph
import Data.Foldable (foldr')
import Data.List (any, elem, filter)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Language.JavaScript.Parser.AST
( JSStatement(..)
, JSExpression(..)
, JSCommaList(..)
, JSBlock(..)
, JSSwitchParts(..)
, JSTryCatch(..)
, JSTryFinally(..)
, JSArrayElement(..)
, JSObjectProperty(..)
, JSCommaTrailingList(..)
, JSCommaList(..)
, JSMethodDefinition(..)
, JSClassElement(..)
, JSClassHeritage(..)
, JSTemplatePart(..)
)
import Language.PureScript.Names
foldrJSCommaList :: (a -> b -> b) -> JSCommaList a -> b -> b
foldrJSCommaList _ JSLNil b = b
foldrJSCommaList fn (JSLOne a) !b = fn a b
foldrJSCommaList fn (JSLCons as _ a) !b = foldrJSCommaList fn as (fn a b)
runForeignModuleDeadCodeElimination :: [Ident] -> [JSStatement] -> [JSStatement]
runForeignModuleDeadCodeElimination is stmts = filter filterExports stmts
where
filterExports :: JSStatement -> Bool
filterExports (JSAssignStatement (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ x) _) _ _ _)
= fltr (unquote . T.pack $ x)
filterExports (JSAssignStatement (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ x)) _ _ _)
= fltr (T.pack x)
filterExports _ = True
fltr :: Text -> Bool
fltr t = any (fromMaybe True . (path graph <$> vertexForKey t <*>) . Just) entryPointVertices
|| any (isUsedInStmt t) nonExps
exps :: [JSStatement]
exps = filter isExportStatement stmts
nonExps = filter (not . isExportStatement) stmts
(graph, _, vertexForKey) = graphFromEdges verts
verts :: [(JSStatement, Text, [Text])]
verts = mapMaybe toVert exps
where
toVert :: JSStatement -> Maybe (JSStatement, Text, [Text])
toVert s
| Just name <- exportStatementName s = Just (s, name, foldr' (fn name) [] exps)
| otherwise = Nothing
fn name s' nms
| isUsedInStmt name s'
, Just n <- exportStatementName s' = n:nms
| otherwise = nms
entryPointVertices :: [Vertex]
entryPointVertices = catMaybes $ do
(_, k, _) <- verts
guard $ k `elem` ns
return (vertexForKey k)
where
ns = runIdent <$> is
unquote :: Text -> Text
unquote = T.drop 1 . T.dropEnd 1
isExportStatement :: JSStatement -> Bool
isExportStatement (JSAssignStatement (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ _)) _ _ _) = True
isExportStatement (JSAssignStatement (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ _) _) _ _ _) = True
isExportStatement _ = False
exportStatementName :: JSStatement -> Maybe Text
exportStatementName (JSAssignStatement (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ i)) _ _ _) = Just . T.pack $ i
exportStatementName (JSAssignStatement (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ i) _) _ _ _) = Just . unquote . T.pack $ i
exportStatementName _ = Nothing
isUsedInStmt :: Text -> JSStatement -> Bool
isUsedInStmt n (JSStatementBlock _ ss _ _) = any (isUsedInStmt n) ss
isUsedInStmt n (JSLet _ es _) = isUsedInExprs n es
isUsedInStmt n (JSClass _ _ h _ cs _ _) =
isUsedInClassHeritage n h || any (isUsedInClassElement n) cs
isUsedInStmt n (JSDoWhile _ stm _ _ e _ _) = isUsedInStmt n stm || isUsedInExpr n e
isUsedInStmt n (JSFor _ _ es1 _ es2 _ es3 _ s) = isUsedInExprs n es1 || isUsedInExprs n es2 || isUsedInExprs n es3 || isUsedInStmt n s
isUsedInStmt n (JSForIn _ _ e1 _ e2 _ s) = isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForVar _ _ _ es1 _ es2 _ es3 _ s) = isUsedInExprs n es1 || isUsedInExprs n es2 || isUsedInExprs n es3 || isUsedInStmt n s
isUsedInStmt n (JSForVarIn _ _ _ e1 _ e2 _ s) = isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForLet _ _ _ es1 _ es2 _ es3 _ s) =
isUsedInExprs n es1 || isUsedInExprs n es2 || isUsedInExprs n es3 ||
isUsedInStmt n s
isUsedInStmt n (JSForLetIn _ _ _ e1 _ e2 _ s) =
isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForLetOf _ _ _ e1 _ e2 _ s) =
isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForConst _ _ _ es1 _ es2 _ es3 _ s) =
isUsedInExprs n es1 || isUsedInExprs n es2 || isUsedInExprs n es3 || isUsedInStmt n s
isUsedInStmt n (JSForConstIn _ _ _ e1 _ e2 _ s) =
isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForConstOf _ _ _ e1 _ e2 _ s) =
isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForOf _ _ e1 _ e2 _ s) =
isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSForVarOf _ _ _ e1 _ e2 _ s) =
isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
isUsedInStmt n (JSAsyncFunction _ _ _ _ es _ (JSBlock _ ss _) _) =
isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInStmt n (JSFunction _ _ _ es _ (JSBlock _ ss _) _) =
isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInStmt n (JSGenerator _ _ _ _ es _ (JSBlock _ ss _) _) =
isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInStmt n (JSIf _ _ e _ s) = isUsedInExpr n e || isUsedInStmt n s
isUsedInStmt n (JSIfElse _ _ e _ s1 _ s2) = isUsedInExpr n e || isUsedInStmt n s1 || isUsedInStmt n s2
isUsedInStmt n (JSLabelled _ _ s) = isUsedInStmt n s
isUsedInStmt _ (JSEmptyStatement _) = False
isUsedInStmt n (JSExpressionStatement e _) = isUsedInExpr n e
isUsedInStmt n (JSAssignStatement e1 _ e2 _) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInStmt n (JSMethodCall e _ es _ _) = isUsedInExpr n e || isUsedInExprs n es
isUsedInStmt n (JSReturn _ me _) = fromMaybe False (isUsedInExpr n <$> me)
isUsedInStmt n (JSSwitch _ _ e _ _ sps _ _) = isUsedInExpr n e || any (isUsedInSwitchParts n) sps
isUsedInStmt n (JSThrow _ e _) = isUsedInExpr n e
isUsedInStmt n (JSTry _ (JSBlock _ ss _) cs f) = any (isUsedInStmt n) ss || any (isUsedInTryCatch n) cs || isUsedInFinally n f
isUsedInStmt n (JSVariable _ es _) = isUsedInExprs n es
isUsedInStmt n (JSWhile _ _ e _ s) = isUsedInExpr n e || isUsedInStmt n s
isUsedInStmt n (JSWith _ _ e _ s _) = isUsedInExpr n e || isUsedInStmt n s
isUsedInStmt _ JSBreak{} = False
isUsedInStmt _ JSConstant{} = False
isUsedInStmt _ JSContinue{} = False
isUsedInExpr :: Text -> JSExpression -> Bool
isUsedInExpr n (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ i)) = n == T.pack i
isUsedInExpr n (JSMemberDot e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSArrayLiteral _ as _) = any (isUsedInArrayElement n) as
isUsedInExpr n (JSAssignExpression e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSAwaitExpression _ e) = isUsedInExpr n e
isUsedInExpr n (JSCallExpression e _ es _) = isUsedInExpr n e || isUsedInExprs n es
isUsedInExpr n (JSCallExpressionDot e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSCallExpressionSquare e1 _ e2 _) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSClassExpression _ _ h _ cs _) =
isUsedInClassHeritage n h || any (isUsedInClassElement n) cs
isUsedInExpr n (JSExpressionBinary e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSExpressionParen _ e _) = isUsedInExpr n e
isUsedInExpr n (JSExpressionPostfix e _) = isUsedInExpr n e
isUsedInExpr n (JSExpressionTernary e1 _ e2 _ e3) = isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInExpr n e3
isUsedInExpr n (JSArrowExpression _ _ s) = isUsedInStmt n s
isUsedInExpr n (JSFunctionExpression _ _ _ _ _ (JSBlock _ ss _)) = any (isUsedInStmt n) ss
isUsedInExpr n (JSGeneratorExpression _ _ _ _ es _ (JSBlock _ ss _)) =
isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInExpr n (JSMemberExpression e _ es _) = isUsedInExpr n e || isUsedInExprs n es
isUsedInExpr n (JSMemberNew _ e _ es _) = isUsedInExpr n e || isUsedInExprs n es
isUsedInExpr n (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ i) _) = n == (unquote .T.pack $ i)
isUsedInExpr n (JSMemberSquare e1 _ e2 _) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSNewExpression _ e) = isUsedInExpr n e
isUsedInExpr n (JSObjectLiteral _ ops _) = foldrJSCommaList (\p b -> isUsedInObjectProperty n p || b) (fromCTList ops) False
where
fromCTList (JSCTLComma as _) = as
fromCTList (JSCTLNone as) = as
isUsedInExpr n (JSSpreadExpression _ e) = isUsedInExpr n e
isUsedInExpr n (JSTemplateLiteral me _ _ tps) =
any (isUsedInExpr n) me || any (\(JSTemplatePart e _ _) -> isUsedInExpr n e) tps
isUsedInExpr n (JSUnaryExpression _ e) = isUsedInExpr n e
isUsedInExpr n (JSVarInitExpression e _) = isUsedInExpr n e
isUsedInExpr _ JSIdentifier{} = False
isUsedInExpr _ JSDecimal{} = False
isUsedInExpr _ JSLiteral{} = False
isUsedInExpr _ JSHexInteger{} = False
isUsedInExpr _ JSOctal{} = False
isUsedInExpr _ JSStringLiteral{} = False
isUsedInExpr _ JSRegEx{} = False
isUsedInExpr n (JSCommaExpression e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
isUsedInExpr n (JSYieldExpression _ me) = any (isUsedInExpr n) me
isUsedInExpr n (JSYieldFromExpression _ _ e) = isUsedInExpr n e
isUsedInExprs :: Text -> JSCommaList JSExpression -> Bool
isUsedInExprs n es = foldrJSCommaList fn es False
where
fn :: JSExpression -> Bool -> Bool
fn e b = isUsedInExpr n e || b
isUsedInSwitchParts :: Text -> JSSwitchParts -> Bool
isUsedInSwitchParts n (JSCase _ e _ ss) = isUsedInExpr n e || any (isUsedInStmt n) ss
isUsedInSwitchParts n (JSDefault _ _ ss) = any (isUsedInStmt n) ss
isUsedInTryCatch :: Text -> JSTryCatch -> Bool
isUsedInTryCatch n (JSCatch _ _ e _ (JSBlock _ ss _)) = isUsedInExpr n e || any (isUsedInStmt n) ss
isUsedInTryCatch n (JSCatchIf _ _ e1 _ e2 _ (JSBlock _ ss _)) = isUsedInExpr n e1 || isUsedInExpr n e2 || any (isUsedInStmt n) ss
isUsedInFinally :: Text -> JSTryFinally -> Bool
isUsedInFinally n (JSFinally _ (JSBlock _ ss _)) = any (isUsedInStmt n) ss
isUsedInFinally _ JSNoFinally = False
isUsedInArrayElement :: Text -> JSArrayElement -> Bool
isUsedInArrayElement n (JSArrayElement e) = isUsedInExpr n e
isUsedInArrayElement _ JSArrayComma{} = False
isUsedInObjectProperty :: Text -> JSObjectProperty -> Bool
isUsedInObjectProperty n (JSPropertyNameandValue _ _ es) = any (isUsedInExpr n) es
isUsedInObjectProperty _ JSPropertyIdentRef{} = False
isUsedInObjectProperty n (JSObjectMethod m) = isUsedInMethodDefinition n m
isUsedInMethodDefinition :: Text -> JSMethodDefinition -> Bool
isUsedInMethodDefinition n (JSMethodDefinition _ _ es _ (JSBlock _ ss _))
= isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInMethodDefinition n (JSGeneratorMethodDefinition _ _ _ es _ (JSBlock _ ss _))
= isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInMethodDefinition n (JSPropertyAccessor _ _ _ es _ (JSBlock _ ss _))
= isUsedInExprs n es || any (isUsedInStmt n) ss
isUsedInClassElement :: Text -> JSClassElement -> Bool
isUsedInClassElement n (JSClassInstanceMethod m) = isUsedInMethodDefinition n m
isUsedInClassElement n (JSClassStaticMethod _ m) = isUsedInMethodDefinition n m
isUsedInClassElement _ JSClassSemi{} = False
isUsedInClassHeritage :: Text -> JSClassHeritage -> Bool
isUsedInClassHeritage n (JSExtends _ e) = isUsedInExpr n e
isUsedInClassHeritage _ JSExtendsNone = False