{-# LANGUAGE OverloadedStrings #-}
module GHC.JS.Opt.Simple (simpleOpt) where
import GHC.Prelude
import GHC.JS.Opt.Expr
import GHC.JS.Syntax
import GHC.Data.FastString
import qualified GHC.Types.Unique.Map as UM
import GHC.Types.Unique.Map (UniqMap)
import qualified GHC.Types.Unique.Set as US
import Control.Monad
import Data.Function
import Data.List (sortBy)
import Data.Maybe
import qualified Data.Semigroup as Semi
data Multiplicity = Zero | One | Many
deriving (Multiplicity -> Multiplicity -> Bool
(Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool) -> Eq Multiplicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Multiplicity -> Multiplicity -> Bool
== :: Multiplicity -> Multiplicity -> Bool
$c/= :: Multiplicity -> Multiplicity -> Bool
/= :: Multiplicity -> Multiplicity -> Bool
Eq, Eq Multiplicity
Eq Multiplicity =>
(Multiplicity -> Multiplicity -> Ordering)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Multiplicity)
-> (Multiplicity -> Multiplicity -> Multiplicity)
-> Ord Multiplicity
Multiplicity -> Multiplicity -> Bool
Multiplicity -> Multiplicity -> Ordering
Multiplicity -> Multiplicity -> Multiplicity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Multiplicity -> Multiplicity -> Ordering
compare :: Multiplicity -> Multiplicity -> Ordering
$c< :: Multiplicity -> Multiplicity -> Bool
< :: Multiplicity -> Multiplicity -> Bool
$c<= :: Multiplicity -> Multiplicity -> Bool
<= :: Multiplicity -> Multiplicity -> Bool
$c> :: Multiplicity -> Multiplicity -> Bool
> :: Multiplicity -> Multiplicity -> Bool
$c>= :: Multiplicity -> Multiplicity -> Bool
>= :: Multiplicity -> Multiplicity -> Bool
$cmax :: Multiplicity -> Multiplicity -> Multiplicity
max :: Multiplicity -> Multiplicity -> Multiplicity
$cmin :: Multiplicity -> Multiplicity -> Multiplicity
min :: Multiplicity -> Multiplicity -> Multiplicity
Ord, Int -> Multiplicity -> ShowS
[Multiplicity] -> ShowS
Multiplicity -> String
(Int -> Multiplicity -> ShowS)
-> (Multiplicity -> String)
-> ([Multiplicity] -> ShowS)
-> Show Multiplicity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Multiplicity -> ShowS
showsPrec :: Int -> Multiplicity -> ShowS
$cshow :: Multiplicity -> String
show :: Multiplicity -> String
$cshowList :: [Multiplicity] -> ShowS
showList :: [Multiplicity] -> ShowS
Show)
data VarValue = Unassigned
| AssignedOnce
| AssignedOnceKnown !JExpr
| AssignedMany
data VarDecl = NoDecl
| ArgDecl !Int
| LocalDecl !Int
deriving (VarDecl -> VarDecl -> Bool
(VarDecl -> VarDecl -> Bool)
-> (VarDecl -> VarDecl -> Bool) -> Eq VarDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarDecl -> VarDecl -> Bool
== :: VarDecl -> VarDecl -> Bool
$c/= :: VarDecl -> VarDecl -> Bool
/= :: VarDecl -> VarDecl -> Bool
Eq, Int -> VarDecl -> ShowS
[VarDecl] -> ShowS
VarDecl -> String
(Int -> VarDecl -> ShowS)
-> (VarDecl -> String) -> ([VarDecl] -> ShowS) -> Show VarDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarDecl -> ShowS
showsPrec :: Int -> VarDecl -> ShowS
$cshow :: VarDecl -> String
show :: VarDecl -> String
$cshowList :: [VarDecl] -> ShowS
showList :: [VarDecl] -> ShowS
Show)
isLocalOrArg :: VarDecl -> Bool
isLocalOrArg :: VarDecl -> Bool
isLocalOrArg (LocalDecl {}) = Bool
True
isLocalOrArg (ArgDecl {}) = Bool
True
isLocalOrArg VarDecl
_ = Bool
False
isDecl :: VarDecl -> Bool
isDecl :: VarDecl -> Bool
isDecl VarDecl
NoDecl = Bool
False
isDecl VarDecl
_ = Bool
True
instance Semi.Semigroup VarDecl where
VarDecl
NoDecl <> :: VarDecl -> VarDecl -> VarDecl
<> VarDecl
x = VarDecl
x
VarDecl
x <> VarDecl
NoDecl = VarDecl
x
ArgDecl Int
n <> ArgDecl Int
m = Int -> VarDecl
ArgDecl (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
m)
LocalDecl Int
n <> LocalDecl Int
m = Int -> VarDecl
LocalDecl (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
m)
ArgDecl Int
n <> VarDecl
_ = Int -> VarDecl
ArgDecl Int
n
VarDecl
_ <> ArgDecl Int
n = Int -> VarDecl
ArgDecl Int
n
instance Ord VarDecl where
compare :: VarDecl -> VarDecl -> Ordering
compare VarDecl
NoDecl VarDecl
NoDecl = Ordering
EQ
compare VarDecl
NoDecl VarDecl
_ = Ordering
LT
compare VarDecl
_ VarDecl
NoDecl = Ordering
GT
compare (ArgDecl Int
n) (ArgDecl Int
m) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
m
compare (ArgDecl {}) VarDecl
_ = Ordering
LT
compare VarDecl
_ (ArgDecl {}) = Ordering
GT
compare (LocalDecl Int
n) (LocalDecl Int
m) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
m
data JFunction = JFunction [Ident] JStat
instance Semi.Semigroup VarValue where
VarValue
Unassigned <> :: VarValue -> VarValue -> VarValue
<> VarValue
x = VarValue
x
VarValue
x <> VarValue
Unassigned = VarValue
x
VarValue
_ <> VarValue
_ = VarValue
AssignedMany
instance Monoid VarValue where
mempty :: VarValue
mempty = VarValue
Unassigned
mappend :: VarValue -> VarValue -> VarValue
mappend = VarValue -> VarValue -> VarValue
forall a. Semigroup a => a -> a -> a
(Semi.<>)
instance Semigroup Multiplicity where
Multiplicity
Zero <> :: Multiplicity -> Multiplicity -> Multiplicity
<> Multiplicity
x = Multiplicity
x
Multiplicity
x <> Multiplicity
Zero = Multiplicity
x
Multiplicity
_ <> Multiplicity
_ = Multiplicity
Many
instance Monoid Multiplicity where
mempty :: Multiplicity
mempty = Multiplicity
Zero
mappend :: Multiplicity -> Multiplicity -> Multiplicity
mappend = Multiplicity -> Multiplicity -> Multiplicity
forall a. Semigroup a => a -> a -> a
(Semi.<>)
data VarUsage = VarUsage
{ VarUsage -> Multiplicity
varUsed :: !Multiplicity
, VarUsage -> VarValue
varAssigned :: !VarValue
, VarUsage -> VarDecl
varDeclared :: !VarDecl
, VarUsage -> Bool
varDeepDeclared :: !Bool
}
assignedMultiple :: VarUsage -> Bool
assignedMultiple :: VarUsage -> Bool
assignedMultiple VarUsage { varAssigned :: VarUsage -> VarValue
varAssigned = VarValue
AssignedMany } = Bool
True
assignedMultiple VarUsage
_ = Bool
False
data SimpleRewrite = SimpleRewrite
{ SimpleRewrite -> UniqMap Ident Ident
renameVar :: UniqMap Ident Ident
, SimpleRewrite -> UniqMap Ident VarUsage
varUsage :: UniqMap Ident VarUsage
}
instance Semigroup VarUsage where
VarUsage
x <> :: VarUsage -> VarUsage -> VarUsage
<> VarUsage
y = VarUsage
{ varUsed :: Multiplicity
varUsed = VarUsage -> Multiplicity
varUsed VarUsage
x Multiplicity -> Multiplicity -> Multiplicity
forall a. Semigroup a => a -> a -> a
Semi.<> VarUsage -> Multiplicity
varUsed VarUsage
y
, varAssigned :: VarValue
varAssigned = VarUsage -> VarValue
varAssigned VarUsage
x VarValue -> VarValue -> VarValue
forall a. Semigroup a => a -> a -> a
Semi.<> VarUsage -> VarValue
varAssigned VarUsage
y
, varDeclared :: VarDecl
varDeclared = VarUsage -> VarDecl
varDeclared VarUsage
x VarDecl -> VarDecl -> VarDecl
forall a. Semigroup a => a -> a -> a
Semi.<> VarUsage -> VarDecl
varDeclared VarUsage
y
, varDeepDeclared :: Bool
varDeepDeclared = VarUsage -> Bool
varDeepDeclared VarUsage
x Bool -> Bool -> Bool
|| VarUsage -> Bool
varDeepDeclared VarUsage
y
}
instance Monoid VarUsage where
mempty :: VarUsage
mempty = Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
Unassigned VarDecl
NoDecl Bool
False
disableOpt :: Bool
disableOpt :: Bool
disableOpt = Bool
False
simpleOpt :: JStat -> JStat
simpleOpt :: JStat -> JStat
simpleOpt JStat
x | Bool
disableOpt = JStat
x
simpleOpt (BlockStat [JStat]
xs) = [JStat] -> JStat
BlockStat ((JStat -> JStat) -> [JStat] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map JStat -> JStat
simpleOpt [JStat]
xs)
simpleOpt (AssignStat JExpr
lhs AOp
AssignOp (ValExpr (JFunc [Ident]
args JStat
body))) =
let JFunction [Ident]
args' JStat
body' = JFunction -> JFunction
simpleOptFunction ([Ident] -> JStat -> JFunction
JFunction [Ident]
args JStat
body)
in JExpr -> AOp -> JExpr -> JStat
AssignStat JExpr
lhs AOp
AssignOp (JVal -> JExpr
ValExpr ([Ident] -> JStat -> JVal
JFunc [Ident]
args' JStat
body'))
simpleOpt (FuncStat Ident
name [Ident]
args JStat
body) =
let JFunction [Ident]
args' JStat
body' = JFunction -> JFunction
simpleOptFunction ([Ident] -> JStat -> JFunction
JFunction [Ident]
args JStat
body)
in Ident -> [Ident] -> JStat -> JStat
FuncStat Ident
name [Ident]
args' JStat
body'
simpleOpt JStat
s = JStat
s
simpleOptFunction :: JFunction -> JFunction
simpleOptFunction :: JFunction -> JFunction
simpleOptFunction JFunction
jf = JFunction
s_opt
where
s_opt :: JFunction
s_opt = JFunction -> JFunction
functionOptExprs (JFunction -> JFunction) -> JFunction -> JFunction
forall a b. (a -> b) -> a -> b
$ JFunction
-> (SimpleRewrite -> JFunction) -> Maybe SimpleRewrite -> JFunction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JFunction
jf (SimpleRewrite -> JFunction -> JFunction
`simpleRewrite` JFunction
s_opt0) Maybe SimpleRewrite
mb_rw
mb_rw :: Maybe SimpleRewrite
mb_rw = Bool -> AnalysisResult -> Maybe SimpleRewrite
mkRewrite Bool
True (JFunction -> AnalysisResult
simpleAnalyze JFunction
s_opt0)
s_opt0 :: JFunction
s_opt0 = JFunction -> JFunction
functionOptExprs (JFunction -> JFunction) -> JFunction -> JFunction
forall a b. (a -> b) -> a -> b
$ JFunction
-> (SimpleRewrite -> JFunction) -> Maybe SimpleRewrite -> JFunction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JFunction
jf (SimpleRewrite -> JFunction -> JFunction
`simpleRewrite` JFunction
jf) Maybe SimpleRewrite
mb_rw0
mb_rw0 :: Maybe SimpleRewrite
mb_rw0 = Bool -> AnalysisResult -> Maybe SimpleRewrite
mkRewrite Bool
False (JFunction -> AnalysisResult
simpleAnalyze JFunction
jf)
functionOptExprs :: JFunction -> JFunction
functionOptExprs :: JFunction -> JFunction
functionOptExprs (JFunction [Ident]
args JStat
s) = [Ident] -> JStat -> JFunction
JFunction [Ident]
args (JStat -> JStat
optExprs JStat
s)
newLocals :: [Ident]
newLocals :: [Ident]
newLocals = (Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Ident -> Bool) -> Ident -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Bool
isReserved ) ([Ident] -> [Ident]) -> [Ident] -> [Ident]
forall a b. (a -> b) -> a -> b
$
(String -> Ident) -> [String] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI (FastString -> Ident) -> (String -> FastString) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString) ([String] -> [Ident]) -> [String] -> [Ident]
forall a b. (a -> b) -> a -> b
$
(Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) String
chars0 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Int -> [String]) -> [Int] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [String]
mkIdents [Int
1..]
where
mkIdents :: Int -> [String]
mkIdents Int
n = [Char
c0Char -> ShowS
forall a. a -> [a] -> [a]
:String
cs | Char
c0 <- String
chars0, String
cs <- Int -> String -> [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n String
chars]
chars0 :: String
chars0 = [Char
'a'..Char
'z']String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'Z']
chars :: String
chars = String
chars0String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'0'..Char
'9']
isReserved :: Ident -> Bool
isReserved (TxtI FastString
i) = FastString
i FastString -> UniqSet FastString -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`US.elementOfUniqSet` UniqSet FastString
reservedSet
reservedSet :: UniqSet FastString
reservedSet = [FastString] -> UniqSet FastString
forall a. Uniquable a => [a] -> UniqSet a
US.mkUniqSet [FastString]
reserved
reserved :: [FastString]
reserved = [
FastString
"abstract", FastString
"arguments", FastString
"await", FastString
"boolean"
, FastString
"break", FastString
"byte", FastString
"case", FastString
"catch"
, FastString
"char", FastString
"class", FastString
"const", FastString
"continue"
, FastString
"debugger", FastString
"default", FastString
"delete", FastString
"do"
, FastString
"double", FastString
"else", FastString
"enum", FastString
"eval"
, FastString
"export", FastString
"extends", FastString
"false", FastString
"final"
, FastString
"finally", FastString
"float", FastString
"for", FastString
"function"
, FastString
"goto", FastString
"if", FastString
"implements", FastString
"import"
, FastString
"in", FastString
"instanceof", FastString
"int", FastString
"interface"
, FastString
"let", FastString
"long", FastString
"native", FastString
"new"
, FastString
"null", FastString
"package", FastString
"private", FastString
"protected"
, FastString
"public", FastString
"return", FastString
"short", FastString
"static"
, FastString
"super", FastString
"switch", FastString
"synchronized", FastString
"this"
, FastString
"throw", FastString
"throws", FastString
"transient", FastString
"true"
, FastString
"try", FastString
"typeof", FastString
"var", FastString
"void"
, FastString
"volatile", FastString
"while", FastString
"with", FastString
"yield"
, FastString
"as", FastString
"async", FastString
"from", FastString
"get"
, FastString
"of", FastString
"NaN", FastString
"prototype", FastString
"undefined"
]
mkRewrite :: Bool -> AnalysisResult -> Maybe SimpleRewrite
mkRewrite :: Bool -> AnalysisResult -> Maybe SimpleRewrite
mkRewrite Bool
do_rename AnalysisResult
a
| AnalysisResult -> Bool
arBailout AnalysisResult
a = Maybe SimpleRewrite
forall a. Maybe a
Nothing
| Bool
otherwise = SimpleRewrite -> Maybe SimpleRewrite
forall a. a -> Maybe a
Just (SimpleRewrite -> Maybe SimpleRewrite)
-> SimpleRewrite -> Maybe SimpleRewrite
forall a b. (a -> b) -> a -> b
$
SimpleRewrite { renameVar :: UniqMap Ident Ident
renameVar = if Bool
do_rename
then [(Ident, Ident)] -> UniqMap Ident Ident
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
UM.listToUniqMap ([Ident] -> [Ident] -> [(Ident, Ident)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
localVars [Ident]
newVars)
else UniqMap Ident Ident
forall k a. UniqMap k a
UM.emptyUniqMap
, varUsage :: UniqMap Ident VarUsage
varUsage = UniqMap Ident VarUsage
vu
}
where
vu :: UM.UniqMap Ident VarUsage
vu :: UniqMap Ident VarUsage
vu = AnalysisResult -> UniqMap Ident VarUsage
arVarUsage AnalysisResult
a
localVars :: [Ident]
localVars :: [Ident]
localVars =
((Ident, VarDecl) -> Ident) -> [(Ident, VarDecl)] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, VarDecl) -> Ident
forall a b. (a, b) -> a
fst
([(Ident, VarDecl)] -> [Ident])
-> ([(Ident, VarUsage)] -> [(Ident, VarDecl)])
-> [(Ident, VarUsage)]
-> [Ident]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ident, VarDecl) -> (Ident, VarDecl) -> Ordering)
-> [(Ident, VarDecl)] -> [(Ident, VarDecl)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (VarDecl -> VarDecl -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (VarDecl -> VarDecl -> Ordering)
-> ((Ident, VarDecl) -> VarDecl)
-> (Ident, VarDecl)
-> (Ident, VarDecl)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Ident, VarDecl) -> VarDecl
forall a b. (a, b) -> b
snd)
([(Ident, VarDecl)] -> [(Ident, VarDecl)])
-> ([(Ident, VarUsage)] -> [(Ident, VarDecl)])
-> [(Ident, VarUsage)]
-> [(Ident, VarDecl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ident, VarUsage) -> (Ident, VarDecl))
-> [(Ident, VarUsage)] -> [(Ident, VarDecl)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Ident
v, VarUsage
u) -> (Ident
v, VarUsage -> VarDecl
varDeclared VarUsage
u))
([(Ident, VarUsage)] -> [(Ident, VarDecl)])
-> ([(Ident, VarUsage)] -> [(Ident, VarUsage)])
-> [(Ident, VarUsage)]
-> [(Ident, VarDecl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ident, VarUsage) -> Bool)
-> [(Ident, VarUsage)] -> [(Ident, VarUsage)]
forall a. (a -> Bool) -> [a] -> [a]
filter (VarDecl -> Bool
isDecl (VarDecl -> Bool)
-> ((Ident, VarUsage) -> VarDecl) -> (Ident, VarUsage) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarUsage -> VarDecl
varDeclared (VarUsage -> VarDecl)
-> ((Ident, VarUsage) -> VarUsage) -> (Ident, VarUsage) -> VarDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident, VarUsage) -> VarUsage
forall a b. (a, b) -> b
snd)
([(Ident, VarUsage)] -> [Ident]) -> [(Ident, VarUsage)] -> [Ident]
forall a b. (a -> b) -> a -> b
$ UniqMap Ident VarUsage -> [(Ident, VarUsage)]
forall k a. UniqMap k a -> [(k, a)]
UM.nonDetUniqMapToList UniqMap Ident VarUsage
vu
blockedNames :: US.UniqSet Ident
blockedNames :: UniqSet Ident
blockedNames =
[Ident] -> UniqSet Ident
forall a. Uniquable a => [a] -> UniqSet a
US.mkUniqSet ([Ident] -> UniqSet Ident) -> [Ident] -> UniqSet Ident
forall a b. (a -> b) -> a -> b
$
((Ident, VarUsage) -> Ident) -> [(Ident, VarUsage)] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, VarUsage) -> Ident
forall a b. (a, b) -> a
fst (
((Ident, VarUsage) -> Bool)
-> [(Ident, VarUsage)] -> [(Ident, VarUsage)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Ident
_k,VarUsage
v) -> (Bool -> Bool
not (Bool -> Bool) -> (VarDecl -> Bool) -> VarDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarDecl -> Bool
isDecl) (VarUsage -> VarDecl
varDeclared VarUsage
v) Bool -> Bool -> Bool
|| VarUsage -> Bool
varDeepDeclared VarUsage
v)
(UniqMap Ident VarUsage -> [(Ident, VarUsage)]
forall k a. UniqMap k a -> [(k, a)]
UM.nonDetUniqMapToList UniqMap Ident VarUsage
vu))
newVars :: [Ident]
newVars :: [Ident]
newVars = (Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Ident -> Bool) -> Ident -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> UniqSet Ident -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`US.elementOfUniqSet` UniqSet Ident
blockedNames)) [Ident]
newLocals
simpleRewrite :: SimpleRewrite -> JFunction -> JFunction
simpleRewrite :: SimpleRewrite -> JFunction -> JFunction
simpleRewrite SimpleRewrite
rw (JFunction [Ident]
args JStat
stat)= [Ident] -> JStat -> JFunction
JFunction ((Ident -> Ident) -> [Ident] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Ident
varReplace [Ident]
args) (JStat -> JStat
go JStat
stat)
where
zeroUsed :: JExpr -> Bool
zeroUsed :: JExpr -> Bool
zeroUsed (ValExpr (JVar Ident
v)) =
Bool -> (VarUsage -> Bool) -> Maybe VarUsage -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
Zero) (Multiplicity -> Bool)
-> (VarUsage -> Multiplicity) -> VarUsage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarUsage -> Multiplicity
varUsed) (UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
v) Bool -> Bool -> Bool
&&
Bool -> (VarUsage -> Bool) -> Maybe VarUsage -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (VarDecl -> Bool
isDecl (VarDecl -> Bool) -> (VarUsage -> VarDecl) -> VarUsage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarUsage -> VarDecl
varDeclared) (UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
v)
zeroUsed JExpr
_ = Bool
False
varReplace :: Ident -> Ident
varReplace :: Ident -> Ident
varReplace Ident
v = Ident -> Maybe Ident -> Ident
forall a. a -> Maybe a -> a
fromMaybe Ident
v (UniqMap Ident Ident -> Ident -> Maybe Ident
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident Ident
renameVar SimpleRewrite
rw) Ident
v)
mayBeFloated :: JExpr -> Bool
mayBeFloated :: JExpr -> Bool
mayBeFloated (ValExpr JVal
v) = JVal -> Bool
mayBeFloatedV JVal
v
mayBeFloated (SelExpr JExpr
_e Ident
_) = Bool
False
mayBeFloated (IdxExpr JExpr
_e1 JExpr
_e2) = Bool
False
mayBeFloated (InfixExpr Op
_ JExpr
e1 JExpr
e2)= JExpr -> Bool
mayBeFloated JExpr
e1 Bool -> Bool -> Bool
&& JExpr -> Bool
mayBeFloated JExpr
e2
mayBeFloated (UOpExpr UOp
_ JExpr
_e) = Bool
False
mayBeFloated (IfExpr JExpr
e1 JExpr
e2 JExpr
e3) = JExpr -> Bool
mayBeFloated JExpr
e1 Bool -> Bool -> Bool
&&
JExpr -> Bool
mayBeFloated JExpr
e2 Bool -> Bool -> Bool
&&
JExpr -> Bool
mayBeFloated JExpr
e3
mayBeFloated (ApplExpr JExpr
e [JExpr]
es)
| ValExpr (JVar (TxtI FastString
i)) <- JExpr
e, FastString -> Bool
isClosureAllocator FastString
i = (JExpr -> Bool) -> [JExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all JExpr -> Bool
mayBeFloated [JExpr]
es
| Bool
otherwise = Bool
False
mayBeFloatedV :: JVal -> Bool
mayBeFloatedV :: JVal -> Bool
mayBeFloatedV (JVar Ident
v)
| Just VarUsage
vu <- UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
v
= VarDecl -> Bool
isDecl (VarUsage -> VarDecl
varDeclared VarUsage
vu) Bool -> Bool -> Bool
&& Bool -> Bool
not (VarUsage -> Bool
assignedMultiple VarUsage
vu)
| Bool
otherwise = Bool
False
mayBeFloatedV (JList [JExpr]
es) = (JExpr -> Bool) -> [JExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all JExpr -> Bool
mayBeFloated [JExpr]
es
mayBeFloatedV (JDouble {}) = Bool
True
mayBeFloatedV (JInt {}) = Bool
True
mayBeFloatedV (JStr {}) = Bool
True
mayBeFloatedV (JRegEx {}) = Bool
True
mayBeFloatedV (JBool {}) = Bool
True
mayBeFloatedV (JHash UniqMap FastString JExpr
ps) = ((FastString, JExpr) -> Bool) -> [(FastString, JExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (JExpr -> Bool
mayBeFloated (JExpr -> Bool)
-> ((FastString, JExpr) -> JExpr) -> (FastString, JExpr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString, JExpr) -> JExpr
forall a b. (a, b) -> b
snd)
(UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
UM.nonDetUniqMapToList UniqMap FastString JExpr
ps)
mayBeFloatedV (JFunc {}) = Bool
False
mayDuplicate :: JExpr -> Bool
mayDuplicate :: JExpr -> Bool
mayDuplicate (ValExpr (JVar Ident
i))
| Just VarUsage
vu <- (UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
i)
= VarDecl -> Bool
isLocalOrArg (VarUsage -> VarDecl
varDeclared VarUsage
vu)
mayDuplicate (ValExpr (JInt Integer
n)) = Integer -> Integer
forall a. Num a => a -> a
abs Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1000000
mayDuplicate (ValExpr (JDouble {})) = Bool
True
mayDuplicate JExpr
_ = Bool
False
zeroAssigned :: Ident -> Bool
zeroAssigned :: Ident -> Bool
zeroAssigned Ident
v
| Just VarUsage
vu <- UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
v
= case VarUsage -> VarValue
varAssigned VarUsage
vu of
VarValue
Unassigned -> Bool
True
VarValue
_ -> Bool
False
| Bool
otherwise = Bool
False
assignedAtMostOnce :: Ident -> Bool
assignedAtMostOnce :: Ident -> Bool
assignedAtMostOnce Ident
v
| Just VarUsage
vu <- UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
v =
case VarUsage -> VarValue
varAssigned VarUsage
vu of
VarValue
Unassigned -> Bool
True
VarValue
AssignedOnce -> Bool
True
AssignedOnceKnown {} -> Bool
True
VarValue
AssignedMany -> Bool
False
| Bool
otherwise = Bool
False
go :: JStat -> JStat
go :: JStat -> JStat
go (DeclStat Ident
v Maybe JExpr
mb_e)
| JExpr -> Bool
zeroUsed (JVal -> JExpr
ValExpr (Ident -> JVal
JVar Ident
v)) =
case Maybe JExpr
mb_e of
Maybe JExpr
Nothing | Ident -> Bool
zeroAssigned Ident
v -> [JStat] -> JStat
BlockStat []
| Bool
otherwise -> Ident -> Maybe JExpr -> JStat
DeclStat (Ident -> Ident
varReplace Ident
v) Maybe JExpr
forall a. Maybe a
Nothing
Just JExpr
e | Bool -> Bool
not (JExpr -> Bool
mayHaveSideEffects JExpr
e) Bool -> Bool -> Bool
&& Ident -> Bool
assignedAtMostOnce Ident
v
-> [JStat] -> JStat
BlockStat []
| Bool
otherwise -> Ident -> Maybe JExpr -> JStat
DeclStat (Ident -> Ident
varReplace Ident
v) (JExpr -> Maybe JExpr
forall a. a -> Maybe a
Just (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e))
| Bool
otherwise = Ident -> Maybe JExpr -> JStat
DeclStat (Ident -> Ident
varReplace Ident
v) ((JExpr -> JExpr) -> Maybe JExpr -> Maybe JExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> JExpr -> JExpr
goE Bool
True) Maybe JExpr
mb_e)
go (AssignStat JExpr
lhs AOp
aop JExpr
e)
| ValExpr (JVar Ident
i) <- JExpr
lhs, Ident -> AOp -> JExpr -> Bool
isTrivialAssignment Ident
i AOp
aop JExpr
e = [JStat] -> JStat
BlockStat []
| JExpr -> Bool
zeroUsed JExpr
lhs Bool -> Bool -> Bool
&& Bool -> Bool
not (JExpr -> Bool
mayHaveSideEffects JExpr
e) = [JStat] -> JStat
BlockStat []
| JExpr -> Bool
zeroUsed JExpr
lhs = JExpr -> AOp -> JExpr -> JStat
AssignStat (Bool -> JExpr -> JExpr
goE Bool
False JExpr
lhs) AOp
aop (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e)
| Bool
otherwise = JExpr -> AOp -> JExpr -> JStat
AssignStat (Bool -> JExpr -> JExpr
goE Bool
False JExpr
lhs) AOp
aop (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e)
go (ReturnStat JExpr
e) = JExpr -> JStat
ReturnStat (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e)
go (BlockStat [JStat]
ss) = [JStat] -> JStat
flattenBlock ((JStat -> JStat) -> [JStat] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map JStat -> JStat
go [JStat]
ss)
go (IfStat JExpr
e JStat
s1 JStat
s2) = JExpr -> JStat -> JStat -> JStat
IfStat (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e) (JStat -> JStat
go JStat
s1) (JStat -> JStat
go JStat
s2)
go (WhileStat Bool
b JExpr
e JStat
s) = Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e) (JStat -> JStat
go JStat
s)
go (ForStat JStat
s1 JExpr
e JStat
s2 JStat
s3) = JStat -> JExpr -> JStat -> JStat -> JStat
ForStat (JStat -> JStat
go JStat
s1) (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e) (JStat -> JStat
go JStat
s2) (JStat -> JStat
go JStat
s3)
go (ForInStat Bool
b Ident
v JExpr
e JStat
s) = Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b (Ident -> Ident
varReplace Ident
v) (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e) (JStat -> JStat
go JStat
s)
go (SwitchStat JExpr
e [(JExpr, JStat)]
cases JStat
s) = JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e)
(((JExpr, JStat) -> (JExpr, JStat))
-> [(JExpr, JStat)] -> [(JExpr, JStat)]
forall a b. (a -> b) -> [a] -> [b]
map (\(JExpr
c,JStat
cs) -> (JExpr
c, JStat -> JStat
go JStat
cs)) [(JExpr, JStat)]
cases)
(JStat -> JStat
go JStat
s)
go (TryStat JStat
s1 Ident
v JStat
s2 JStat
s3) = JStat -> Ident -> JStat -> JStat -> JStat
TryStat (JStat -> JStat
go JStat
s1) (Ident -> Ident
varReplace Ident
v) (JStat -> JStat
go JStat
s2) (JStat -> JStat
go JStat
s3)
go (ApplStat JExpr
e [JExpr]
es) = JExpr -> [JExpr] -> JStat
ApplStat (Bool -> JExpr -> JExpr
goE Bool
True JExpr
e) ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> JExpr -> JExpr
goE Bool
True) [JExpr]
es)
go (UOpStat UOp
uop JExpr
e) = UOp -> JExpr -> JStat
UOpStat UOp
uop (Bool -> JExpr -> JExpr
goE Bool
False JExpr
e)
go (LabelStat JLabel
lbl JStat
s) = JLabel -> JStat -> JStat
LabelStat JLabel
lbl (JStat -> JStat
go JStat
s)
go s :: JStat
s@(BreakStat {}) = JStat
s
go s :: JStat
s@(ContinueStat {}) = JStat
s
go (FuncStat Ident
i [Ident]
args JStat
s) = Ident -> [Ident] -> JStat -> JStat
FuncStat Ident
i ((Ident -> Ident) -> [Ident] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Ident
varReplace [Ident]
args) (JStat -> JStat
go JStat
s)
goE :: Bool -> JExpr -> JExpr
goE :: Bool -> JExpr -> JExpr
goE Bool
rhs (ValExpr (JVar Ident
v))
| Bool
rhs
, Just VarUsage
vu <- UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (SimpleRewrite -> UniqMap Ident VarUsage
varUsage SimpleRewrite
rw) Ident
v
, AssignedOnceKnown JExpr
ee <- VarUsage -> VarValue
varAssigned VarUsage
vu
, VarUsage -> Multiplicity
varUsed VarUsage
vu Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
One Bool -> Bool -> Bool
|| JExpr -> Bool
mayDuplicate JExpr
ee
, VarDecl -> Bool
isDecl (VarUsage -> VarDecl
varDeclared VarUsage
vu)
, JExpr -> Bool
mayBeFloated JExpr
ee
= Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
ee
goE Bool
_rhs (ValExpr JVal
v) = JVal -> JExpr
ValExpr (JVal -> JVal
goV JVal
v)
goE Bool
rhs (SelExpr JExpr
e Ident
i) = JExpr -> Ident -> JExpr
SelExpr (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e) Ident
i
goE Bool
rhs (IdxExpr JExpr
e1 JExpr
e2) = JExpr -> JExpr -> JExpr
IdxExpr (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e1) (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e2)
goE Bool
rhs (InfixExpr Op
op JExpr
e1 JExpr
e2) = Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
op (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e1) (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e2)
goE Bool
rhs (UOpExpr UOp
op JExpr
e) = UOp -> JExpr -> JExpr
UOpExpr UOp
op (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e)
goE Bool
rhs (IfExpr JExpr
e1 JExpr
e2 JExpr
e3) = JExpr -> JExpr -> JExpr -> JExpr
IfExpr (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e1) (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e2) (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e3)
goE Bool
rhs (ApplExpr JExpr
e [JExpr]
es) = JExpr -> [JExpr] -> JExpr
ApplExpr (Bool -> JExpr -> JExpr
goE Bool
rhs JExpr
e) ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> JExpr -> JExpr
goE Bool
rhs) [JExpr]
es)
goV :: JVal -> JVal
goV :: JVal -> JVal
goV (JVar Ident
v) = Ident -> JVal
JVar (Ident -> Ident
varReplace Ident
v)
goV (JList [JExpr]
es) = [JExpr] -> JVal
JList ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> JExpr -> JExpr
goE Bool
True) [JExpr]
es)
goV (JHash UniqMap FastString JExpr
ps) = UniqMap FastString JExpr -> JVal
JHash ((JExpr -> JExpr)
-> UniqMap FastString JExpr -> UniqMap FastString JExpr
forall a b.
(a -> b) -> UniqMap FastString a -> UniqMap FastString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> JExpr -> JExpr
goE Bool
True) UniqMap FastString JExpr
ps)
goV v :: JVal
v@(JFunc {}) = JVal
v
goV v :: JVal
v@(JDouble {}) = JVal
v
goV v :: JVal
v@(JInt {}) = JVal
v
goV v :: JVal
v@(JStr {}) = JVal
v
goV v :: JVal
v@(JRegEx {}) = JVal
v
goV v :: JVal
v@(JBool {}) = JVal
v
flattenBlock :: [JStat] -> JStat
flattenBlock :: [JStat] -> JStat
flattenBlock [JStat]
stats =
case (JStat -> Bool) -> [JStat] -> [JStat]
forall a. (a -> Bool) -> [a] -> [a]
filter (JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
/= [JStat] -> JStat
BlockStat []) [JStat]
stats of
[] -> [JStat] -> JStat
BlockStat []
[JStat
s] -> JStat
s
[JStat]
ss -> [JStat] -> JStat
BlockStat [JStat]
ss
data AnalysisResult = AnalysisResult
{ AnalysisResult -> Bool
arBailout :: !Bool
, AnalysisResult -> UniqMap Ident VarUsage
arVarUsage :: !(UniqMap Ident VarUsage)
, AnalysisResult -> Int
arDeclaredCount :: !Int
}
simpleAnalyze :: JFunction -> AnalysisResult
simpleAnalyze :: JFunction -> AnalysisResult
simpleAnalyze (JFunction [Ident]
args JStat
body) = Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
False (Bool -> UniqMap Ident VarUsage -> Int -> AnalysisResult
AnalysisResult Bool
False UniqMap Ident VarUsage
start Int
0) JStat
body
where
start :: UniqMap Ident VarUsage
start :: UniqMap Ident VarUsage
start = [(Ident, VarUsage)] -> UniqMap Ident VarUsage
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
UM.listToUniqMap
([(Ident, VarUsage)] -> UniqMap Ident VarUsage)
-> [(Ident, VarUsage)] -> UniqMap Ident VarUsage
forall a b. (a -> b) -> a -> b
$ (Int -> Ident -> (Ident, VarUsage))
-> [Int] -> [Ident] -> [(Ident, VarUsage)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n Ident
v -> (Ident
v, Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
Unassigned (Int -> VarDecl
ArgDecl Int
n) Bool
False))
[Int
0..]
[Ident]
args
add :: Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add :: Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
i VarUsage
vu AnalysisResult
m = AnalysisResult
m { arVarUsage = UM.addToUniqMap_C (Semi.<>) (arVarUsage m) i vu }
declare :: Bool -> Ident -> Maybe JExpr -> AnalysisResult -> AnalysisResult
declare :: Bool -> Ident -> Maybe JExpr -> AnalysisResult -> AnalysisResult
declare Bool
True Ident
i Maybe JExpr
_assign AnalysisResult
m =
let vu :: VarUsage
vu = Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
AssignedMany VarDecl
NoDecl Bool
True
in AnalysisResult
m { arVarUsage = UM.addToUniqMap_C (Semi.<>) (arVarUsage m) i vu}
declare Bool
False Ident
i Maybe JExpr
assign AnalysisResult
m =
let count :: Int
count = AnalysisResult -> Int
arDeclaredCount AnalysisResult
m
!newCount :: Int
newCount
| Just (VarUsage Multiplicity
_ VarValue
_ (LocalDecl Int
_) Bool
_) <-
UniqMap Ident VarUsage -> Ident -> Maybe VarUsage
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
UM.lookupUniqMap (AnalysisResult -> UniqMap Ident VarUsage
arVarUsage AnalysisResult
m) Ident
i = Int
count
| Bool
otherwise = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
vassign :: VarValue
vassign | Just JExpr
e <- Maybe JExpr
assign = JExpr -> VarValue
AssignedOnceKnown JExpr
e
| Bool
otherwise = VarValue
Unassigned
!vu :: VarUsage
vu = Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
vassign (Int -> VarDecl
LocalDecl Int
count) Bool
False
in AnalysisResult
m { arDeclaredCount = newCount
, arVarUsage = UM.addToUniqMap_C (Semi.<>) (arVarUsage m) i vu
}
go :: Bool -> AnalysisResult -> JStat -> AnalysisResult
go :: Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep AnalysisResult
u (DeclStat Ident
v Maybe JExpr
mb_e) =
case Maybe JExpr
mb_e of
Maybe JExpr
Nothing -> Bool -> Ident -> Maybe JExpr -> AnalysisResult -> AnalysisResult
declare Bool
deep Ident
v Maybe JExpr
mb_e AnalysisResult
u
Just JExpr
e -> Bool -> Ident -> Maybe JExpr -> AnalysisResult -> AnalysisResult
declare Bool
deep Ident
v Maybe JExpr
mb_e (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e)
go Bool
_deep AnalysisResult
u (AssignStat (ValExpr (JVar Ident
v)) AOp
aop JExpr
e) =
let use :: Multiplicity
use = case AOp
aop of
AOp
AssignOp -> Multiplicity
Zero
AOp
_ -> Multiplicity
One
in Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
use (JExpr -> VarValue
AssignedOnceKnown JExpr
e) VarDecl
NoDecl Bool
False) (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e)
go Bool
_deep AnalysisResult
u (AssignStat JExpr
lhs AOp
_aop JExpr
rhs) = AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
lhs) JExpr
rhs
go Bool
_deep AnalysisResult
u (ReturnStat JExpr
e) = AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e
go Bool
deep AnalysisResult
u (BlockStat [JStat]
ss) = (AnalysisResult -> JStat -> AnalysisResult)
-> AnalysisResult -> [JStat] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep) AnalysisResult
u [JStat]
ss
go Bool
deep AnalysisResult
u (IfStat JExpr
e JStat
s1 JStat
s2) = Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e) JStat
s1) JStat
s2
go Bool
deep AnalysisResult
u (WhileStat Bool
_b JExpr
e JStat
s) = Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e) JStat
s
go Bool
deep AnalysisResult
u (ForStat JStat
s1 JExpr
e JStat
s2 JStat
s3)
= Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (AnalysisResult -> JExpr -> AnalysisResult
goE (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep AnalysisResult
u JStat
s1) JExpr
e) JStat
s2) JStat
s3
go Bool
deep AnalysisResult
u (ForInStat Bool
b Ident
v JExpr
e JStat
s) =
let !u' :: AnalysisResult
u' = if Bool
b then Bool -> Ident -> Maybe JExpr -> AnalysisResult -> AnalysisResult
declare Bool
deep Ident
v Maybe JExpr
forall a. Maybe a
Nothing AnalysisResult
u else AnalysisResult
u
in Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
AssignedMany VarDecl
NoDecl Bool
True)
(Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u' JExpr
e) JStat
s) JStat
s)
go Bool
deep AnalysisResult
u (SwitchStat JExpr
e [(JExpr, JStat)]
cases JStat
s)
= Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (AnalysisResult -> JExpr -> AnalysisResult
goE ((AnalysisResult -> JStat -> AnalysisResult)
-> AnalysisResult -> [JStat] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep) AnalysisResult
u (((JExpr, JStat) -> JStat) -> [(JExpr, JStat)] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map (JExpr, JStat) -> JStat
forall a b. (a, b) -> b
snd [(JExpr, JStat)]
cases)) JExpr
e) JStat
s
go Bool
deep AnalysisResult
u (TryStat JStat
s1 Ident
v JStat
s2 JStat
s3)
= Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
AssignedMany VarDecl
NoDecl Bool
True)
(Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep (Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep AnalysisResult
u JStat
s1) JStat
s2) JStat
s3)
go Bool
_deep AnalysisResult
u (ApplStat JExpr
e [JExpr]
es)
| (ValExpr (JVar (TxtI FastString
i))) <- JExpr
e, FastString
i FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
"eval" = AnalysisResult
u { arBailout = True }
| Bool
otherwise = (AnalysisResult -> JExpr -> AnalysisResult)
-> AnalysisResult -> [JExpr] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e) [JExpr]
es
go Bool
_deep AnalysisResult
u (UOpStat UOp
op JExpr
e)
| ValExpr (JVar Ident
v) <- JExpr
e
, UOp
op UOp -> [UOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UOp
PreIncOp, UOp
PostIncOp, UOp
PreDecOp, UOp
PostDecOp] =
Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
One VarValue
AssignedOnce VarDecl
NoDecl Bool
False) AnalysisResult
u
| Bool
otherwise = AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e
go Bool
deep AnalysisResult
u (LabelStat JLabel
_ JStat
s) = Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
deep AnalysisResult
u JStat
s
go Bool
_deep AnalysisResult
u (BreakStat Maybe JLabel
_) = AnalysisResult
u
go Bool
_deep AnalysisResult
u (ContinueStat Maybe JLabel
_) = AnalysisResult
u
go Bool
_deep AnalysisResult
u (FuncStat Ident
_ [Ident]
vs JStat
s)
= Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
True ((AnalysisResult -> Ident -> AnalysisResult)
-> AnalysisResult -> [Ident] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\AnalysisResult
u Ident
v -> Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
AssignedOnce VarDecl
NoDecl Bool
True) AnalysisResult
u) AnalysisResult
u [Ident]
vs) JStat
s
goE :: AnalysisResult -> JExpr -> AnalysisResult
goE :: AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u (ValExpr JVal
v) = AnalysisResult -> JVal -> AnalysisResult
goV AnalysisResult
u JVal
v
goE AnalysisResult
u (SelExpr JExpr
e Ident
_i) = AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e
goE AnalysisResult
u (IdxExpr JExpr
e1 JExpr
e2) = AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e1) JExpr
e2
goE AnalysisResult
u (InfixExpr Op
_ JExpr
e1 JExpr
e2) = AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e1) JExpr
e2
goE AnalysisResult
u (UOpExpr UOp
_ JExpr
e) = AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e
goE AnalysisResult
u (IfExpr JExpr
e1 JExpr
e2 JExpr
e3) = AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e1) JExpr
e2) JExpr
e3
goE AnalysisResult
u (ApplExpr JExpr
e [JExpr]
es)
| (ValExpr (JVar (TxtI FastString
i))) <- JExpr
e, FastString
i FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
"eval" = AnalysisResult
u { arBailout = True }
| Bool
otherwise = (AnalysisResult -> JExpr -> AnalysisResult)
-> AnalysisResult -> [JExpr] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnalysisResult -> JExpr -> AnalysisResult
goE (AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u JExpr
e) [JExpr]
es
goV :: AnalysisResult -> JVal -> AnalysisResult
goV :: AnalysisResult -> JVal -> AnalysisResult
goV AnalysisResult
u (JVar Ident
v) = Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
One VarValue
Unassigned VarDecl
NoDecl Bool
False) AnalysisResult
u
goV AnalysisResult
u (JList [JExpr]
es) = (AnalysisResult -> JExpr -> AnalysisResult)
-> AnalysisResult -> [JExpr] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u [JExpr]
es
goV AnalysisResult
u (JDouble SaneDouble
_) = AnalysisResult
u
goV AnalysisResult
u (JInt Integer
_) = AnalysisResult
u
goV AnalysisResult
u (JStr FastString
_) = AnalysisResult
u
goV AnalysisResult
u (JRegEx FastString
_) = AnalysisResult
u
goV AnalysisResult
u (JBool Bool
_) = AnalysisResult
u
goV AnalysisResult
u (JHash UniqMap FastString JExpr
ps) = (AnalysisResult -> JExpr -> AnalysisResult)
-> AnalysisResult -> [JExpr] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnalysisResult -> JExpr -> AnalysisResult
goE AnalysisResult
u (((FastString, JExpr) -> JExpr) -> [(FastString, JExpr)] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map (FastString, JExpr) -> JExpr
forall a b. (a, b) -> b
snd ([(FastString, JExpr)] -> [JExpr])
-> [(FastString, JExpr)] -> [JExpr]
forall a b. (a -> b) -> a -> b
$ UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
UM.nonDetUniqMapToList UniqMap FastString JExpr
ps)
goV AnalysisResult
u (JFunc [Ident]
vs JStat
s)
= Bool -> AnalysisResult -> JStat -> AnalysisResult
go Bool
True ((AnalysisResult -> Ident -> AnalysisResult)
-> AnalysisResult -> [Ident] -> AnalysisResult
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\AnalysisResult
u Ident
v -> Ident -> VarUsage -> AnalysisResult -> AnalysisResult
add Ident
v (Multiplicity -> VarValue -> VarDecl -> Bool -> VarUsage
VarUsage Multiplicity
Zero VarValue
AssignedOnce VarDecl
NoDecl Bool
True) AnalysisResult
u) AnalysisResult
u [Ident]
vs) JStat
s
isTrivialAssignment :: Ident -> AOp -> JExpr -> Bool
isTrivialAssignment :: Ident -> AOp -> JExpr -> Bool
isTrivialAssignment Ident
v AOp
AssignOp (ValExpr (JVar Ident
v')) = Ident
v Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
v'
isTrivialAssignment Ident
_ AOp
_ JExpr
_ = Bool
False
mayHaveSideEffects :: JExpr -> Bool
mayHaveSideEffects :: JExpr -> Bool
mayHaveSideEffects (IdxExpr (ValExpr (JVar (TxtI FastString
i))) JExpr
e)
| FastString
i FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
"h$stack" = JExpr -> Bool
mayHaveSideEffects JExpr
e
mayHaveSideEffects (SelExpr JExpr
e (TxtI FastString
i))
| FastString -> Bool
isHeapObjectProperty FastString
i = JExpr -> Bool
mayHaveSideEffects JExpr
e
mayHaveSideEffects (ValExpr JVal
v) = JVal -> Bool
mayHaveSideEffectsV JVal
v
mayHaveSideEffects (SelExpr {}) = Bool
True
mayHaveSideEffects (IdxExpr {}) = Bool
True
mayHaveSideEffects (UOpExpr UOp
uop JExpr
e) = Bool
uo Bool -> Bool -> Bool
|| JExpr -> Bool
mayHaveSideEffects JExpr
e
where
uo :: Bool
uo = case UOp
uop of
UOp
NotOp -> Bool
False
UOp
BNotOp -> Bool
False
UOp
NegOp -> Bool
False
UOp
PlusOp -> Bool
False
UOp
TypeofOp -> Bool
False
UOp
_ -> Bool
True
mayHaveSideEffects (InfixExpr Op
_o JExpr
e1 JExpr
e2) =
JExpr -> Bool
mayHaveSideEffects JExpr
e1 Bool -> Bool -> Bool
|| JExpr -> Bool
mayHaveSideEffects JExpr
e2
mayHaveSideEffects (IfExpr JExpr
e1 JExpr
e2 JExpr
e3) =
JExpr -> Bool
mayHaveSideEffects JExpr
e1 Bool -> Bool -> Bool
|| JExpr -> Bool
mayHaveSideEffects JExpr
e2 Bool -> Bool -> Bool
|| JExpr -> Bool
mayHaveSideEffects JExpr
e3
mayHaveSideEffects (ApplExpr {}) = Bool
True
mayHaveSideEffectsV :: JVal -> Bool
mayHaveSideEffectsV :: JVal -> Bool
mayHaveSideEffectsV (JVar {}) = Bool
False
mayHaveSideEffectsV (JList [JExpr]
es) = (JExpr -> Bool) -> [JExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any JExpr -> Bool
mayHaveSideEffects [JExpr]
es
mayHaveSideEffectsV (JDouble {}) = Bool
False
mayHaveSideEffectsV (JInt {}) = Bool
False
mayHaveSideEffectsV (JStr {}) = Bool
False
mayHaveSideEffectsV (JRegEx {}) = Bool
False
mayHaveSideEffectsV (JBool {}) = Bool
False
mayHaveSideEffectsV (JHash UniqMap FastString JExpr
ps) = (JExpr -> Bool) -> UniqMap FastString JExpr -> Bool
forall a k. (a -> Bool) -> UniqMap k a -> Bool
UM.anyUniqMap JExpr -> Bool
mayHaveSideEffects UniqMap FastString JExpr
ps
mayHaveSideEffectsV (JFunc {}) = Bool
True
isHeapObjectProperty :: FastString -> Bool
isHeapObjectProperty :: FastString -> Bool
isHeapObjectProperty FastString
"d1" = Bool
True
isHeapObjectProperty FastString
"d2" = Bool
True
isHeapObjectProperty FastString
"d3" = Bool
True
isHeapObjectProperty FastString
"d4" = Bool
True
isHeapObjectProperty FastString
"d5" = Bool
True
isHeapObjectProperty FastString
"d6" = Bool
True
isHeapObjectProperty FastString
"d7" = Bool
True
isHeapObjectProperty FastString
"d8" = Bool
True
isHeapObjectProperty FastString
"d9" = Bool
True
isHeapObjectProperty FastString
"d10" = Bool
True
isHeapObjectProperty FastString
"d11" = Bool
True
isHeapObjectProperty FastString
"d12" = Bool
True
isHeapObjectProperty FastString
"d13" = Bool
True
isHeapObjectProperty FastString
"d14" = Bool
True
isHeapObjectProperty FastString
"d15" = Bool
True
isHeapObjectProperty FastString
"d16" = Bool
True
isHeapObjectProperty FastString
"d17" = Bool
True
isHeapObjectProperty FastString
"d18" = Bool
True
isHeapObjectProperty FastString
"d19" = Bool
True
isHeapObjectProperty FastString
"d20" = Bool
True
isHeapObjectProperty FastString
"d21" = Bool
True
isHeapObjectProperty FastString
"d22" = Bool
True
isHeapObjectProperty FastString
"d23" = Bool
True
isHeapObjectProperty FastString
"d24" = Bool
True
isHeapObjectProperty FastString
_ = Bool
False
isClosureAllocator :: FastString -> Bool
isClosureAllocator :: FastString -> Bool
isClosureAllocator FastString
"h$c1" = Bool
True
isClosureAllocator FastString
"h$c2" = Bool
True
isClosureAllocator FastString
"h$c3" = Bool
True
isClosureAllocator FastString
"h$c4" = Bool
True
isClosureAllocator FastString
"h$c5" = Bool
True
isClosureAllocator FastString
"h$c6" = Bool
True
isClosureAllocator FastString
"h$c7" = Bool
True
isClosureAllocator FastString
"h$c8" = Bool
True
isClosureAllocator FastString
"h$c9" = Bool
True
isClosureAllocator FastString
"h$c10" = Bool
True
isClosureAllocator FastString
"h$c11" = Bool
True
isClosureAllocator FastString
"h$c12" = Bool
True
isClosureAllocator FastString
"h$c13" = Bool
True
isClosureAllocator FastString
"h$c14" = Bool
True
isClosureAllocator FastString
"h$c15" = Bool
True
isClosureAllocator FastString
"h$c16" = Bool
True
isClosureAllocator FastString
"h$c17" = Bool
True
isClosureAllocator FastString
"h$c18" = Bool
True
isClosureAllocator FastString
"h$c19" = Bool
True
isClosureAllocator FastString
"h$c20" = Bool
True
isClosureAllocator FastString
"h$c21" = Bool
True
isClosureAllocator FastString
"h$c22" = Bool
True
isClosureAllocator FastString
"h$c23" = Bool
True
isClosureAllocator FastString
"h$c24" = Bool
True
isClosureAllocator FastString
_ = Bool
False