Permalink
Browse files

unId in common; simplify uses strings for the stack

  • Loading branch information...
1 parent b4b1bd9 commit 654a473fbfe621dfeb13646332f0ed815cd37a5b Arjun Guha committed Mar 13, 2009
@@ -17,9 +17,6 @@ import Text.ParserCombinators.Parsec(SourcePos)
import WebBits.Common
import WebBits.JavaScript.Syntax
-unId (Id _ v) = v
-
-
-- ----------------------------------------------------------------------------
-- Environment
@@ -143,11 +143,11 @@ newLocalVar expr = do
let id = Id noPos ("__webbits" ++ show n)
return (VarDeclStmt noPos [VarDecl noPos id (Just expr)],VarRef noPos id)
-newStmtLabel :: State Int (Id SourcePos)
+newStmtLabel :: State Int String
newStmtLabel = do
n <- get
put (n+1)
- return (Id noPos ("__webbitslabel" ++ show n))
+ return ("__webbitslabel" ++ show n)
-- |If the expression is not a variable-reference, create a name for it.
@@ -320,7 +320,7 @@ isLoop _ = False
-- addition, we generate labels for switch statements and loops. This allows
-- us to make all continue and break statements jump/exit to explicit
-- statements.
-purifyStmt :: [(Id SourcePos,LabelType)]
+purifyStmt :: [(String,LabelType)]
-> Statement SourcePos -> State Int (Statement SourcePos)
purifyStmt labels stmt = case stmt of
BlockStmt p stmts -> liftM (BlockStmt p) (mapM (purifyStmt labels) stmts)
@@ -340,28 +340,29 @@ purifyStmt labels stmt = case stmt of
cases' <- mapM (purifyCase ((l,ImplicitSwitchLabel):labels)) cases
return $ BlockStmt p [BlockStmt p eStmts,
s1,
- LabelledStmt p l $ SwitchStmt p id cases']
+ LabelledStmt p (Id p l) $ SwitchStmt p id cases']
WhileStmt p e s -> do
(ess,e') <- purifyExpr e
l <- newStmtLabel
s' <- purifyStmt ((l,ImplicitLoopLabel):labels) s
return (BlockStmt p [BlockStmt p ess,
- LabelledStmt p l $ WhileStmt p e' s'])
+ LabelledStmt p (Id p l) $ WhileStmt p e' s'])
-- an unlabelled break terminates the innermost enclosing switch/loop.
BreakStmt p Nothing -> case L.find (not.isExplicitLabel) labels of
- Just (id,lbl) -> return $ BreakStmt p (Just id)
+ Just (id,lbl) -> return $ BreakStmt p (Just (Id p id))
Nothing -> fail $ "syntax error at " ++ show p ++ "\nNo enclosing loop " ++
"or switch to break to."
- BreakStmt p (Just id) -> case L.lookup id labels of
+ BreakStmt p (Just id) -> case L.lookup (unId id) labels of
Just _ -> return stmt
Nothing -> fail $ "syntax error at " ++ show p ++ "\nNo enclosing label " ++
- "with the name " ++ show id
+ "with the name " ++ show id ++
+ "; candidates are " ++ show (map fst labels)
-- continues the next iteration of the innermost enclosing loop.
ContinueStmt p Nothing -> case L.find isLoopLabel labels of
Nothing -> fail $ "syntax error at " ++ show p ++ "\nUse of continue " ++
"outside a loop"
- Just (id,_) -> return $ ContinueStmt p (Just id)
- ContinueStmt p (Just id) -> case L.lookup id labels of
+ Just (id,_) -> return $ ContinueStmt p (Just (Id p id))
+ ContinueStmt p (Just id) -> case L.lookup (unId id) labels of
Nothing -> fail $ "syntax error at " ++ show p ++ "\nNo loop named " ++
show id
-- we can't have an explicit continue to an implicitly labelled loop
@@ -396,9 +397,9 @@ purifyStmt labels stmt = case stmt of
return (BlockStmt p [BlockStmt p (concatMap fst r),
VarDeclStmt p (map snd r)])
LabelledStmt p id s -> case isLoop s of
- True -> do s' <- purifyStmt ((id,ExplicitLoopLabel):labels) s
+ True -> do s' <- purifyStmt ((unId id,ExplicitLoopLabel):labels) s
return $ LabelledStmt p id s'
- False -> do s' <- purifyStmt ((id,ExplicitLabel):labels) s
+ False -> do s' <- purifyStmt ((unId id,ExplicitLabel):labels) s
return $ LabelledStmt p id s'
otherwise -> fail $ "purifyExpr received " ++ show stmt
@@ -419,7 +420,7 @@ purifyCatch labels (CatchClause p id s) = do
-- |Assumes that the head of 'labels' is an 'ImplicitSwitchLabel'. After
-- purification, the list of statements in the body is a single block
-- statement.
-purifyCase :: [(Id SourcePos,LabelType)]
+purifyCase :: [(String,LabelType)]
-> CaseClause SourcePos -> State Int (CaseClause SourcePos)
purifyCase labels (CaseDefault p ss) = do
s' <- purifyStmt labels (BlockStmt p ss)
@@ -2,7 +2,7 @@
module WebBits.JavaScript.Syntax(Expression(..),CaseClause(..),Statement(..),
InfixOp(..),CatchClause(..),VarDecl(..),JavaScript(..),
AssignOp(..),Id(..),PrefixOp(..),PostfixOp(..),Prop(..),
- ForInit(..),ForInInit(..)) where
+ ForInit(..),ForInInit(..),unId) where
import Text.ParserCombinators.Parsec(SourcePos) -- used by data JavaScript
import Data.Generics(Data,Typeable)
@@ -16,6 +16,9 @@ data JavaScript a
data Id a = Id a String deriving (Show,Eq,Ord,Data,Typeable)
+unId :: Id a -> String
+unId (Id _ s) = s
+
-- http://developer.mozilla.org/en/docs/
-- Core_JavaScript_1.5_Reference:Operators:Operator_Precedence
data InfixOp = OpLT | OpLEq | OpGT | OpGEq | OpIn | OpInstanceof | OpEq | OpNEq
@@ -20,8 +20,6 @@ jsToCore :: [Statement SourcePos]
jsToCore (VarDeclStmt{}:stmts) = map stmt stmts
jsToCore stmts = error $ "jsToCore: missing global vars:\n" ++ show stmts
-unId (Id _ v) = v
-
unVar (VarRef _ (Id _ v)) = v
unVar e = error $ "expected a VarRef:\n" ++ show e
View
@@ -20,11 +20,8 @@ intraprocGraphToDot gr = GV.graphToDot gr [] -- attributes
main = do
str <- getContents
let script = parse "" str
- -- putStrLn (show (localVars script))
- putStrLn (pretty $ simplify script)
let core = jsToCore (simplify script)
let funcExprs = allFuncExprs core
let graphs = map (intraprocGraph'.funcExprBody) funcExprs
- mapM_ (putStrLn.show.(G.labEdges)) graphs
let vizs = map (show.intraprocGraphToDot) graphs
mapM_ (putStrLn) vizs

0 comments on commit 654a473

Please sign in to comment.