WebBits 0.9.3 → 0.11.0

raw patch · 9 files changed

+202/−157 lines, 9 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• LICENSE +10/−4
• Setup.lhs +6/−8
• WebBits.cabal +3/−3
• src/WebBits/JavaScript.hs +21/−0
• src/WebBits/JavaScript/Environment.hs +26/−7
• src/WebBits/JavaScript/JavaScript.hs +3/−1
• src/WebBits/JavaScript/Lexer.hs +2/−1
• src/WebBits/JavaScript/Parser.hs +119/−121
• src/WebBits/JavaScript/PrettyPrint.hs +12/−12

@@ -1,8 +1,14 @@ Copyright (c) 2007-2008 Arjun Guha and Spiridon Eliopoulos. -Contains source code derived from HtmlPrag 0.16 Copyright (c) 2003 - 2005 -Neil W. Van Dyke, licensed under the terms of the GNU Lesser General Public-License 2.1.- WebBits is licensed under the terms of the GNU Lesser General Public License 2.1.++Contains source code derived from HtmlPrag 0.16, Copyright (c) 2003 - 2005 Neil+W. Van Dyke, licensed under the terms of the GNU Lesser General Public License+2.1.++Contains source code derived from javascript.plt, Copyright (c) 2008 David+Herman, licensed under the terms of the GNU Lesser General Public License 2.1++The tests/ directory contains open-source JavaScript code.  Their licenses+are inline.

@@ -6,20 +6,18 @@  > isHaskellFile file = ".lhs" `L.isSuffixOf` file || ".hs" `L.isSuffixOf` file -> moduleName file = "Test." ++ m where->   m = L.takeWhile (\ch -> ch /= '.') file+> moduleName file = L.takeWhile  (/= '.') file  > testMain _ _ _ _ = do->   files <- getDirectoryContents "src/Test"->   let tests = filter isHaskellFile files->   let testModules = map moduleName tests+>   files <- getDirectoryContents "tests"+>   let testModules = [moduleName f | f <- files, isHaskellFile f] >   let testFuncs = map (++ ".main") testModules >   let testExpr = "sequence [ " ++ concat (L.intersperse "," testFuncs) ++  >                  " ] >>= \\cases -> runTestTT (TestList cases)" >   let moduleLine = concat (L.intersperse " " testModules)->   let cmd = "cd src && ghc  -fno-monomorphism-restriction -fglasgow-exts " ++->             "-package HUnit -e \"" ++ testExpr ++ " >> return ()\" " ++ ->             moduleLine+>   let cmd = "cd tests && ghc  -XNoMonomorphismRestriction -fglasgow-exts " +++>             "-package HUnit -i:../src -e \"" ++ testExpr ++ +>             " >> return ()\" " ++ moduleLine >   putStrLn "Testing command is:" >   putStrLn cmd >   putStrLn "\nLoading tests..."

@@ -1,6 +1,6 @@ Name:           WebBits-Version:        0.9.3-Cabal-Version:	>= 1.2+Version:        0.11.0+Cabal-Version:	>= 1.2.3 Copyright:      Copyright (c) 2007-2008 Arjun Guha and Spiridon Eliopoulos License:        LGPL License-file:   LICENSE@@ -47,4 +47,4 @@     WebBits.JavaScript.JavaScript WebBits.JavaScript.Lexer      WebBits.JavaScript.Parser WebBits.JavaScript.PrettyPrint     WebBits.JavaScript.Syntax WebBits.JavaScript.Environment-    WebBits.JavaScript.Crawl+    WebBits.JavaScript.Crawl WebBits.JavaScript

@@ -0,0 +1,21 @@+-- |Re-exports commonly used modules.+module WebBits.JavaScript+  ( module WebBits.JavaScript.Syntax+  , module WebBits.JavaScript.HtmlEmbedding+  , module WebBits.JavaScript.Parser+  , module WebBits.JavaScript.Combinators+  , module WebBits.Common+  , module WebBits.JavaScript.Environment+  -- JavaScript.Instances exports nothing+  ) where++import WebBits.Common++import WebBits.JavaScript.Syntax+import WebBits.JavaScript.Parser+import WebBits.JavaScript.PrettyPrint+import WebBits.JavaScript.HtmlEmbedding+import WebBits.JavaScript.Combinators+import WebBits.JavaScript.Environment++import WebBits.JavaScript.Instances

@@ -210,6 +210,17 @@ labelProp e = gmapM labelAny e  +labelVarDecl :: VarDecl Ann+             -> Z.ZipperT Env (State Int) (VarDecl Ann)+labelVarDecl (VarDecl (_,_,loc) id@(Id _ name) rhs) = do+  env <- Z.getNode+  case M.lookup name env of+    Nothing -> fail $ "WebBits bug: unbound id in labelVarDecl (" ++ name ++ ")"+    Just lbl' -> case rhs of+      Nothing -> return (VarDecl (env,lbl',loc) id Nothing)+      Just expr -> do+        expr' <- labelExpr expr+        return (VarDecl (env,lbl',loc) id (Just expr'))  labelExpr :: Expression Ann            -> Z.ZipperT Env (State Int) (Expression Ann)@@ -224,6 +235,11 @@   id' <- labelIdNoVar id   expr' <- labelExpr expr   return (DotRef (env,lbl,loc) expr' id')+labelExpr (VarRef (_,_,loc) id@(Id _ name)) = do+  env <- Z.getNode+  case M.lookup name env of+    Nothing -> fail $ "WebBits bug : unbound identifer " ++ name+    Just lbl' -> return (VarRef (env,lbl',loc) id) labelExpr (FuncExpr (_,_,loc) args stmt) = do   env <- Z.getNode   lbl <- nextLabel@@ -265,21 +281,24 @@  labelAny :: GenericM (Z.ZipperT Env (State Int))  labelAny a = (labelAny' `extM` labelEnv `extM` labelId `extM` labelProp `extM`-  labelExpr `extM` labelStmt) a+  labelExpr `extM` labelStmt `extM` labelVarDecl) a +topLevelPartialEnv = (M.empty,S.singleton "this")+ -- |Annotates each expression with its static environment.  In addition, -- a map of free identifiers is returned, along with the next valid label. staticEnvironment :: [Statement SourcePos] -                  -> ([Statement Ann],Env,Int)+                  -> ([Statement Ann],Env,Env,Int) staticEnvironment stmts =   let stmts' = explicitThis stmts       labelM = do         partialEnvTree <- Z.execZipperT (mapM buildStmt stmts')-                            (Z.toLocation (Z.Node emptyPartialEnv []))-        (envTree,globals) <- runStateT (completeEnvM partialEnvTree) M.empty+                            (Z.toLocation (Z.Node topLevelPartialEnv []))+        (envTree,freeEnv) <- runStateT (completeEnvM partialEnvTree) M.empty+        let globals = M.union freeEnv (Z.rootLabel envTree)         let stmts'' = map insertEmptyAnn stmts'          labelledStmts <- Z.evalZipperT (mapM labelStmt stmts'')                                         (Z.toLocation envTree)-        return (labelledStmts,globals)-      ((labelledStmts,globals),nextLabel) = runState labelM 0-    in (labelledStmts,globals,nextLabel)+        return (labelledStmts,freeEnv,globals)+      ((labelledStmts,freeEnv,globals),nextLabel) = runState labelM 1+    in (labelledStmts,freeEnv,globals,nextLabel)

@@ -4,10 +4,12 @@   , module WebBits.JavaScript.HtmlEmbedding   , module WebBits.JavaScript.Parser   , module WebBits.JavaScript.Combinators+  , module WebBits.Common   -- JavaScript.Instances exports nothing   ) where --- +import WebBits.Common+ import WebBits.JavaScript.Syntax import WebBits.JavaScript.Parser import WebBits.JavaScript.PrettyPrint

@@ -1,7 +1,7 @@ {- This isn't a lexer in the sense that it provides a JavaScript token-stream.
  - This module provides character-parsers for various JavaScript tokens.
  -}
-module WebBits.JavaScript.Lexer(identifier,reserved,operator,reservedOp,charLiteral,
+module WebBits.JavaScript.Lexer(lexeme,identifier,reserved,operator,reservedOp,charLiteral,
                         stringLiteral,natural,integer,float,naturalOrFloat,
                         decimal,hexadecimal,octal,symbol,whiteSpace,parens,
                         braces,brackets,squares,semi,comma,colon,dot,
@@ -61,3 +61,4 @@ colon = T.colon lex	
 dot = T.dot lex
 brackets = T.brackets lex
+lexeme = T.lexeme lex

@@ -1,10 +1,16 @@-module WebBits.JavaScript.Parser(parseScript,parseExpression,parseStatement
+module WebBits.JavaScript.Parser(parseScript,parseExpression
+   , parseString
    , parseScriptFromString
    , emptyParsedJavaScript
    , ParsedStatement
    , ParsedExpression
    , parseJavaScriptFromFile
    , parseSimpleExpr'
+   , parseBlockStmt
+   , parseStatement
+   , StatementParser
+   , ExpressionParser
+   , parseAssignExpr
    ) where
 
 import WebBits.JavaScript.Lexer hiding (identifier)
@@ -16,18 +22,16 @@ import Control.Monad.Trans (MonadIO,liftIO)
 import Numeric(readDec,readOct,readHex)
 import Data.Char(chr)
+import Data.Char
 
 -- We parameterize the parse tree over source-locations.
-type ParsedExpr = Expression SourcePos
-type ParsedStmt = Statement SourcePos
-
 type ParsedStatement = Statement SourcePos
 type ParsedExpression = Expression SourcePos
 
 
 -- These parsers can store some arbitrary state
-type StatementParser state = CharParser state ParsedStmt
-type ExpressionParser state = CharParser state ParsedExpr
+type StatementParser state = CharParser state ParsedStatement
+type ExpressionParser state = CharParser state ParsedExpression
 
 identifier =
   liftM2 Id getPosition Lexer.identifier
@@ -88,8 +92,8 @@ parseDoWhileStmt = do
   pos <- getPosition
   reserved "do"
-  body <- parseStatement
-  reserved "while"
+  body <- parseBlockStmt
+  reserved "while" <?> "while at the end of a do block"
   test <- parseParenExpr <?> "parenthesized test-expression in do loop"
   optional semi
   return (DoWhileStmt pos body test)
@@ -286,16 +290,11 @@ 
 
 parseBoolLit:: ExpressionParser st
-parseBoolLit =
-  let parseTrueLit = do
-        pos <- getPosition
-        reserved "true"
-        return (BoolLit pos True)
-      parseFalseLit = do
-        pos <- getPosition
-        reserved "false"
-        return (BoolLit pos False)
-    in parseTrueLit <|> parseFalseLit
+parseBoolLit = do
+    pos <- getPosition
+    let parseTrueLit  = reserved "true"  >> return (BoolLit pos True)
+        parseFalseLit = reserved "false" >> return (BoolLit pos False)
+    parseTrueLit <|> parseFalseLit
 
 parseVarRef:: ExpressionParser st
 parseVarRef = liftM2 VarRef getPosition identifier
@@ -321,8 +320,8 @@ 
 parseEscapeChar = do
   c <- oneOf allEscapes
-  (Just c') <- return $ lookup c escapeChars
-  return c'
+  let (Just c') = lookup c escapeChars -- will succeed due to line above
+  return c' 
 
 parseAsciiHexChar = do
   char 'x'
@@ -337,6 +336,7 @@         
 isWhitespace ch = ch `elem` " \t"
 
+
 -- The endWith argument is either single-quote or double-quote, depending on how
 -- we opened the string.
 parseStringLit' endWith =
@@ -345,10 +345,12 @@       cs <- parseStringLit' endWith
       return $ "'" ++ cs) <|>
   (do char '\\'
-      c <- (parseEscapeChar <|> parseAsciiHexChar <|> parseUnicodeHexChar <|> char '\r' <|> char '\n')
+      c <- parseEscapeChar <|> parseAsciiHexChar <|> parseUnicodeHexChar <|> 
+           char '\r' <|> char '\n'
       cs <- parseStringLit' endWith
-      -- TODO: Leading whitespace on the new line is probably meant to be ignored.
-      if c == '\r' || c == '\n' then return (c:(dropWhile isWhitespace cs)) else return cs) <|>
+      if c == '\r' || c == '\n' 
+        then return (c:(dropWhile isWhitespace cs)) 
+        else return (c:cs)) <|>
    (liftM2 (:) anyChar (parseStringLit' endWith))
 
 parseStringLit:: ExpressionParser st
@@ -356,14 +358,13 @@   pos <- getPosition
   -- parseStringLit' takes as an argument the quote-character that opened the
   -- string.
-  str <- (char '\'' >>= parseStringLit') <|> (char '\"' >>= parseStringLit')
+  str <- lexeme $ (char '\'' >>= parseStringLit') <|> (char '\"' >>= parseStringLit')
   -- CRUCIAL: Parsec.Token parsers expect to find their token on the first
-  -- character, and read whitespaces beyond their tokens.  Without this,
-  -- expressions like:
+  -- character, and read whitespaces beyond their tokens.  Without 'lexeme'
+  -- above, expressions like:
   --   var s = "string"   ;
   -- do not parse.
-  spaces 
-  return (StringLit pos str)
+  return $ StringLit pos str
 
 --}}}
 
@@ -374,7 +375,12 @@         return $ \f -> f ('g' `elem` flags) ('i' `elem` flags) 
   let parseEscape = char '\\' >> anyChar
   let parseChar = noneOf "/"
-  let parseRe = (char '/' >> return "") <|> (char '\\' >> liftM2 (:) anyChar parseRe) <|> (liftM2 (:) anyChar parseRe)
+  let parseRe = (char '/' >> return "") <|> 
+                (do char '\\'
+                    ch <- anyChar -- TOOD: too lenient
+                    rest <- parseRe
+                    return ('\\':ch:rest)) <|> 
+                (liftM2 (:) anyChar parseRe)
   pos <- getPosition
   char '/'
   pat <- parseRe --many1 parseChar
@@ -396,7 +402,7 @@         val <- parseAssignExpr
         return (name,val)
     in do pos <- getPosition
-          props <- braces (parseProp `sepBy` comma) <?> "object literal"
+          props <- braces (parseProp `sepEndBy` comma) <?> "object literal"
           return $ ObjectLit pos props
 
 --{{{ Parsing numbers.  From pg. 17-18 of ECMA-262.
@@ -407,54 +413,60 @@   [(hex,"")] <- return $ Numeric.readHex digits
   return hex
 
-decimalDigit = oneOf "0123456789"
-
 -- Creates a decimal value from a whole, fractional and exponent part.
 mkDecimal:: Double -> Double -> Int -> Double
 mkDecimal w f e =
   if (f >= 1.0)
     then mkDecimal w (f / 10.0) e
-    else (w+f) * (10.0^e)
-
-decimalInteger = do
-  xs <- many1 decimalDigit
-  spaces
-  return $ (fst.head.readDec) xs
-
-{-  (try (char '0' >> spaces >> return 0)) <|>
-  (do xs <- many1 decimalDigit
-      return $ (fst.head.readDec) xs) -}
+    else (w + f) * (10.0 ^^ e)
 
 exponentPart = do
   oneOf "eE"
-  ((char '+' >> many1 decimalDigit >>= return.fst.head.readDec) <|> 
-   (char '-' >> many1 decimalDigit >>= return.negate.fst.head.readDec) <|>
-   (many1 decimalDigit >>= return.fst.head.readDec))
+  (char '+' >> decimal) <|> (char '-' >> negate `fmap` decimal) <|> decimal
   
 decLit =
-  (do whole <- decimalInteger
-      frac <- option 0 (char '.' >> decimalInteger)
+  (do whole <- decimal
+      frac <- option 0 (char '.' >> decimal)
       exp <- option 0  exponentPart
-      return $ mkDecimal (fromIntegral whole) (fromIntegral frac) exp) <|>
-  (do frac <- char '.' >> decimalInteger
+      return $ mkDecimal (fromIntegral whole) (fromIntegral frac) (fromIntegral exp)) <|>
+  (do frac <- char '.' >> decimal
       exp <- option 0  exponentPart
-      return $ mkDecimal 0.0 (fromIntegral frac) exp)
+      return $ mkDecimal 0.0 (fromIntegral frac) (fromIntegral exp))
 
 parseNumLit:: ExpressionParser st
-parseNumLit = 
-  liftM2 NumLit getPosition
-    (do x <- hexLit <|> decLit
-        (notFollowedBy identifierStart <?> "whitespace") 
-        spaces
-        return x)
+parseNumLit = do
+    pos <- getPosition
+    num <- lexeme $ hexLit <|> decLit
+    notFollowedBy identifierStart <?> "whitespace"
+    return $ NumLit pos num
 
 --}}}
 
+------------------------------------------------------------------------------
+-- Position Helper
+------------------------------------------------------------------------------
+
+withPos cstr p = do { pos <- getPosition; e <- p; return $ cstr pos e }
+
+-------------------------------------------------------------------------------
+-- Compound Expression Parsers
+-------------------------------------------------------------------------------
+
+dotRef e = (reservedOp "." >> withPos cstr identifier) <?> "property.ref"
+    where cstr pos key = DotRef pos e key
+
+funcApp e = (parens $ withPos cstr (parseExpression `sepBy` comma)) <?> "(function application)"
+    where cstr pos args = CallExpr pos e args
+
+bracketRef e = (brackets $ withPos cstr parseExpression) <?> "[property-ref]"
+    where cstr pos key = BracketRef pos e key
+
+-------------------------------------------------------------------------------
+-- Expression Parsers
+-------------------------------------------------------------------------------
+
 parseParenExpr:: ExpressionParser st
-parseParenExpr = do
-  pos <- getPosition
-  expr <- parens parseListExpr
-  return (ParenExpr pos expr)
+parseParenExpr = withPos ParenExpr (parens parseListExpr)
 
 -- everything above expect functions
 parseExprForNew = parseThisRef <|> parseNullLit <|> parseBoolLit <|> parseStringLit 
@@ -475,44 +487,16 @@       return (NewExpr pos constructor arguments)) <|>
   parseSimpleExpr'
 
-parseSimpleExpr (Just e) =
-  ((do reservedOp "." <?> "property.ref"
-       pos <- getPosition
-       key <- identifier
-       parseSimpleExpr $ Just (DotRef pos e key)) <|>
-   (do pos <- getPosition
-       reservedOp "(" <?> "(function application)" 
-       args <- parseExpression `sepBy` comma
-       --reservedOp ")"
-       spaces   -- This hack is needed as the token parser parses ")+", ")-",
-       char ')' -- etc. as a single token.
-       spaces
-       parseSimpleExpr $ Just (CallExpr pos e args)) <|>
-   (do reservedOp "[" <?> "[property-ref]"
-       pos <- getPosition
-       key <- parseExpression <?> "expression (2)"
-       char ']'
-       spaces
-       --reservedOp "]"
-       parseSimpleExpr $ Just (BracketRef pos e key)) <|>
-   (return e))
+parseSimpleExpr (Just e) = (do
+    e' <- dotRef e <|> funcApp e <|> bracketRef e
+    parseSimpleExpr $ Just e') <|> (return e)
 parseSimpleExpr Nothing = do
   e <- parseNewExpr <?> "expression (3)"
   parseSimpleExpr (Just e)
-  
-parseSimpleExprForNew (Just e) =
-  ((do reservedOp "." <?> "property.ref"
-       pos <- getPosition
-       key <- identifier
-       parseSimpleExprForNew $ Just (DotRef pos e key)) <|>
-   (do reservedOp "[" <?> "[property-ref]"
-       pos <- getPosition
-       key <- parseExpression <?> "expression (2)"
-       char ']'
-       spaces
-       --reservedOp "]"
-       parseSimpleExprForNew $ Just (BracketRef pos e key)) <|>
-   (return e))
+
+parseSimpleExprForNew (Just e) = (do
+    e' <- dotRef e <|> bracketRef e
+    parseSimpleExprForNew $ Just e') <|> (return e)
 parseSimpleExprForNew Nothing = do
   e <- parseNewExpr <?> "expression (3)"
   parseSimpleExprForNew (Just e)
@@ -543,32 +527,42 @@     (reservedOp str <|> reserved str)
     return (PostfixExpr pos constr) -- points-free, returns a function
 
--- apparently, expression tables can't handle multiple prefixes (which makes sense, since chaining ++ and -- doesn't 
--- make any sense)
+prefixIncDecExpr = do
+  pos <- getPosition
+  op <- optionMaybe $ (reservedOp "++" >> return PrefixInc) <|>
+                      (reservedOp "--" >> return PrefixDec)
+  case op of
+    Nothing -> parseSimpleExpr Nothing
+    Just op -> do
+      innerExpr <- parseSimpleExpr Nothing -- TODO: must be an l-val, I think
+      return (PrefixExpr pos op innerExpr)
+
+-- apparently, expression tables can't handle immediately-nested prefixes
+
 parsePrefixedExpr = do
-  pos <- getPosition 
-  op <- optionMaybe $ (reservedOp "!" >> return PrefixLNot) <|> (reservedOp "~" >> return PrefixBNot)
+  pos <- getPosition
+  op <- optionMaybe $ (reservedOp "!" >> return PrefixLNot) <|> 
+                      (reservedOp "~" >> return PrefixBNot) <|>
+                      (try (lexeme $ char '-' >> notFollowedBy (char '-')) >>
+                       return PrefixMinus) <|>
+                      (try (lexeme $ char '+' >> notFollowedBy (char '+')) >>
+                       return PrefixPlus) <|>
+                      (reserved "typeof" >> return PrefixTypeof) <|>
+                      (reserved "void" >> return PrefixVoid) <|>
+                      (reserved "delete" >> return PrefixDelete)
   case op of
-    Nothing -> parseSimpleExpr Nothing  -- new is treated as a simple expr
+    Nothing -> prefixIncDecExpr  -- new is treated as a simple expr
     Just op -> do
       innerExpr <- parsePrefixedExpr
       return (PrefixExpr pos op innerExpr)
-    
-exprTable:: [[Operator Char st ParsedExpr]]
+
+exprTable:: [[Operator Char st ParsedExpression]]
 exprTable = 
   [
    [makePrefixExpr "++" PrefixInc,
     makePostfixExpr "++" PostfixInc],
    [makePrefixExpr "--" PrefixDec,
     makePostfixExpr "--" PostfixDec],
-   -- What we really need here is a good, old-fashioned lexer.
-   [mkPrefix (try $ char '+' >> notFollowedBy (char '+')) PrefixPlus,
-    mkPrefix (try $ char '-' >> notFollowedBy (char '-')) PrefixMinus],
-    -- makePrefixExpr "-" PrefixMinus],
-   [makePrefixExpr "typeof" PrefixTypeof,
-    makePrefixExpr "void" PrefixVoid,
-    makePrefixExpr "delete" PrefixDelete],
-    
    [makeInfixExpr "*" OpMul, makeInfixExpr "/" OpDiv, makeInfixExpr "%" OpMod],
    [makeInfixExpr "+" OpAdd, makeInfixExpr "-" OpSub],
    [makeInfixExpr "<<" OpLShift, makeInfixExpr ">>" OpSpRShift,
@@ -590,19 +584,18 @@ 
 --{{{ Parsing ternary operators: left factored
 
-parseTernaryExpr':: CharParser st (Maybe (ParsedExpr,ParsedExpr))
-parseTernaryExpr' =
-  (do reservedOp "?"
-      l <- parseTernaryExpr
-      colon
-      r <- parseTernaryExpr
-      return $ Just (l,r)) <|>
-  (return Nothing)
+parseTernaryExpr':: CharParser st (ParsedExpression,ParsedExpression)
+parseTernaryExpr' = do
+    reservedOp "?"
+    l <- parseAssignExpr
+    colon
+    r <- parseAssignExpr
+    return $(l,r)
 
 parseTernaryExpr:: ExpressionParser st
 parseTernaryExpr = do
   e <- parseExpression'
-  e' <- parseTernaryExpr'
+  e' <- optionMaybe parseTernaryExpr'
   case e' of
     Nothing -> return e
     Just (l,r) -> do p <- getPosition
@@ -611,13 +604,13 @@ 
 -- Parsing assignment operations.
 makeAssignExpr str constr = Infix parser AssocRight where
-  parser:: CharParser st (ParsedExpr -> ParsedExpr -> ParsedExpr)
+  parser:: CharParser st (ParsedExpression -> ParsedExpression -> ParsedExpression)
   parser = do
     pos <- getPosition
     reservedOp str
     return (AssignExpr pos constr)
 
-assignTable:: [[Operator Char st ParsedExpr]]
+assignTable:: [[Operator Char st ParsedExpression]]
 assignTable = [
   [makeAssignExpr "=" OpAssign, makeAssignExpr "+=" OpAssignAdd, 
     makeAssignExpr "-=" OpAssignSub, makeAssignExpr "*=" OpAssignMul,
@@ -657,3 +650,8 @@ 
 emptyParsedJavaScript = 
   Script (error "Parser.emptyParsedJavaScript--no annotation") []
+
+parseString :: String -> [Statement SourcePos]
+parseString str = case parse parseScript "" str of
+  Left err -> error (show err)
+  Right (Script _ stmts) -> stmts

@@ -40,13 +40,13 @@  instance PrettyPrintable (CaseClause a) where   pp (CaseClause _ expr stmts) =-    pp expr <+> colon $$ (nest 2 (vcat (map pp stmts)))+    text "case" $+$ pp expr <+> colon $$ (nest 2 (vcat (map pp stmts)))   pp (CaseDefault _ stmts) =     text "default:" $$ (nest 2 (vcat (map pp stmts)))  instance PrettyPrintable (CatchClause a) where   pp (CatchClause _ id stmt) =-    text "catch" <+> (parens.pp) id <+> pp stmt+    text "catch" <+> (parens.pp) id <+> inBlock stmt   instance PrettyPrintable (VarDecl a) where@@ -74,7 +74,7 @@   pp (ReturnStmt _ expr) =     text "return" <+> pp expr <> semi   pp (DoWhileStmt _ stmt expr) =-    text "do" $$ (nest 2 (pp stmt <+> inParens expr))+    text "do" $$ (nest 2 (pp stmt <+> text "while" <+> inParens expr))   pp (BreakStmt _ Nothing) =     text "break;"   pp (BreakStmt _ (Just label)) =@@ -92,11 +92,10 @@     text "for" <+> parens (pp init <> semi <+> pp incr <> semi <+> pp test)       $$ (nest 2 (pp body))   pp (TryStmt _ stmt catches finally) =-    (text "try" $$ pp stmt $$ (vcat (map pp catches)) $$ ppFinally) where-      ppFinally = -        case finally of-          Nothing -> empty-	  (Just stmt) -> text "finally" <> pp stmt+    text "try" $$ inBlock stmt $$ (vcat (map pp catches)) $$ ppFinally where +      ppFinally = case finally of+        Nothing -> empty+        Just stmt -> text "finally" <> inBlock stmt   pp (ThrowStmt _ expr) =     text "throw" <+> pp expr <> semi   pp (WithStmt _ expr stmt) | isParenExpr expr =@@ -112,7 +111,7 @@  instance PrettyPrintable (Prop a) where   pp (PropId _ id) = pp id-  pp (PropString _ str) = text str+  pp (PropString _ str) = doubleQuotes (text (jsEscape str))   pp (PropNum _ n) = text (show n)  @@ -198,8 +197,8 @@ -- Based on: --   http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Guide:Literals jsEscape:: String -> String-jsEscape str =-  if str == ""  then "" else (sel (head str)) ++ (jsEscape (tail str)) where+jsEscape "" = ""+jsEscape (ch:chs) = (sel ch) ++ jsEscape chs where     sel '\b' = "\\b"     sel '\f' = "\\f"     sel '\n' = "\\n"@@ -208,6 +207,7 @@     sel '\v' = "\\v"     sel '\'' = "\\'"     sel '\"' = "\\\""+    sel '\\' = "\\\\"     sel x    = [x]     -- We don't have to do anything about \X, \x and \u escape sequences. @@ -242,7 +242,7 @@   pp (InfixExpr _ op left right) =      pp left <+> pp op <+> pp right   pp (CondExpr _ test cons alt) =-    inParens test <+> text "?" <+> inParens cons <+> colon <+> inParens alt+    pp test <+> text "?" <+> pp cons <+> colon <+> pp alt   pp (AssignExpr _ op l r) =     pp l <+> pp op <+> pp r   pp (ParenExpr _ expr) =