module Language.ECMAScript3.Analysis.Environment
{-# DEPRECATED "Use 'Language.ECMAScript.Analysis.LexicalEnvironment'\
\ from package 'language-ecmascript-analysis'" #-}
( env
, localVars
, EnvTree (..)
) where
import Data.List
import Data.Maybe
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import Text.ParserCombinators.Parsec.Pos (SourcePos)
import Language.ECMAScript3.Syntax
data Partial = Partial {
Partial -> Map String SourcePos
partialLocals :: M.Map String SourcePos,
Partial -> Map String SourcePos
partialReferences :: M.Map String SourcePos,
Partial -> [Partial]
partialNested :: [Partial]
}
empty :: Partial
empty :: Partial
empty = Map String SourcePos
-> Map String SourcePos -> [Partial] -> Partial
Partial forall k a. Map k a
M.empty forall k a. Map k a
M.empty []
ref :: Id SourcePos -> Partial
ref :: Id SourcePos -> Partial
ref (Id SourcePos
p String
v) = Map String SourcePos
-> Map String SourcePos -> [Partial] -> Partial
Partial forall k a. Map k a
M.empty (forall k a. k -> a -> Map k a
M.singleton String
v SourcePos
p) []
decl :: Id SourcePos -> Partial
decl :: Id SourcePos -> Partial
decl (Id SourcePos
p String
v) = Map String SourcePos
-> Map String SourcePos -> [Partial] -> Partial
Partial (forall k a. k -> a -> Map k a
M.singleton String
v SourcePos
p) forall k a. Map k a
M.empty []
nest :: Partial -> Partial
nest :: Partial -> Partial
nest Partial
partial = Map String SourcePos
-> Map String SourcePos -> [Partial] -> Partial
Partial forall k a. Map k a
M.empty forall k a. Map k a
M.empty [Partial
partial]
unions :: [Partial] -> Partial
unions :: [Partial] -> Partial
unions [Partial]
ps = Map String SourcePos
-> Map String SourcePos -> [Partial] -> Partial
Partial (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions (forall a b. (a -> b) -> [a] -> [b]
map Partial -> Map String SourcePos
partialLocals [Partial]
ps))
(forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions (forall a b. (a -> b) -> [a] -> [b]
map Partial -> Map String SourcePos
partialReferences [Partial]
ps))
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Partial -> [Partial]
partialNested [Partial]
ps)
javascript :: JavaScript SourcePos -> Partial
javascript :: JavaScript SourcePos -> Partial
javascript (Script SourcePos
_ [Statement SourcePos]
ss) = [Partial] -> Partial
unions (forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
ss)
lvalue :: LValue SourcePos -> Partial
lvalue :: LValue SourcePos -> Partial
lvalue LValue SourcePos
lv = case LValue SourcePos
lv of
LVar SourcePos
p String
x -> Id SourcePos -> Partial
ref (forall a. a -> String -> Id a
Id SourcePos
p String
x)
LDot SourcePos
_ Expression SourcePos
e String
_ -> Expression SourcePos -> Partial
expr Expression SourcePos
e
LBracket SourcePos
_ Expression SourcePos
e1 Expression SourcePos
e2 -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e1, Expression SourcePos -> Partial
expr Expression SourcePos
e2]
expr :: Expression SourcePos -> Partial
expr :: Expression SourcePos -> Partial
expr Expression SourcePos
e = case Expression SourcePos
e of
StringLit SourcePos
_ String
_ -> Partial
empty
RegexpLit {} -> Partial
empty
NumLit SourcePos
_ Double
_ -> Partial
empty
IntLit SourcePos
_ Int
_ -> Partial
empty
BoolLit SourcePos
_ Bool
_ -> Partial
empty
NullLit SourcePos
_ -> Partial
empty
ArrayLit SourcePos
_ [Expression SourcePos]
es -> [Partial] -> Partial
unions (forall a b. (a -> b) -> [a] -> [b]
map Expression SourcePos -> Partial
expr [Expression SourcePos]
es)
ObjectLit SourcePos
_ [(Prop SourcePos, Expression SourcePos)]
props -> [Partial] -> Partial
unions (forall a b. (a -> b) -> [a] -> [b]
map (Expression SourcePos -> Partial
exprforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [(Prop SourcePos, Expression SourcePos)]
props)
ThisRef SourcePos
_ -> Partial
empty
VarRef SourcePos
_ Id SourcePos
id -> Partial
empty
DotRef SourcePos
_ Expression SourcePos
e Id SourcePos
_ -> Expression SourcePos -> Partial
expr Expression SourcePos
e
BracketRef SourcePos
_ Expression SourcePos
e1 Expression SourcePos
e2 -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e1, Expression SourcePos -> Partial
expr Expression SourcePos
e2]
NewExpr SourcePos
_ Expression SourcePos
e1 [Expression SourcePos]
es -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e1, [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expression SourcePos -> Partial
expr [Expression SourcePos]
es]
PrefixExpr SourcePos
_ PrefixOp
_ Expression SourcePos
e -> Expression SourcePos -> Partial
expr Expression SourcePos
e
InfixExpr SourcePos
_ InfixOp
_ Expression SourcePos
e1 Expression SourcePos
e2 -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e1, Expression SourcePos -> Partial
expr Expression SourcePos
e2]
CondExpr SourcePos
_ Expression SourcePos
e1 Expression SourcePos
e2 Expression SourcePos
e3 -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e1, Expression SourcePos -> Partial
expr Expression SourcePos
e2, Expression SourcePos -> Partial
expr Expression SourcePos
e3]
AssignExpr SourcePos
_ AssignOp
_ LValue SourcePos
lv Expression SourcePos
e -> [Partial] -> Partial
unions [LValue SourcePos -> Partial
lvalue LValue SourcePos
lv, Expression SourcePos -> Partial
expr Expression SourcePos
e]
UnaryAssignExpr SourcePos
_ UnaryAssignOp
_ LValue SourcePos
lv -> LValue SourcePos -> Partial
lvalue LValue SourcePos
lv
ListExpr SourcePos
_ [Expression SourcePos]
es -> [Partial] -> Partial
unions (forall a b. (a -> b) -> [a] -> [b]
map Expression SourcePos -> Partial
expr [Expression SourcePos]
es)
CallExpr SourcePos
_ Expression SourcePos
e [Expression SourcePos]
es -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expression SourcePos -> Partial
expr [Expression SourcePos]
es]
FuncExpr SourcePos
_ Maybe (Id SourcePos)
_ [Id SourcePos]
args [Statement SourcePos]
ss -> Partial -> Partial
nest forall a b. (a -> b) -> a -> b
$ [Partial] -> Partial
unions [[Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Id SourcePos -> Partial
decl [Id SourcePos]
args
,[Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
ss]
caseClause :: CaseClause SourcePos -> Partial
caseClause :: CaseClause SourcePos -> Partial
caseClause CaseClause SourcePos
cc = case CaseClause SourcePos
cc of
CaseClause SourcePos
_ Expression SourcePos
e [Statement SourcePos]
ss -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
ss]
CaseDefault SourcePos
_ [Statement SourcePos]
ss -> [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
ss
catchClause :: CatchClause SourcePos -> Partial
catchClause :: CatchClause SourcePos -> Partial
catchClause (CatchClause SourcePos
_ Id SourcePos
id Statement SourcePos
s) = [Partial] -> Partial
unions [Id SourcePos -> Partial
decl Id SourcePos
id, Statement SourcePos -> Partial
stmt Statement SourcePos
s]
varDecl :: VarDecl SourcePos -> Partial
varDecl :: VarDecl SourcePos -> Partial
varDecl (VarDecl SourcePos
_ Id SourcePos
id Maybe (Expression SourcePos)
Nothing) = Id SourcePos -> Partial
decl Id SourcePos
id
varDecl (VarDecl SourcePos
_ Id SourcePos
id (Just Expression SourcePos
e)) = [Partial] -> Partial
unions [Id SourcePos -> Partial
decl Id SourcePos
id, Expression SourcePos -> Partial
expr Expression SourcePos
e]
forInit :: ForInit SourcePos -> Partial
forInit :: ForInit SourcePos -> Partial
forInit ForInit SourcePos
fi = case ForInit SourcePos
fi of
ForInit SourcePos
NoInit -> Partial
empty
VarInit [VarDecl SourcePos]
ds -> [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map VarDecl SourcePos -> Partial
varDecl [VarDecl SourcePos]
ds
ExprInit Expression SourcePos
e -> Expression SourcePos -> Partial
expr Expression SourcePos
e
forInInit :: ForInInit SourcePos -> Partial
forInInit :: ForInInit SourcePos -> Partial
forInInit (ForInVar Id SourcePos
id) = Id SourcePos -> Partial
decl Id SourcePos
id
forInInit (ForInLVal LValue SourcePos
lv) = LValue SourcePos -> Partial
lvalue LValue SourcePos
lv
stmt :: Statement SourcePos -> Partial
stmt :: Statement SourcePos -> Partial
stmt Statement SourcePos
s = case Statement SourcePos
s of
BlockStmt SourcePos
_ [Statement SourcePos]
ss -> [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
ss
EmptyStmt SourcePos
_ -> Partial
empty
ExprStmt SourcePos
_ Expression SourcePos
e -> Expression SourcePos -> Partial
expr Expression SourcePos
e
IfStmt SourcePos
_ Expression SourcePos
e Statement SourcePos
s1 Statement SourcePos
s2 -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, Statement SourcePos -> Partial
stmt Statement SourcePos
s1, Statement SourcePos -> Partial
stmt Statement SourcePos
s2]
IfSingleStmt SourcePos
_ Expression SourcePos
e Statement SourcePos
s -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, Statement SourcePos -> Partial
stmt Statement SourcePos
s]
SwitchStmt SourcePos
_ Expression SourcePos
e [CaseClause SourcePos]
cases -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CaseClause SourcePos -> Partial
caseClause [CaseClause SourcePos]
cases]
WhileStmt SourcePos
_ Expression SourcePos
e Statement SourcePos
s -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, Statement SourcePos -> Partial
stmt Statement SourcePos
s]
DoWhileStmt SourcePos
_ Statement SourcePos
s Expression SourcePos
e -> [Partial] -> Partial
unions [Statement SourcePos -> Partial
stmt Statement SourcePos
s, Expression SourcePos -> Partial
expr Expression SourcePos
e]
BreakStmt SourcePos
_ Maybe (Id SourcePos)
_ -> Partial
empty
ContinueStmt SourcePos
_ Maybe (Id SourcePos)
_ -> Partial
empty
LabelledStmt SourcePos
_ Id SourcePos
_ Statement SourcePos
s -> Statement SourcePos -> Partial
stmt Statement SourcePos
s
ForInStmt SourcePos
_ ForInInit SourcePos
fii Expression SourcePos
e Statement SourcePos
s -> [Partial] -> Partial
unions [ForInInit SourcePos -> Partial
forInInit ForInInit SourcePos
fii, Expression SourcePos -> Partial
expr Expression SourcePos
e, Statement SourcePos -> Partial
stmt Statement SourcePos
s]
ForStmt SourcePos
_ ForInit SourcePos
fi Maybe (Expression SourcePos)
me1 Maybe (Expression SourcePos)
me2 Statement SourcePos
s ->
[Partial] -> Partial
unions [ForInit SourcePos -> Partial
forInit ForInit SourcePos
fi, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Partial
empty Expression SourcePos -> Partial
expr Maybe (Expression SourcePos)
me1, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Partial
empty Expression SourcePos -> Partial
expr Maybe (Expression SourcePos)
me2, Statement SourcePos -> Partial
stmt Statement SourcePos
s]
TryStmt SourcePos
_ Statement SourcePos
s Maybe (CatchClause SourcePos)
mcatch Maybe (Statement SourcePos)
ms ->
[Partial] -> Partial
unions [Statement SourcePos -> Partial
stmt Statement SourcePos
s, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Partial
empty CatchClause SourcePos -> Partial
catchClause Maybe (CatchClause SourcePos)
mcatch, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Partial
empty Statement SourcePos -> Partial
stmt Maybe (Statement SourcePos)
ms]
ThrowStmt SourcePos
_ Expression SourcePos
e -> Expression SourcePos -> Partial
expr Expression SourcePos
e
ReturnStmt SourcePos
_ Maybe (Expression SourcePos)
me -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Partial
empty Expression SourcePos -> Partial
expr Maybe (Expression SourcePos)
me
WithStmt SourcePos
_ Expression SourcePos
e Statement SourcePos
s -> [Partial] -> Partial
unions [Expression SourcePos -> Partial
expr Expression SourcePos
e, Statement SourcePos -> Partial
stmt Statement SourcePos
s]
VarDeclStmt SourcePos
_ [VarDecl SourcePos]
decls -> [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map VarDecl SourcePos -> Partial
varDecl [VarDecl SourcePos]
decls
FunctionStmt SourcePos
_ Id SourcePos
fnId [Id SourcePos]
args [Statement SourcePos]
ss ->
[Partial] -> Partial
unions [Id SourcePos -> Partial
decl Id SourcePos
fnId, Partial -> Partial
nest forall a b. (a -> b) -> a -> b
$ [Partial] -> Partial
unions [[Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Id SourcePos -> Partial
decl [Id SourcePos]
args,
[Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
ss]]
data EnvTree = EnvTree (M.Map String SourcePos) [EnvTree]
makeEnvTree :: Map String SourcePos
-> Partial
-> (EnvTree,Map String SourcePos)
makeEnvTree :: Map String SourcePos -> Partial -> (EnvTree, Map String SourcePos)
makeEnvTree Map String SourcePos
enclosing (Partial Map String SourcePos
locals Map String SourcePos
references [Partial]
nested) = (EnvTree
tree,Map String SourcePos
globals) where
nestedResults :: [(EnvTree, Map String SourcePos)]
nestedResults = forall a b. (a -> b) -> [a] -> [b]
map (Map String SourcePos -> Partial -> (EnvTree, Map String SourcePos)
makeEnvTree (Map String SourcePos
locals forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map String SourcePos
enclosing)) [Partial]
nested
tree :: EnvTree
tree = Map String SourcePos -> [EnvTree] -> EnvTree
EnvTree Map String SourcePos
locals (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(EnvTree, Map String SourcePos)]
nestedResults)
globals' :: Map String SourcePos
globals' = (Map String SourcePos
references forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map String SourcePos
locals) forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map String SourcePos
enclosing
globals :: Map String SourcePos
globals = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions (Map String SourcePos
globals'forall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(EnvTree, Map String SourcePos)]
nestedResults)
env :: Map String SourcePos
-> [Statement SourcePos]
-> (EnvTree,Map String SourcePos)
env :: Map String SourcePos
-> [Statement SourcePos] -> (EnvTree, Map String SourcePos)
env Map String SourcePos
globals [Statement SourcePos]
program = Map String SourcePos -> Partial -> (EnvTree, Map String SourcePos)
makeEnvTree Map String SourcePos
globals ([Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
program)
localVars :: [Statement SourcePos]
-> [(String, SourcePos)]
localVars :: [Statement SourcePos] -> [(String, SourcePos)]
localVars [Statement SourcePos]
body = forall k a. Map k a -> [(k, a)]
M.toList Map String SourcePos
locals where
Partial Map String SourcePos
locals Map String SourcePos
_ [Partial]
_ = [Partial] -> Partial
unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Statement SourcePos -> Partial
stmt [Statement SourcePos]
body