Permalink
Browse files

new environment code; should be the last revision

  • Loading branch information...
1 parent 0a64975 commit 2b58d69097bad70f52a2bc53d9a70e086e0adaa9 Arjun Guha committed Apr 3, 2009
View
@@ -35,13 +35,22 @@ Library
ghc-options:
-fwarn-incomplete-patterns
Extensions:
- Generics Rank2Types TypeSynonymInstances DeriveDataTypeable RelaxedPolyRec
+ Generics TypeSynonymInstances DeriveDataTypeable
Exposed-Modules:
- WebBits.Html.Html WebBits.Html.Syntax WebBits.Html.PermissiveParser
- WebBits.Html.PrettyPrint WebBits.Html.Instances WebBits.Common
- WebBits.Html.RawScript WebBits.JavaScript.Combinators
- WebBits.JavaScript.HtmlEmbedding WebBits.JavaScript.Instances
- WebBits.JavaScript WebBits.JavaScript.Lexer
- WebBits.JavaScript.Parser WebBits.JavaScript.PrettyPrint
+ WebBits.Html.Html
+ WebBits.Html.Syntax
+ WebBits.Html.PermissiveParser
+ WebBits.Html.PrettyPrint
+ WebBits.Html.Instances
+ WebBits.Common
+ WebBits.Html.RawScript
+ WebBits.JavaScript.Combinators
+ WebBits.JavaScript.HtmlEmbedding
+ WebBits.JavaScript.Instances
+ WebBits.JavaScript
+ WebBits.JavaScript.Lexer
+ WebBits.JavaScript.Parser
+ WebBits.JavaScript.PrettyPrint
WebBits.JavaScript.Syntax
- WebBits.JavaScript.Crawl WebBits.JavaScript.Env
+ WebBits.JavaScript.Crawl
+ WebBits.JavaScript.Environment
View
@@ -5,7 +5,6 @@ module WebBits.Common
, initialPos
, SourcePos
, sourceName
- , everythingBut
, excludeFunctions
) where
@@ -26,19 +25,6 @@ import qualified Text.PrettyPrint.HughesPJ as Pp
import Text.ParserCombinators.Parsec.Pos (SourcePos, initialPos, sourceName)
import WebBits.JavaScript.Syntax
--- |Similar to 'everything'. 'everythingBut' descends into 'term' only if
--- the generic predicate is 'True'. If the predicate is 'False',
--- the query is still applied to 'term'.
-everythingBut :: (r -> r -> r) -- ^combines results
- -> GenericQ Bool -- ^generic predicate that determines whether
- -- to descend into a value
- -> GenericQ r -- ^generic query
- -> GenericQ r
-everythingBut combine canDescend query term = case canDescend term of
- False -> query term -- does not descend
- True -> L.foldl' combine (query term)
- (gmapQ (everythingBut combine canDescend query) term)
-
-- |For generics, this type cannot be quantified.
isNotFuncExpr :: Expression SourcePos -> Bool
isNotFuncExpr (FuncExpr{}) = False
@@ -5,7 +5,6 @@ module WebBits.JavaScript
, module WebBits.JavaScript.Parser
, module WebBits.JavaScript.Combinators
, module WebBits.Common
- , module WebBits.JavaScript.Env
-- JavaScript.Instances exports nothing
) where
@@ -16,6 +15,5 @@ import WebBits.JavaScript.Parser
import WebBits.JavaScript.PrettyPrint
import WebBits.JavaScript.HtmlEmbedding
import WebBits.JavaScript.Combinators
-import WebBits.JavaScript.Env
import WebBits.JavaScript.Instances
@@ -1,59 +0,0 @@
--- |
--- Maintainer: arjun@cs.brown.edu
---
--- Determine the environment of a JavaScript function.
-module WebBits.JavaScript.Env
- (
- -- * Environment
- localVars
- ) where
-
-import Data.Generics
-import Data.List (foldl')
-import qualified Data.Set as S
-import Data.Set (Set)
-import Text.ParserCombinators.Parsec(SourcePos)
-
-import WebBits.Common
-import WebBits.JavaScript.Syntax
-
--- ----------------------------------------------------------------------------
--- Environment
-
--- |Locally defined variables in a list of statements. Does not descend
--- into nested functions.
-localVars :: [Statement SourcePos] -> Set String
-localVars stmts = everythingBut S.union excludeFunctions query stmts where
- query :: GenericQ (Set String)
- query = (mkQ S.empty collectVarDecl) `extQ` collectForInInit `extQ`
- collectFuncStmt
-
- collectFuncStmt :: Statement SourcePos -> Set String
- collectFuncStmt (FunctionStmt _ id _ _) = S.singleton (unId id)
- collectFuncStmt stmt = S.empty
-
- collectVarDecl :: VarDecl SourcePos -> Set String
- collectVarDecl (VarDecl _ v _) = S.singleton (unId v)
-
- collectForInInit :: ForInInit SourcePos -> Set String
- collectForInInit (ForInVar v) = S.singleton (unId v)
- collectForInInit (ForInNoVar _) = S.empty
-
--- |Free variables of a function. Naturally, this reports free variables
--- in nested functions as well.
--- TODO: Does not report free variables in nested functions!
-funcFreeVars :: Expression SourcePos -> Set String
-funcFreeVars (FuncExpr _ argIds body) = free where
- free = S.difference (S.difference used declared) args
- -- Collect VarRef's in this function, but don't descend into nested functions.
- used = everythingBut S.union excludeFunctions (mkQ S.empty getVar) body
- -- Variables declared in this function.
- declared = localVars [body]
- -- Arguments as a set
- args = S.fromList (map unId argIds)
-funcFreeVars _ = error "funcFreeVars requires a FuncExpr"
-
-
-getVar :: Expression SourcePos -> Set String
-getVar (VarRef _ (Id _ v)) = S.singleton v
-getVar _ = S.empty
@@ -1,4 +1,7 @@
-module WebBits.JavaScript.Environment where
+module WebBits.JavaScript.Environment
+ ( env
+ , EnvTree (..)
+ ) where
import Data.List
import Data.Maybe
@@ -57,9 +60,7 @@ expr e = case e of
PrefixExpr _ _ e -> expr e
InfixExpr _ _ e1 e2 -> unions [expr e1, expr e2]
CondExpr _ e1 e2 e3 -> unions [expr e1, expr e2, expr e3]
- AssignExpr _ _ (VarRef _ id) e -> [ref id, expr e]
- AssignExpr _ _ ((VarRef _ id) e -> [ref id, expr e]
- AssignExpr _ _ (VarRef _ id) e -> [ref id, expr e]
+ AssignExpr _ _ (VarRef _ id) e -> unions [ref id, expr e]
AssignExpr _ _ e1 e2 -> unions [expr e1, expr e2]
ParenExpr _ e -> expr e
ListExpr _ es -> unions (map expr es)
View
@@ -2,12 +2,8 @@ module WebBits.Test
( pretty
, parse
, parseJavaScriptFromFile
- , label
- , globals
, isJsFile
, getJsPaths
- , sameIds
- , diffIds
, commandIO
, rhinoIO
, rhinoIOFile
@@ -42,8 +38,6 @@ import WebBits.JavaScript.PrettyPrint ()
import WebBits.JavaScript.Syntax
import WebBits.JavaScript.Parser (parseScriptFromString,parseJavaScriptFromFile,
ParsedStatement)
-import WebBits.JavaScript.Environment (LabelledStatement,LabelledExpression,
- Ann,staticEnvironment,Env)
pretty :: [ParsedStatement] -> String
pretty stmts = render $ vcat $ map pp stmts
@@ -68,21 +62,6 @@ getJsPaths dpath = do
paths <- if exists then getDirectoryContents dpath else return []
return [dpath </> p | p <- paths, isJsFile p]
-globals :: [ParsedStatement] -> [String]
-globals stmts = M.keys env where
- (_,_,env,_) = staticEnvironment stmts
-
-label :: [ParsedStatement] -> [LabelledStatement]
-label stmts = labelledStmts where
- (labelledStmts,_,_,_) = staticEnvironment stmts
-
-idWithPos :: (Int,Int)
- -> Id Ann
- -> [Int]
-idWithPos (line,col) (Id (_,lbl,pos) _)
- | line == sourceLine pos && col == sourceColumn pos = [lbl]
-idWithPos _ _ = []
-
labelAt :: (Foldable t)
=> [t (a,Int,SourcePos)]
@@ -97,27 +76,6 @@ labelAt terms (line,column) =
show line ++ ", column " ++ show column)
-sameIds :: [(Int,Int)] -- ^positions of identifiers that reference the same
- -- variable
- -> [LabelledStatement]
- -> Assertion
-sameIds [] stmts =
- assertFailure "sameIds called with no identifiers"
-sameIds idLocs stmts = do
- let lbls = map (labelAt stmts) idLocs
- when (length (L.nub lbls) /= 1) $
- assertFailure $ "sameIds: distinct labels in " ++ show lbls
- return ()
-
-diffIds :: [(Int,Int)] -- ^positions of identifiers that reference distinct
- -- variables
- -> [LabelledStatement]
- -> Assertion
-diffIds idLocs stmts = do
- let lbls = map (labelAt stmts) idLocs
- when (L.nub lbls /= lbls) $
- assertFailure $ "diffIds : some labels are the same in " ++ show lbls
- return ()
commandIO :: FilePath -- ^path of the executable
-> [String] -- ^command line arguments
View
@@ -1,24 +0,0 @@
-var x = 12;
-
-(function (x) { return x; })(x);
-
-
-/*
-
-> module Env1 where
-
-> import Test.HUnit
-> import WebBits.Test
-
-> test1 = TestCase $ do
-> parsedStmts <- parseJavaScriptFromFile "Env1.lhs"
-> let stmts = label parsedStmts
-> sameIds [(3,12),(3,24)] stmts
-> sameIds [(1,5),(3,30)] stmts
-> diffIds [(1,5),(3,24)] stmts
-
-> main :: IO Test
-> main = do
-> return $ TestList [test1]
-
-*/
View
@@ -1,26 +0,0 @@
-var x = 12;
-
-y = 34;
-
-
-
-/*
-
-> module Env2 where
-
-> import Data.List (sort)
-> import Test.HUnit
-> import WebBits.Test
-
-> test1 = TestCase $ do
-> parsedStmts <- parseJavaScriptFromFile "Env2.lhs"
-> let names = globals parsedStmts
-> let expected = ["this","x","y"]
-> assertEqual "Env2 globals wrong" (sort expected) (sort names)
-
-> main :: IO Test
-> main = do
-> return $ TestList [test1]
-
-*/
-
View
@@ -1,26 +0,0 @@
-var x = 12;
-
-var y = 34;
-
-
-
-/*
-
-> module Env3 where
-
-> import Data.List (sort)
-> import Test.HUnit
-> import WebBits.Test
-
-> test1 = TestCase $ do
-> parsedStmts <- parseJavaScriptFromFile "Env3.lhs"
-> let names = globals parsedStmts
-> let expected = ["this","x","y"]
-> assertEqual "Env3 globals wrong" (sort expected) (sort names)
-
-> main :: IO Test
-> main = do
-> return $ TestList [test1]
-
-*/
-
Oops, something went wrong.

0 comments on commit 2b58d69

Please sign in to comment.