version 0.90.9

12 files changed, 1802 insertions, 0 deletions

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..ac6e4ee
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+Copyright (c) 2007--2012, Brown University, 2008-2012 Claudiu Saftoiu,
+2012 Stevens Institute of Technology.
+All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright 
+      notice, this list of conditions and the following disclaimer in the 
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Brown University, Stevens Institute of Technology
+      nor the names of its contributors may be used to endorse or promote
+      products derived from this software without specific prior written 
+      permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/language-ecmascript.cabal b/language-ecmascript.cabal
new file mode 100644
index 0000000..07c4857
--- /dev/null
+++ b/language-ecmascript.cabal
@@ -0,0 +1,79 @@
+Name:           language-ecmascript
+Version:        0.9
+Cabal-Version:	>= 1.10
+Copyright:      (c) 2007-2012 Brown University, (c) 2008-2010 Claudiu Saftoiu,
+                (c) 2012 Stevens Institute of Technology
+License:        BSD3
+License-file:   LICENSE
+Author:         Andrey Chudnov, Arjun Guha, Spiridon Aristides Eliopoulos,
+                Joe Gibbs Politz, Claudiu Saftoiu
+Maintainer:     Andrey Chudnov <oss@chudnov.com>
+Homepage:       http://github.com/jswebtools/language-ecmascript
+Bug-reports:    http://github.com/jswebtools/language-ecmascript/issues
+Stability:      provisional
+Tested-with:    GHC==7.0.4, GHC==7.4.1
+Category:       Language
+Build-Type:     Simple
+Synopsis:       JavaScript analysis tools
+Description:
+  Some tools for working with ECMAScript 3 (popularly known as JavaScript). 
+  Includes a parser, pretty-printer, and basic building blocks for more
+  sophisticated tools.
+
+  This package supercedes package WebBits.
+
+Source-repository head
+   type: git
+   location: git://github.com/jswebtools/language-ecmascript.git
+
+Source-repository this
+   type: git
+   location: git://github.com/jswebtools/language-ecmascript.git
+   tag: 0.9
+
+Library
+  Hs-Source-Dirs:
+    src
+  Build-Depends:
+    base >= 4 && < 5,
+    mtl >= 1.1.0.1,
+    parsec < 3.2.0,
+    pretty >= 0.1,
+    containers >= 0.1,
+    syb >= 0.1,
+    uniplate >= 1.6 && <1.7,
+    data-default >= 0.4 && <0.5
+  ghc-options:
+    -fwarn-incomplete-patterns
+  Exposed-Modules:
+    Language.ECMAScript3 
+    Language.ECMAScript3.Lexer 
+    Language.ECMAScript3.Parser
+    Language.ECMAScript3.PrettyPrint
+    Language.ECMAScript3.Syntax
+    Language.ECMAScript3.Syntax.Annotations
+    Language.ECMAScript3.Analysis.Environment
+    Language.ECMAScript3.Analysis.LabelSets
+  Default-Extensions:
+    DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts
+  Default-Language: Haskell2010
+
+Test-Suite unittest
+  Hs-Source-Dirs: src
+  Type: exitcode-stdio-1.0
+  Main-Is: UnitTest.hs
+  Build-Depends:
+    base >= 4 && < 5,
+    mtl >= 1.1.0.1,
+    parsec < 3.2.0,
+    pretty >= 0.1,
+    containers >= 0.1,
+    syb >= 0.1,
+    directory,
+    filepath,
+    HUnit,
+    data-default >=0.4 && <0.5
+  Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts
+  Default-Language: Haskell2010
+  ghc-options:
+    -fwarn-incomplete-patterns
diff --git a/src/Language/ECMAScript3.hs b/src/Language/ECMAScript3.hs
new file mode 100644
index 0000000..77a6917
--- /dev/null
+++ b/src/Language/ECMAScript3.hs
@@ -0,0 +1,12 @@
+-- |Re-exports commonly used modules.
+module Language.ECMAScript3
+  ( module Language.ECMAScript3.Syntax
+  , module Language.ECMAScript3.Parser
+  , renderStatements
+  , renderExpression
+  ) where
+
+
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.Parser
+import Language.ECMAScript3.PrettyPrint
diff --git a/src/Language/ECMAScript3/Analysis/Environment.hs b/src/Language/ECMAScript3/Analysis/Environment.hs
new file mode 100644
index 0000000..c845203
--- /dev/null
+++ b/src/Language/ECMAScript3/Analysis/Environment.hs
@@ -0,0 +1,156 @@
+-- | A lexical environment analysis of ECMAScript programs
+
+module Language.ECMAScript3.Analysis.Environment
+  ( 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
+
+-- | Intermediate data structure that contains locally declared names and
+-- all references to identifers.
+data Partial = Partial {
+  partialLocals :: M.Map String SourcePos,
+  partialReferences :: M.Map String SourcePos,
+  partialNested :: [Partial]
+}
+
+empty :: Partial
+empty = Partial M.empty M.empty []
+
+ref :: Id SourcePos -> Partial
+ref (Id p v) = Partial M.empty (M.singleton v p) []
+
+decl :: Id SourcePos -> Partial
+decl (Id p v) = Partial (M.singleton v p) M.empty []
+
+nest :: Partial -> Partial
+nest partial = Partial M.empty M.empty [partial]
+
+-- Combine partial results from the same lexical scope.
+unions :: [Partial] -> Partial
+unions ps = Partial (M.unions (map partialLocals ps))
+                    (M.unions (map partialReferences ps))
+                    (concatMap partialNested ps)
+
+javascript :: JavaScript SourcePos -> Partial
+javascript (Script _ ss) = unions (map stmt ss)
+
+
+lvalue :: LValue SourcePos -> Partial
+lvalue lv = case lv of
+  LVar p x -> ref (Id p x)
+  LDot _ e _ -> expr e
+  LBracket _ e1 e2 -> unions [expr e1, expr e2]
+
+expr :: Expression SourcePos -> Partial
+expr e = case e of
+  StringLit _ _ -> empty
+  RegexpLit {} -> empty
+  NumLit _ _ -> empty
+  IntLit _ _ -> empty
+  BoolLit _ _ -> empty
+  NullLit _ -> empty
+  ArrayLit _ es -> unions (map expr es)
+  ObjectLit _ props -> unions (map (expr.snd) props)
+  ThisRef _ -> empty
+  VarRef _ id -> empty
+  DotRef _ e _ -> expr e
+  BracketRef _ e1 e2 -> unions [expr e1, expr e2]
+  NewExpr _ e1 es -> unions [expr e1, unions $ map expr es]
+  PrefixExpr _ _ e -> expr e
+  InfixExpr _ _ e1 e2 -> unions [expr e1, expr e2]
+  CondExpr _ e1 e2 e3 -> unions [expr e1, expr e2, expr e3]
+  AssignExpr _ _ lv e -> unions [lvalue lv, expr e]
+  UnaryAssignExpr _ _ lv -> lvalue lv
+  ParenExpr _ e -> expr e
+  ListExpr _ es -> unions (map expr es)
+  CallExpr _ e es -> unions [expr e, unions $ map expr es]
+  FuncExpr _ _ args s -> nest $ unions [unions $ map decl args, stmt s]
+
+caseClause :: CaseClause SourcePos -> Partial
+caseClause cc = case cc of
+  CaseClause _ e ss -> unions [expr e, unions $ map stmt ss]
+  CaseDefault _ ss -> unions $ map stmt ss
+
+-- TODO: Verify that this is a declaration and not a reference.
+catchClause :: CatchClause SourcePos -> Partial
+catchClause (CatchClause _ id s) = unions [decl id, stmt s]
+
+varDecl :: VarDecl SourcePos -> Partial
+varDecl (VarDecl _ id Nothing) = decl id
+varDecl (VarDecl _ id (Just e)) = unions [decl id, expr e]
+ 
+forInit :: ForInit SourcePos -> Partial
+forInit fi = case fi of
+  NoInit -> empty
+  VarInit ds -> unions $ map varDecl ds
+  ExprInit e -> expr e 
+
+forInInit :: ForInInit SourcePos -> Partial
+forInInit (ForInVar id) = decl id
+forInInit (ForInLVal lv) = lvalue lv
+  
+stmt :: Statement SourcePos -> Partial
+stmt s = case s of
+  BlockStmt _ ss -> unions $ map stmt ss
+  EmptyStmt _ -> empty
+  ExprStmt _ e -> expr e
+  IfStmt _ e s1 s2 -> unions [expr e, stmt s1, stmt s2]
+  IfSingleStmt _ e s -> unions [expr e, stmt s]
+  SwitchStmt _ e cases -> unions [expr e, unions $ map caseClause cases]
+  WhileStmt _ e s -> unions [expr e, stmt s]
+  DoWhileStmt _ s e -> unions [stmt s, expr e]
+  BreakStmt _ _ -> empty
+  ContinueStmt _ _ -> empty
+  LabelledStmt _ _ s -> stmt s
+  ForInStmt _ fii e s -> unions [forInInit fii, expr e, stmt s]
+  ForStmt _ fi  me1 me2 s -> 
+    unions [forInit fi, maybe empty expr me1, maybe empty expr me2, stmt s]
+  TryStmt _ s mcatch ms ->
+    unions [stmt s, maybe empty catchClause mcatch, maybe empty stmt ms]
+  ThrowStmt _ e -> expr e
+  ReturnStmt _ me -> maybe empty expr me
+  WithStmt _ e s -> unions [expr e, stmt s]
+  VarDeclStmt _ decls -> unions $ map varDecl decls
+  FunctionStmt _ fnId args s ->
+    unions [decl fnId, nest $ unions [unions $ map decl args, stmt s]]
+
+-- |The statically-determinate lexical structure of a JavaScript program.
+data EnvTree = EnvTree (M.Map String SourcePos) [EnvTree]
+
+-- A 'Partial' specifies identifier references in addition to identifier
+-- declarations.  We descend into a 'Partial', pushing enclosing declarations
+-- in to remove references to identifiers declared in the enclosing scope.
+-- Any referencs to identifiers not declared in either the current or the
+-- enclosing scope are local definitions of global variables.
+makeEnvTree :: Map String SourcePos -- ^enclosing environment
+            -> Partial -- ^local environment and references
+            -> (EnvTree,Map String SourcePos) 
+            -- ^environment and global definitions
+makeEnvTree enclosing (Partial locals references nested) = (tree,globals) where
+  nestedResults = map (makeEnvTree (locals `M.union` enclosing)) nested
+  tree = EnvTree locals (map fst nestedResults)
+  globals' = (references `M.difference` locals) `M.difference` enclosing
+  globals = M.unions (globals':map snd nestedResults)
+
+env :: Map String SourcePos -- ^browser/testing environment
+    -> [Statement SourcePos] 
+    -> (EnvTree,Map String SourcePos)
+env globals program = makeEnvTree globals (unions $ map stmt program)
+
+
+localVars :: [Statement SourcePos]
+          -> [(String, SourcePos)]
+localVars body = M.toList locals where
+  Partial locals _ _ = unions $ map stmt body
+
diff --git a/src/Language/ECMAScript3/Analysis/LabelSets.hs b/src/Language/ECMAScript3/Analysis/LabelSets.hs
new file mode 100644
index 0000000..e8b75a9
--- /dev/null
+++ b/src/Language/ECMAScript3/Analysis/LabelSets.hs
@@ -0,0 +1,88 @@
+-- | Label-set analysis which annotates all the statements in the script
+-- with their label sets according to ECMAScript specification,
+-- section 12.12. The result of this analysis are useful for building
+-- control-flow graphs.
+
+module Language.ECMAScript3.Analysis.LabelSets (annotateLabelSets 
+                                               ,Label(..)) where
+
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.Syntax.Annotations
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Generics.Uniplate.Data
+import Data.Data (Data)
+import Control.Applicative
+import Data.Typeable (Typeable)
+
+-- | Labels are either strings (identifiers) or /empty/ (see 12.12 of
+-- the spec)
+data Label = Label String
+           | EmptyLabel
+             deriving (Ord, Eq, Show, Data, Typeable)
+
+-- | Annotates statements with their label sets; example use:
+--
+-- >>> let jsa = reannotate (\a -> (a, Set.empty))
+-- >>> in  annotateLabelSets jsa snd (\labs (a, ls) -> (a, labs `Set.union` ls))
+annotateLabelSets :: Data a =>
+                     (a -> Set Label) -- ^ annotation read function
+                  -> (Set Label -> a -> a) -- ^ annotation write function
+                  -> JavaScript a  -- ^ the script to annotate
+                  -> JavaScript a
+annotateLabelSets r w = transformBi (annotateFuncStmtBodies r w)
+                      . transformBi (annotateFuncExprBodies r w)
+                      . descendBi   (annotateStatement r w)
+
+annotateFuncStmtBodies :: Data a => 
+                          (a -> Set Label)
+                       -> (Set Label -> a -> a) 
+                       -> Statement a
+                       -> Statement a
+annotateFuncStmtBodies r w s = case s of
+  FunctionStmt a name params body -> 
+    let newbody = descend (annotateStatement r w) body
+    in  FunctionStmt a name params newbody
+  _ -> s
+                       
+annotateFuncExprBodies :: Data a => 
+                          (a -> Set Label)
+                       -> (Set Label -> a -> a) 
+                       -> Expression a 
+                       -> Expression a
+annotateFuncExprBodies r w e = case e of
+  FuncExpr a mname params body -> 
+    let newbody = descend (annotateStatement r w) body
+    in  FuncExpr a mname params newbody
+  _ -> e
+
+-- | 12.12 ECMA262: the production /Identifier/ : /Statement/ is
+-- evaluated by adding /Identifier/ to the label ser of /Statement/
+-- and then evluating /Statement/. If the /LabelledStatement/ itsef
+-- has a non-empty label set, these labels are also added to the label
+-- set of /Statement/ before evaluating it. ... Prior to evaluation of
+-- a /LabelledStatement/, the contained /Statement/ is regarded as
+-- possessing an empty label set, unless it is an /IterationStatement/
+-- or a /SwitchStatement/, in which case it is regarded as possessing
+-- a label set consisting of the single element, @empty@.
+annotateStatement :: Data a => 
+                     (a -> Set Label)
+                  -> (Set Label -> a -> a)
+                  -> Statement a   
+                  -> Statement a
+annotateStatement r w s = case s of
+  LabelledStmt ann lab stmt -> 
+    let labelset = Set.insert (id2Label lab) (r ann) 
+        newstmt  = annotateStatement r w $ w labelset <$> stmt
+    in  LabelledStmt ann lab newstmt
+  SwitchStmt {} -> 
+    let labelset = Set.insert EmptyLabel (r $ getAnnotation s)
+    in  descend (annotateStatement r w) (w labelset <$> s)
+  _ | isIterationStmt s ->
+    let labelset = Set.insert EmptyLabel (r $ getAnnotation s)
+    in  descend (annotateStatement r w) (w labelset <$> s)
+  _                     -> descend (annotateStatement r w) s
+
+id2Label :: Id a -> Label
+id2Label = Label . unId
+                                
diff --git a/src/Language/ECMAScript3/Lexer.hs b/src/Language/ECMAScript3/Lexer.hs
new file mode 100644
index 0000000..2348994
--- /dev/null
+++ b/src/Language/ECMAScript3/Lexer.hs
@@ -0,0 +1,65 @@
+-- | 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 Language.ECMAScript3.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,
+                        identifierStart) where
+
+import Prelude hiding (lex)
+import Text.Parsec
+import qualified Text.Parsec.Token as T
+
+identifierStart = letter <|> oneOf "$_"
+
+javascriptDef =
+  T.LanguageDef "/*"
+                "*/"
+                "//"
+                False -- no nested comments
+                identifierStart
+                (alphaNum <|> oneOf "$_") -- identifier rest
+                (oneOf "{}<>()~.,?:|&^=!+-*/%!") -- operator start
+                (oneOf "=<>|&+") -- operator rest
+                ["break", "case", "catch", "const", "continue", "debugger", 
+                 "default", "delete", "do", "else", "enum", "false", "finally",
+                 "for", "function", "if", "instanceof", "in", "let", "new", 
+                 "null", "return", "switch", "this", "throw", "true", "try", 
+                 "typeof", "var", "void", "while", "with"]
+                ["|=", "^=", "&=", "<<=", ">>=", ">>>=", "+=", "-=", "*=", "/=", 
+                 "%=", "=", ";", ",", "?", ":", "||", "&&", "|", "^", "&", 
+                 "===", "==", "=", "!==", "!=", "<<", "<=", "<", ">>>", ">>", 
+                 ">=", ">", "++", "--", "+", "-", "*", "/", "%", "!", "~", ".", 
+                 "[", "]", "{", "}", "(", ")","</","instanceof"]
+                 True -- case-sensitive
+            
+lex :: T.TokenParser st
+lex = T.makeTokenParser javascriptDef
+
+-- everything but commaSep and semiSep
+identifier = T.identifier	 lex
+reserved = T.reserved	 lex
+operator = T.operator	 lex
+reservedOp = T.reservedOp lex	
+charLiteral = T.charLiteral lex	
+stringLiteral = T.stringLiteral lex	
+natural = T.natural lex	
+integer = T.integer lex	
+float = T.float lex	
+naturalOrFloat = T.naturalOrFloat lex	
+decimal = T.decimal lex	
+hexadecimal = T.hexadecimal lex	
+octal = T.octal lex	
+symbol = T.symbol lex	
+whiteSpace = T.whiteSpace lex	
+parens = T.parens	 lex
+braces = T.braces	 lex
+squares = T.squares lex	
+semi = T.semi	 lex
+comma = T.comma	 lex
+colon = T.colon lex	
+dot = T.dot lex
+brackets = T.brackets lex
+lexeme = T.lexeme lex
diff --git a/src/Language/ECMAScript3/Parser.hs b/src/Language/ECMAScript3/Parser.hs
new file mode 100644
index 0000000..cebbf53
--- /dev/null
+++ b/src/Language/ECMAScript3/Parser.hs
@@ -0,0 +1,759 @@
+-- | Parser for ECMAScript 3.
+
+module Language.ECMAScript3.Parser
+  (parse
+  , parseScriptFromString
+  , parseJavaScriptFromFile
+  , parseScript
+  , parseExpression
+  , parseString
+  , ParsedStatement
+  , ParsedExpression
+  , parseSimpleExpr'
+  , parseBlockStmt
+  , parseStatement
+  , StatementParser
+  , ExpressionParser
+  , assignExpr
+  ) where
+
+import Language.ECMAScript3.Lexer hiding (identifier)
+import qualified Language.ECMAScript3.Lexer as Lexer
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.Syntax.Annotations
+import Data.Default
+import Text.Parsec hiding (parse)
+import Text.Parsec.Expr
+import Control.Monad(liftM,liftM2)
+import Control.Monad.Trans (MonadIO,liftIO)
+import Numeric(readDec,readOct,readHex)
+import Data.Char
+import Control.Monad.Identity
+import Data.Maybe (isJust, isNothing, fromMaybe)
+
+-- We parameterize the parse tree over source-locations.
+type ParsedStatement = Statement SourcePos
+type ParsedExpression = Expression SourcePos
+
+type CharParser a = ParsecT String ParserState Identity a
+
+-- These parsers can store some arbitrary state
+type StatementParser  = CharParser ParsedStatement
+type ExpressionParser = CharParser ParsedExpression
+-- the statement label stack
+type ParserState = [String]
+
+initialParserState :: ParserState
+initialParserState = []
+
+-- | checks if the label is not yet on the stack, if it is -- throws
+-- an error; otherwise it pushes it onto the stack
+pushLabel :: String -> CharParser ()
+pushLabel lab = do labs <- getState
+                   pos <- getPosition
+                   if lab `elem` labs 
+                     then fail $ "Duplicate label at " ++ show pos
+                     else putState (lab:labs)
+
+popLabel :: CharParser ()
+popLabel = modifyState safeTail
+  where safeTail [] = []
+        safeTail (_:xs) = xs
+
+clearLabels :: ParserState -> ParserState
+clearLabels _ = []
+
+withFreshLabelStack :: CharParser a -> CharParser a
+withFreshLabelStack p = do oldState <- getState
+                           putState $ clearLabels oldState
+                           a <- p
+                           putState oldState
+                           return a
+
+identifier :: CharParser (Id SourcePos)
+identifier =
+  liftM2 Id getPosition Lexer.identifier
+
+--{{{ Statements
+
+-- Keep in mind that Token.reserved parsers (exported from the lexer) do not
+-- consume any input on failure.  Note that all statements (expect for labelled
+-- and expression statements) begin with a reserved-word.  If we fail to parse
+-- this reserved-word, no input is consumed.  Hence, we can have the massive or
+-- block that is parseExpression.  Note that if the reserved-word is parsed, it 
+-- must be whatever statement the reserved-word indicates.  If we fail after the
+-- reserved-word, we truly have a syntax error.  Since input has been consumed,
+-- <|> will not try its alternate in parseExpression, and we will fail.
+
+parseIfStmt:: StatementParser  
+parseIfStmt = do
+  pos <- getPosition
+  reserved "if"
+  test <- parseParenExpr <?> "parenthesized test-expression in if statement"
+  consequent <- parseStatement <?> "true-branch of if statement"
+  optional semi -- TODO: in spec?
+  ((do reserved "else"
+       alternate <- parseStatement
+       return $ IfStmt pos test consequent alternate)
+   <|> return (IfSingleStmt pos test consequent))
+
+parseSwitchStmt:: StatementParser
+parseSwitchStmt =
+  let parseDefault = do
+        pos <- getPosition
+        reserved "default"
+        colon
+        statements <- many parseStatement
+        return (CaseDefault pos statements)
+      parseCase = do
+         pos <- getPosition
+         reserved "case"
+         condition <- parseListExpr
+         colon
+         actions <- many parseStatement
+         return (CaseClause pos condition actions)
+      isCaseDefault (CaseDefault _ _) = True   
+      isCaseDefault _                 = False
+      checkClauses cs = case filter isCaseDefault cs of
+        (_:c:_) -> fail $ "duplicate default clause in switch statement at " ++
+                          show (getAnnotation c)
+        _ -> return ()                  
+    in do pos <- getPosition
+          reserved "switch"
+          test <- parseParenExpr
+          clauses <- braces $ many $ parseDefault <|> parseCase
+          checkClauses clauses
+          return (SwitchStmt pos test clauses)
+
+parseWhileStmt:: StatementParser
+parseWhileStmt = do
+  pos <- getPosition
+  reserved "while"
+  test <- parseParenExpr <?> "parenthesized test-expression in while loop"
+  body <- parseStatement
+  return (WhileStmt pos test body)
+
+parseDoWhileStmt:: StatementParser
+parseDoWhileStmt = do
+  pos <- getPosition
+  reserved "do"
+  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)
+
+parseContinueStmt:: StatementParser
+parseContinueStmt = do
+  pos <- getPosition
+  reserved "continue"
+  pos' <- getPosition
+  -- Ensure that the identifier is on the same line as 'continue.'
+  id <- if sourceLine pos == sourceLine pos'
+        then liftM Just identifier <|> return Nothing
+        else return Nothing
+  optional semi
+  return $ ContinueStmt pos id
+
+parseBreakStmt:: StatementParser
+parseBreakStmt = do
+  pos <- getPosition
+  reserved "break"
+  pos' <- getPosition
+  -- Ensure that the identifier is on the same line as 'break.'
+  id <- if sourceLine pos == sourceLine pos'
+        then liftM Just identifier <|> return Nothing
+        else return Nothing
+  optional semi           
+  return $ BreakStmt pos id
+
+parseBlockStmt:: StatementParser
+parseBlockStmt = do
+  pos <- getPosition
+  statements <- braces (many parseStatement)
+  return (BlockStmt pos statements)
+
+parseEmptyStmt:: StatementParser 
+parseEmptyStmt = do
+  pos <- getPosition
+  semi
+  return (EmptyStmt pos)
+
+parseLabelledStmt:: StatementParser
+parseLabelledStmt = do
+  pos <- getPosition
+  -- Lookahead for the colon.  If we don't see it, we are parsing an identifier
+  -- for an expression statement.
+  label <- try (do label <- identifier
+                   colon
+                   return label)
+  pushLabel $ unId label
+  statement <- parseStatement
+  popLabel
+  return (LabelledStmt pos label statement)
+
+parseExpressionStmt:: StatementParser
+parseExpressionStmt = do
+  pos <- getPosition
+  expr <- parseListExpr -- TODO: spec 12.4?
+  optional semi
+  return $ ExprStmt pos expr
+
+
+parseForInStmt:: StatementParser
+parseForInStmt =
+  let parseInit = (reserved "var" >> liftM ForInVar identifier)
+               <|> liftM ForInLVal lvalue
+  in do pos <- getPosition
+        -- Lookahead, so that we don't clash with parseForStmt
+        (init,expr) <- try $ do reserved "for"
+                                parens $ do init <- parseInit
+                                            reserved "in"
+                                            expr <- parseExpression
+                                            return (init,expr)
+        body <- parseStatement
+        return $ ForInStmt pos init expr body
+
+parseForStmt:: StatementParser
+parseForStmt =
+  let parseInit = (reserved "var" >> liftM VarInit (parseVarDecl `sepBy` comma))
+               <|> liftM ExprInit parseListExpr
+               <|> return NoInit
+    in do pos <- getPosition
+          reserved "for"
+          reservedOp "("
+          init <- parseInit
+          semi
+          test <- optionMaybe parseExpression
+          semi
+          iter <- optionMaybe parseListExpr
+          reservedOp ")" <?> "closing paren"
+          stmt <- parseStatement
+          return $ ForStmt pos init test iter stmt
+
+parseTryStmt:: StatementParser
+parseTryStmt =
+  let parseCatchClause = do pos <- getPosition
+                            reserved "catch"
+                            id <- parens identifier
+                            stmt <- parseStatement
+                            return $ CatchClause pos id stmt
+  in do reserved "try"
+        pos <- getPosition
+        guarded <- parseStatement
+        mCatch <- optionMaybe parseCatchClause
+        mFinally <- optionMaybe $ reserved "finally" >> parseStatement
+        -- the spec requires at least a catch or a finally block to
+        -- be present
+        if isJust mCatch || isJust mFinally 
+          then return $ TryStmt pos guarded mCatch mFinally
+          else fail $ "A try statement should have at least a catch\ 
+                      \ or a finally block, at " ++ show pos
+
+parseThrowStmt:: StatementParser
+parseThrowStmt = do
+  pos <- getPosition
+  reserved "throw"
+  expr <- parseExpression
+  optional semi
+  return (ThrowStmt pos expr)
+
+parseReturnStmt:: StatementParser
+parseReturnStmt = do
+  pos <- getPosition
+  reserved "return"
+  expr <- optionMaybe parseListExpr
+  optional semi
+  return (ReturnStmt pos expr)
+
+parseWithStmt:: StatementParser
+parseWithStmt = do
+  pos <- getPosition
+  reserved "with"
+  context <- parseParenExpr
+  stmt <- parseStatement
+  return (WithStmt pos context stmt)
+
+parseVarDecl = do
+  pos <- getPosition
+  id <- identifier
+  init <- (reservedOp "=" >> liftM Just parseExpression) <|> return Nothing
+  return (VarDecl pos id init)
+
+parseVarDeclStmt:: StatementParser
+parseVarDeclStmt = do 
+  pos <- getPosition
+  reserved "var"
+  decls <- parseVarDecl `sepBy` comma
+  optional semi
+  return (VarDeclStmt pos decls)
+
+parseFunctionStmt:: StatementParser
+parseFunctionStmt = do
+  pos <- getPosition
+  name <- try (reserved "function" >> identifier) -- ambiguity with FuncExpr
+  args <- parens (identifier `sepBy` comma)
+  -- label sets don't cross function boundaries
+  body <- withFreshLabelStack parseBlockStmt <?> "function body in { ... }"
+  return (FunctionStmt pos name args body)
+
+parseStatement:: StatementParser
+parseStatement = parseIfStmt <|> parseSwitchStmt <|> parseWhileStmt 
+  <|> parseDoWhileStmt <|> parseContinueStmt <|> parseBreakStmt 
+  <|> parseBlockStmt <|> parseEmptyStmt <|> parseForInStmt <|> parseForStmt
+  <|> parseTryStmt <|> parseThrowStmt <|> parseReturnStmt <|> parseWithStmt 
+  <|> parseVarDeclStmt  <|> parseFunctionStmt
+  -- labelled, expression and the error message always go last, in this order
+  <|> parseLabelledStmt <|> parseExpressionStmt <?> "statement"
+
+--}}}
+
+--{{{ Expressions
+
+-- References used to construct this stuff:
+-- + http://developer.mozilla.org/en/docs/
+--     Core_JavaScript_1.5_Reference:Operators:Operator_Precedence
+-- + http://www.mozilla.org/js/language/grammar14.html
+--
+-- Aren't expression tables nice?  Well, we can't quite use them, because of 
+-- JavaScript's ternary (?:) operator.  We have to use two expression tables.
+-- We use one expression table for the assignment operators that bind looser 
+-- than ?: (assignTable).  The terms of assignTable are ternary expressions 
+-- (parseTernaryExpr).  parseTernaryExpr left-factors the left-recursive
+-- production for ?:, and is defined over the second expression table, 
+-- exprTable, which consists of operators that bind tighter than ?:.  The terms
+-- of exprTable are atomic expressions, parenthesized expressions, functions and
+-- array references.
+
+--{{{ Primary expressions
+
+parseThisRef:: ExpressionParser
+parseThisRef = do
+  pos <- getPosition
+  reserved "this"
+  return (ThisRef pos)
+
+parseNullLit:: ExpressionParser
+parseNullLit = do
+  pos <- getPosition
+  reserved "null"
+  return (NullLit pos)
+
+
+parseBoolLit:: ExpressionParser
+parseBoolLit = do
+    pos <- getPosition
+    let parseTrueLit  = reserved "true"  >> return (BoolLit pos True)
+        parseFalseLit = reserved "false" >> return (BoolLit pos False)
+    parseTrueLit <|> parseFalseLit
+
+parseVarRef:: ExpressionParser
+parseVarRef = liftM2 VarRef getPosition identifier
+
+parseArrayLit:: ExpressionParser
+parseArrayLit = liftM2 ArrayLit getPosition (squares (parseExpression `sepEndBy` comma))
+  
+parseFuncExpr = do
+  pos <- getPosition
+  reserved "function"
+  name <- optionMaybe identifier
+  args <- parens (identifier `sepBy` comma)
+  -- labels don't cross function boundaries
+  body <- withFreshLabelStack parseBlockStmt
+  return $ FuncExpr pos name args body
+
+--{{{ parsing strings
+
+escapeChars =
+ [('\'','\''),('\"','\"'),('\\','\\'),('b','\b'),('f','\f'),('n','\n'),
+  ('r','\r'),('t','\t'),('v','\v'),('/','/'),(' ',' '),('0','\0')]
+
+allEscapes:: String
+allEscapes = map fst escapeChars
+
+parseEscapeChar = do
+  c <- oneOf allEscapes
+  let (Just c') = lookup c escapeChars -- will succeed due to line above
+  return c' 
+
+parseAsciiHexChar = do
+  char 'x'
+  d1 <- hexDigit
+  d2 <- hexDigit
+  return ((chr.fst.head.readHex) (d1:d2:""))
+
+parseUnicodeHexChar = do
+  char 'u'
+  liftM (chr.fst.head.readHex) 
+        (sequence [hexDigit,hexDigit,hexDigit,hexDigit])
+        
+isWhitespace ch = ch `elem` " \t"
+
+
+-- The endWith argument is either single-quote or double-quote, depending on how
+-- we opened the string.
+parseStringLit' endWith =
+  (char endWith >> return "") <|>
+  (do try (string "\\'")
+      cs <- parseStringLit' endWith
+      return $ "'" ++ cs) <|>
+  (do char '\\'
+      c <- parseEscapeChar <|> parseAsciiHexChar <|> parseUnicodeHexChar <|> 
+           char '\r' <|> char '\n'
+      cs <- parseStringLit' endWith
+      if c == '\r' || c == '\n' 
+        then return (c:dropWhile isWhitespace cs) 
+        else return (c:cs)) <|>
+   liftM2 (:) anyChar (parseStringLit' endWith)
+
+parseStringLit:: ExpressionParser
+parseStringLit = do
+  pos <- getPosition
+  -- parseStringLit' takes as an argument the quote-character that opened the
+  -- string.
+  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 'lexeme'
+  -- above, expressions like:
+  --   var s = "string"   ;
+  -- do not parse.
+  return $ StringLit pos str
+
+--}}}
+
+parseRegexpLit:: ExpressionParser
+parseRegexpLit = do
+  let parseFlags = do
+        flags <- many (oneOf "mgi")
+        return $ \f -> f ('g' `elem` flags) ('i' `elem` flags) 
+  let parseEscape :: CharParser Char
+      parseEscape = char '\\' >> anyChar
+  let parseChar :: CharParser Char
+      parseChar = noneOf "/"
+  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
+  flags <- parseFlags
+  spaces -- crucial for Parsec.Token parsers
+  return $ flags (RegexpLit pos pat)
+          
+parseObjectLit:: ExpressionParser
+parseObjectLit =
+  let parseProp = do
+        -- Parses a string, identifier or integer as the property name.  I
+        -- apologize for the abstruse style, but it really does make the code
+        -- much shorter.
+        name <- liftM (\(StringLit p s) -> PropString p s) parseStringLit
+            <|> liftM2 PropId getPosition identifier
+            <|> liftM2 PropNum getPosition decimal
+        colon
+        val <- assignExpr
+        return (name,val)
+    in do pos <- getPosition
+          props <- braces (parseProp `sepEndBy` comma) <?> "object literal"
+          return $ ObjectLit pos props
+
+--{{{ Parsing numbers.  From pg. 17-18 of ECMA-262.
+
+hexLit = do
+  try (string "0x")
+  digits <- many1 (oneOf "0123456789abcdefABCDEF")
+  [(hex,"")] <- return $ Numeric.readHex digits
+  return (True, hex)
+
+-- 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)
+
+exponentPart = do
+  oneOf "eE"
+  (char '+' >> decimal) <|> (char '-' >> negate `fmap` decimal) <|> decimal
+
+--wrap a parser's result in a Just:
+jparser = liftM Just
+
+decLit = 
+  (do whole <- decimal
+      mfrac <- option Nothing (jparser (char '.' >> decimal))
+      mexp <-  option Nothing (jparser exponentPart)
+      if isNothing mfrac && isNothing mexp
+        then return (True, fromIntegral whole)
+        else return (False, mkDecimal (fromIntegral whole) 
+                                      (fromIntegral (fromMaybe 0 mfrac))
+                                      (fromIntegral (fromMaybe 0 mexp)))) <|>
+  (do frac <- char '.' >> decimal
+      exp <- option 0 exponentPart
+      return (False, mkDecimal 0.0 (fromIntegral frac) (fromIntegral exp)))
+
+parseNumLit:: ExpressionParser
+parseNumLit = do
+    pos <- getPosition
+    (isint, num) <- lexeme $ hexLit <|> decLit
+    notFollowedBy identifierStart <?> "whitespace"
+    if isint
+      then return $ IntLit pos (round num) 
+      else 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 = DotRef pos e
+
+funcApp e = parens (withPos cstr (parseExpression `sepBy` comma)) 
+         <?>"(function application)"
+    where cstr pos = CallExpr pos e
+
+bracketRef e = brackets (withPos cstr parseExpression) <?> "[property-ref]"
+    where cstr pos = BracketRef pos e
+
+-------------------------------------------------------------------------------
+-- Expression Parsers
+-------------------------------------------------------------------------------
+
+parseParenExpr:: ExpressionParser
+parseParenExpr = withPos ParenExpr (parens parseListExpr)
+
+-- everything above expect functions
+parseExprForNew = parseThisRef <|> parseNullLit <|> parseBoolLit <|> parseStringLit 
+  <|> parseArrayLit <|> parseParenExpr <|> parseNewExpr <|> parseNumLit 
+  <|> parseRegexpLit <|> parseObjectLit <|> parseVarRef
+
+-- all the expression parsers defined above
+parseSimpleExpr' = parseThisRef <|> parseNullLit <|> parseBoolLit 
+  <|> parseStringLit <|> parseArrayLit <|> parseParenExpr
+  <|> parseFuncExpr <|> parseNumLit <|> parseRegexpLit <|> parseObjectLit
+  <|> parseVarRef
+
+parseNewExpr =
+  (do pos <- getPosition
+      reserved "new"
+      constructor <- parseSimpleExprForNew Nothing -- right-associativity
+      arguments <- try (parens (parseExpression `sepBy` comma)) <|> return []
+      return (NewExpr pos constructor arguments)) <|>
+  parseSimpleExpr'
+
+parseSimpleExpr (Just e) = ((dotRef e <|> funcApp e <|> bracketRef e) >>=
+                            parseSimpleExpr . Just)  
+                        <|> return e
+parseSimpleExpr Nothing = do
+  e <- parseNewExpr <?> "expression (3)"
+  parseSimpleExpr (Just e)
+
+parseSimpleExprForNew (Just e) = ((dotRef e <|> bracketRef e) >>=
+                                  parseSimpleExprForNew . Just)
+                              <|> return e
+parseSimpleExprForNew Nothing = do
+  e <- parseNewExpr <?> "expression (3)"
+  parseSimpleExprForNew (Just e)
+    
+--}}}
+
+makeInfixExpr str constr = Infix parser AssocLeft where
+  parser:: CharParser (Expression SourcePos -> Expression SourcePos -> Expression SourcePos)
+  parser = do
+    pos <- getPosition
+    reservedOp str
+    return (InfixExpr pos constr)  -- points-free, returns a function
+
+
+-- apparently, expression tables can't handle immediately-nested prefixes
+parsePrefixedExpr = do
+  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 -> unaryAssignExpr
+    Just op -> do
+      innerExpr <- parsePrefixedExpr
+      return (PrefixExpr pos op innerExpr)
+
+exprTable:: [[Operator String ParserState Identity ParsedExpression]]
+exprTable = 
+  [ [ makeInfixExpr "==" OpEq
+    , makeInfixExpr "!=" OpNEq
+    , makeInfixExpr "===" OpStrictEq
+    , makeInfixExpr "!==" OpStrictNEq
+    ]
+
+  , [ makeInfixExpr "||" OpLOr ]
+
+  , [ makeInfixExpr "&&" OpLAnd ]
+  
+  , [ makeInfixExpr "|" OpBOr ]
+
+  , [ makeInfixExpr "^" OpBXor ]
+
+  , [ makeInfixExpr "&" OpBAnd ]
+
+  , [ makeInfixExpr "<" OpLT
+    , makeInfixExpr "<=" OpLEq
+    , makeInfixExpr ">" OpGT
+    , makeInfixExpr ">=" OpGEq
+    , makeInfixExpr "instanceof" OpInstanceof
+    , makeInfixExpr "in" OpIn
+    ]
+
+  , [ makeInfixExpr "<<" OpLShift
+    , makeInfixExpr ">>" OpSpRShift
+    , makeInfixExpr ">>>" OpZfRShift
+    ]
+
+  , [ makeInfixExpr "+" OpAdd
+    , makeInfixExpr "-" OpSub
+    ]
+
+  , [ makeInfixExpr "*" OpMul
+    , makeInfixExpr "/" OpDiv
+    , makeInfixExpr "%" OpMod
+    ]
+  ]
+
+parseExpression' = 
+  buildExpressionParser exprTable parsePrefixedExpr <?> "simple expression"
+
+asLValue :: SourcePos
+         -> Expression SourcePos 
+         -> CharParser (LValue SourcePos)
+asLValue p' e = case e of
+  VarRef p (Id _ x) -> return (LVar p x)
+  DotRef p e (Id _ x) -> return (LDot p e x)
+  BracketRef p e1 e2 -> return (LBracket p e1 e2)
+  otherwise -> fail $ "expected a left-value at " ++ show p'
+
+lvalue :: CharParser (LValue SourcePos)
+lvalue = do
+  p <- getPosition
+  e <- parseSimpleExpr Nothing
+  asLValue p e
+
+
+unaryAssignExpr :: CharParser ParsedExpression
+unaryAssignExpr = do
+  p <- getPosition
+  let prefixInc = do
+        reservedOp "++"
+        liftM (UnaryAssignExpr p PrefixInc) lvalue
+  let prefixDec = do
+        reservedOp "--"
+        liftM (UnaryAssignExpr p PrefixDec) lvalue
+  let postfixInc e = do
+        reservedOp "++"
+        liftM (UnaryAssignExpr p PostfixInc) (asLValue p e)
+  let postfixDec e = do
+        reservedOp "--"
+        liftM (UnaryAssignExpr p PostfixDec) (asLValue p e)
+  let other = do
+        e <- parseSimpleExpr Nothing
+        postfixInc e <|> postfixDec e <|> return e
+  prefixInc <|> prefixDec <|> other
+
+
+parseTernaryExpr':: CharParser (ParsedExpression,ParsedExpression)
+parseTernaryExpr' = do
+    reservedOp "?"
+    l <- assignExpr
+    colon
+    r <- assignExpr
+    return (l,r)
+
+parseTernaryExpr:: ExpressionParser
+parseTernaryExpr = do
+  e <- parseExpression'
+  e' <- optionMaybe parseTernaryExpr'
+  case e' of
+    Nothing -> return e
+    Just (l,r) -> do p <- getPosition
+                     return $ CondExpr p e l r
+
+
+assignOp :: CharParser AssignOp
+assignOp = 
+  (reservedOp "=" >> return OpAssign) <|>
+  (reservedOp "+=" >> return OpAssignAdd) <|>
+  (reservedOp "-=" >> return OpAssignSub) <|>
+  (reservedOp "*=" >> return OpAssignMul) <|>
+  (reservedOp "/=" >> return OpAssignDiv) <|>
+  (reservedOp "%=" >> return OpAssignMod) <|>
+  (reservedOp "<<=" >> return OpAssignLShift) <|>
+  (reservedOp ">>=" >> return OpAssignSpRShift) <|>
+  (reservedOp ">>>=" >> return OpAssignZfRShift) <|>
+  (reservedOp "&=" >> return OpAssignBAnd) <|>
+  (reservedOp "^=" >> return OpAssignBXor) <|>
+  (reservedOp "|=" >> return OpAssignBOr)
+
+
+assignExpr :: ExpressionParser
+assignExpr = do
+  p <- getPosition
+  lhs <- parseTernaryExpr
+  let assign = do
+        op <- assignOp
+        lhs <- asLValue p lhs
+        rhs <- assignExpr
+        return (AssignExpr p op lhs rhs)
+  assign <|> return lhs
+
+parseExpression:: ExpressionParser
+parseExpression = assignExpr
+
+parseListExpr = liftM2 ListExpr getPosition (assignExpr `sepBy1` comma)
+
+parseScript:: CharParser (JavaScript SourcePos)
+parseScript = do
+  whiteSpace
+  liftM2 Script getPosition (parseStatement `sepBy` whiteSpace)
+  
+-- | Parse from a stream; same as 'Text.Parsec.parse'
+parse :: Stream s Identity t =>
+         Parsec s [String] a -- ^ The parser to use
+      -> SourceName -- ^ Name of the source file
+      -> s -- ^ the stream to parse, usually a 'String'
+      -> Either ParseError a
+parse p = runParser p initialParserState
+
+-- | Read a JavaScript program from file an parse it into a list of
+-- statements
+parseJavaScriptFromFile :: MonadIO m => String -- ^ file name
+                        -> m [Statement SourcePos]
+parseJavaScriptFromFile filename = do
+  chars <- liftIO $ readFile filename
+  case parse parseScript filename chars of
+    Left err               -> fail (show err)
+    Right (Script _ stmts) -> return stmts
+
+-- | Parse a JavaScript program from a string
+parseScriptFromString :: String -- ^ source file name
+                      -> String -- ^ JavaScript source to parse
+                      -> Either ParseError (JavaScript SourcePos)
+parseScriptFromString = parse parseScript
+
+-- | Parse a JavaScript source string into a list of statements
+parseString :: String -- ^ JavaScript source
+            -> [Statement SourcePos]
+parseString str = case parse parseScript "" str of
+  Left err -> error (show err)
+  Right (Script _ stmts) -> stmts
diff --git a/src/Language/ECMAScript3/PrettyPrint.hs b/src/Language/ECMAScript3/PrettyPrint.hs
new file mode 100644
index 0000000..b67b638
--- /dev/null
+++ b/src/Language/ECMAScript3/PrettyPrint.hs
@@ -0,0 +1,231 @@
+-- |Pretty-printing JavaScript.
+module Language.ECMAScript3.PrettyPrint
+  ( 
+--    stmt
+--  , expr
+  javaScript
+  , renderStatements
+  , renderExpression
+  ) where
+
+import Text.PrettyPrint.HughesPJ
+import Language.ECMAScript3.Syntax
+
+-- | Renders a list of statements as a 'String'
+renderStatements :: [Statement a] -> String
+renderStatements = render . stmtList
+
+-- | Renders a list of statements as a 'String'
+renderExpression :: Expression a -> String
+renderExpression = render . expr
+
+-- Displays the statement in { ... }, unless it is a block itself.
+inBlock:: Statement a -> Doc
+inBlock s@(BlockStmt _ _) = stmt s
+inBlock s                 = lbrace $+$ nest 2 (stmt s) $+$ rbrace
+
+-- Displays the expression in ( ... ), unless it is a parenthesized expression
+inParens:: Expression a -> Doc
+inParens e@(ParenExpr _ _) = expr e
+inParens e                 = parens (expr e)
+
+pp (Id _ str) = text str
+
+forInit :: ForInit a -> Doc
+forInit t = case t of
+  NoInit     -> empty
+  VarInit vs -> text "var" <+> cat (punctuate comma $ map varDecl vs)
+  ExprInit e -> expr e
+
+forInInit :: ForInInit a -> Doc  
+forInInit t = case t of
+  ForInVar id   -> text "var" <+> pp id
+  ForInLVal lv -> lvalue lv
+
+caseClause :: CaseClause a -> Doc
+caseClause (CaseClause _ e ss) =
+  text "case" $+$ expr e <+> colon $$ nest 2 (stmtList ss)
+caseClause (CaseDefault _ ss) =
+  text "default:" $$ nest 2 (stmtList ss)
+
+varDecl :: VarDecl a -> Doc
+varDecl (VarDecl _ id Nothing) = pp id
+varDecl (VarDecl _ id (Just e)) = pp id <+> equals <+> expr e
+
+stmt :: Statement a -> Doc
+stmt s = case s of
+  BlockStmt _ ss -> lbrace $+$ nest 2 (stmtList ss) $$ rbrace
+  EmptyStmt _ -> semi
+  ExprStmt _ e -> expr e <> semi
+  IfSingleStmt _ test cons -> text "if" <+> inParens test $$ stmt cons
+  IfStmt _ test cons alt ->
+    text "if" <+> inParens test $$ stmt cons $$ text "else" <+> stmt alt
+  SwitchStmt _ e cases ->
+    text "switch" <+> inParens e $$ 
+    braces (nest 2 (vcat (map caseClause cases)))
+  WhileStmt _ test body -> text "while" <+> inParens test $$ stmt body
+  ReturnStmt _ Nothing -> text "return"
+  ReturnStmt _ (Just e) -> text "return" <+> expr e
+  DoWhileStmt _ s e -> 
+    text "do" $$ (stmt s <+> text "while" <+> inParens e <> semi)
+  BreakStmt _ Nothing ->  text "break" <> semi
+  BreakStmt _ (Just label) -> text "break" <+> pp label <> semi
+  ContinueStmt _ Nothing -> text "continue" <> semi
+  ContinueStmt _ (Just label) -> text"continue" <+> pp label <> semi
+  LabelledStmt _ label s -> pp label <> colon $$ stmt s
+  ForInStmt p init e body -> 
+    text "for" <+> 
+    parens (forInInit init <+> text "in" <+> expr e) $+$ stmt body
+  ForStmt _ init incr test body ->
+    text "for" <+> 
+    parens (forInit init <> semi <+> mexpr incr <> semi <+> mexpr test) $$ 
+    stmt body
+  TryStmt _ stmt mcatch mfinally ->
+    text "try" $$ inBlock stmt $$ ppCatch $$ ppFinally 
+    where ppFinally = case mfinally of
+            Nothing -> empty
+            Just stmt -> text "finally" <> inBlock stmt
+          ppCatch = case mcatch of
+            Nothing -> empty
+            Just (CatchClause _ id s) -> 
+              text "catch" <+> (parens.pp) id <+> inBlock s
+  ThrowStmt _ e -> text "throw" <+> expr e <> semi
+  WithStmt _ expr s ->  text "with" <+> inParens expr $$ stmt s
+  VarDeclStmt _ decls ->
+    text "var" <+> cat (punctuate comma (map varDecl decls)) <> semi
+  FunctionStmt _ name args s ->
+    text "function" <+> pp name <> 
+    parens (cat $ punctuate comma (map pp args)) $$ 
+    inBlock s
+
+stmtList :: [Statement a] -> Doc
+stmtList = vcat . map stmt
+
+prop :: Prop a -> Doc
+prop p = case p of
+  PropId _ id -> pp id
+  PropString _ str -> doubleQuotes (text (jsEscape str))
+  PropNum _ n -> text (show n)
+
+infixOp op = text $ case op of
+  OpMul -> "*"
+  OpDiv -> "/"
+  OpMod -> "%" 
+  OpAdd -> "+" 
+  OpSub -> "-"
+  OpLShift -> "<<"
+  OpSpRShift -> ">>"
+  OpZfRShift -> ">>>"
+  OpLT -> "<"
+  OpLEq -> "<="
+  OpGT -> ">"
+  OpGEq -> ">="
+  OpIn -> "in"
+  OpInstanceof -> "instanceof"
+  OpEq -> "=="
+  OpNEq -> "!="
+  OpStrictEq -> "==="
+  OpStrictNEq -> "!=="
+  OpBAnd -> "&"
+  OpBXor -> "^"
+  OpBOr -> "|"
+  OpLAnd -> "&&"
+  OpLOr -> "||"
+
+
+prefixOp op = text $ case op of
+  PrefixLNot -> "!"
+  PrefixBNot -> "~"
+  PrefixPlus -> "+"
+  PrefixMinus -> "-"
+  PrefixTypeof -> "typeof"
+  PrefixVoid -> "void"
+  PrefixDelete -> "delete"
+
+
+assignOp op = text $ case op of
+  OpAssign -> "="
+  OpAssignAdd -> "+="
+  OpAssignSub -> "-="
+  OpAssignMul -> "*="
+  OpAssignDiv -> "/="
+  OpAssignMod -> "%="
+  OpAssignLShift -> "<<="
+  OpAssignSpRShift -> ">>="
+  OpAssignZfRShift -> ">>>="
+  OpAssignBAnd -> "&="
+  OpAssignBXor -> "^="
+  OpAssignBOr -> "|="
+
+-- Based on:
+--   http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Guide:Literals
+jsEscape:: String -> String
+jsEscape "" = ""
+jsEscape (ch:chs) = sel ch ++ jsEscape chs where
+    sel '\b' = "\\b"
+    sel '\f' = "\\f"
+    sel '\n' = "\\n"
+    sel '\r' = "\\r"
+    sel '\t' = "\\t"
+    sel '\v' = "\\v"
+    sel '\'' = "\\'"
+    sel '\"' = "\\\""
+    sel '\\' = "\\\\"
+    sel x    = [x]
+    -- We don't have to do anything about \X, \x and \u escape sequences.
+
+lvalue :: LValue a -> Doc
+lvalue (LVar _ x) = text x
+lvalue (LDot _ e x) = expr e <> text "." <> text x
+lvalue (LBracket _ e1 e2) = expr e1 <> brackets (expr e2)
+ 
+expr :: Expression a -> Doc
+expr e = case e of 
+  StringLit _ str ->  doubleQuotes (text (jsEscape str))
+  RegexpLit _ re global ci -> 
+    text "/" <> text re <> text "/" <> g <> i where
+      g = if global then text "g" else empty
+      i = if ci then text "i" else empty
+  NumLit _ n ->  text (show n)
+  IntLit _ n ->  text (show n)
+  BoolLit _ True ->  text "true"
+  BoolLit _ False ->  text "false"
+  NullLit _ ->  text "null"
+  ArrayLit _ es ->  brackets $ cat $ punctuate comma (map expr es)
+  ObjectLit _ xs ->  
+    braces (hsep (punctuate comma (map pp' xs))) where
+      pp' (n,v) =  prop n <> colon <+> expr v
+  ThisRef _ ->  text "this"
+  VarRef _ id ->  pp id
+  DotRef _ e' id -> expr e' <> text "." <> pp id
+  BracketRef _ container key -> expr container <> brackets (expr key)
+  NewExpr _ constr args -> 
+    text "new" <+> expr constr <> 
+    parens (cat $ punctuate comma (map expr args))
+  PrefixExpr _ op e' -> prefixOp op <+> expr e'
+  InfixExpr _ op left right -> expr left <+> infixOp op <+> expr right
+  CondExpr _ test cons alt -> 
+    expr test <+> text "?" <+> expr cons <+> colon <+> expr alt
+  AssignExpr _ op l r ->  lvalue l <+> assignOp op <+> expr r
+  UnaryAssignExpr _ op e' -> case op of
+    PrefixInc -> text "++" <> lvalue e'
+    PrefixDec -> text "--" <> lvalue e'
+    PostfixInc -> lvalue e' <> text "++"
+    PostfixDec -> lvalue e' <> text "--"
+  ParenExpr _ e' ->  parens (expr e')
+  ListExpr _ es ->  cat $ punctuate comma (map expr es)
+  CallExpr _ f args -> 
+    expr f <> parens (cat $ punctuate comma (map expr args))
+  FuncExpr _ name args body -> 
+    text "function" <+> text (maybe "" unId name) <+>
+    parens (cat $ punctuate comma (map pp args)) $$ 
+    inBlock body
+
+mexpr :: Maybe (Expression a) -> Doc
+mexpr Nothing = empty
+mexpr (Just e) = expr e
+
+-- | Renders a JavaScript program as a document, the show instance of
+-- 'Doc' will pretty-print it automatically
+javaScript :: JavaScript a -> Doc
+javaScript (Script _ ss) = stmtList ss
diff --git a/src/Language/ECMAScript3/Syntax.hs b/src/Language/ECMAScript3/Syntax.hs
new file mode 100644
index 0000000..f43a33a
--- /dev/null
+++ b/src/Language/ECMAScript3/Syntax.hs
@@ -0,0 +1,236 @@
+-- |ECMAScript 3 syntax. /Spec/ refers to the ECMA-262 specification, 3rd edition.
+module Language.ECMAScript3.Syntax (JavaScript(..)
+                                   ,unJavaScript
+                                   ,Statement(..)
+                                   ,isIterationStmt
+                                   ,CaseClause(..)
+                                   ,CatchClause(..)
+                                   ,ForInit(..)
+                                   ,ForInInit(..)
+                                   ,VarDecl(..)
+                                   ,Expression(..)
+                                   ,InfixOp(..)
+                                   ,AssignOp(..)
+                                   ,Id(..)
+                                   ,unId
+                                   ,PrefixOp(..)
+                                   ,Prop(..)
+                                   ,UnaryAssignOp(..)
+                                   ,LValue (..)
+                                   ,SourcePos
+                                   ) where
+
+import Text.Parsec.Pos(initialPos,SourcePos) -- used by data JavaScript
+import Data.Generics(Data,Typeable)
+import Data.Foldable (Foldable)
+import Data.Traversable (Traversable)
+import Data.Default
+
+data JavaScript a
+  -- |A script in \<script\> ... \</script\> tags.
+  = Script a [Statement a] 
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+
+instance Default a => Default (JavaScript a) where
+  def = Script def []
+
+-- | extracts statements from a JavaScript type
+unJavaScript :: JavaScript a -> [Statement a]
+unJavaScript (Script _ stmts) = stmts
+
+instance Default SourcePos where
+  def = initialPos ""
+
+data Id a = Id a String 
+          deriving (Show,Eq,Ord,Data,Typeable,Functor,Foldable,Traversable)
+
+unId :: Id a -> String
+unId (Id _ s) = s
+
+-- | Infix operators: see spec 11.5-11.11
+data InfixOp = OpLT -- ^ @<@
+             | OpLEq -- ^ @<=@
+             | OpGT -- ^ @>@
+             | OpGEq -- ^ @>=@
+             | OpIn -- ^ @in@
+             | OpInstanceof -- ^ @instanceof@
+             | OpEq -- ^ @==@
+             | OpNEq -- ^ @!=@
+             | OpStrictEq -- ^ @===@
+             | OpStrictNEq -- ^ @!===@
+             | OpLAnd -- ^ @&&@
+             | OpLOr -- ^ @||@
+             | OpMul -- ^ @*@
+             | OpDiv -- ^ @/@
+             | OpMod -- ^ @%@
+             | OpSub -- ^ @-@
+             | OpLShift -- ^ @<<@
+             | OpSpRShift -- ^ @>>@
+             | OpZfRShift -- ^ @>>>@
+             | OpBAnd -- ^ @&@
+             | OpBXor -- ^ @^@
+             | OpBOr -- ^ @|@
+             | OpAdd -- ^ @+@
+    deriving (Show,Data,Typeable,Eq,Ord,Enum)
+
+-- | Assignment operators: see spec 11.13
+data AssignOp = OpAssign -- ^ simple assignment, @=@
+              | OpAssignAdd -- ^ @+=@
+              | OpAssignSub -- ^ @-=@
+              | OpAssignMul -- ^ @*=@
+              | OpAssignDiv -- ^ @/=@
+              | OpAssignMod -- ^ @%=@
+              | OpAssignLShift -- ^ @<<=@
+              | OpAssignSpRShift -- ^ @>>=@
+              | OpAssignZfRShift -- ^ @>>>=@
+              | OpAssignBAnd -- ^ @&=@
+              | OpAssignBXor -- ^ @^=@
+              | OpAssignBOr -- ^ @|=@
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+-- | Unary assignment operators: see spec 11.3, 11.4.4, 11.4.5
+data UnaryAssignOp = PrefixInc -- ^ @++x@
+                   | PrefixDec -- ^ @--x@
+                   | PostfixInc -- ^ @x++@
+                   | PostfixDec -- ^ @x--@
+  deriving (Show, Data, Typeable, Eq, Ord)
+
+-- | Prefix operators: see spec 11.4 (excluding 11.4.4, 11.4.5)
+data PrefixOp = PrefixLNot -- ^ @!@
+              | PrefixBNot -- ^ @~@
+              | PrefixPlus -- ^ @+@
+              | PrefixMinus -- ^ @-@
+              | PrefixTypeof -- ^ @typeof@
+              | PrefixVoid -- ^ @void@
+              | PrefixDelete -- ^ @delete@
+  deriving (Show,Data,Typeable,Eq,Ord)
+
+-- | Property names in an object initializer: see spec 11.1.5
+data Prop a = PropId a (Id a) -- ^ property name is an identifier, @foo@
+            | PropString a String -- ^ property name is a string, @\"foo\"@
+            | PropNum a Integer -- ^ property name is an integer, @42@
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+ 
+-- | Left-hand side expressions: see spec 11.2
+data LValue a
+  = LVar a String -- ^ variable reference, @foo@
+  | LDot a (Expression a) String -- ^ @foo.bar@
+  | LBracket a (Expression a) (Expression a) -- ^ @foo[bar]@
+  deriving (Show, Eq, Ord, Data, Typeable, Functor,Foldable,Traversable) 
+
+-- | Expressions, see spec 11
+data Expression a
+  = StringLit a String -- ^ @\"foo\"@, spec 11.1.3, 7.8
+  | RegexpLit a String Bool Bool 
+    -- ^ @RegexpLit a regexp global?  case_insensitive?@ -- regular
+    -- expression, see spec 11.1.3, 7.8
+  | NumLit a Double -- ^ @41.99999@, spec 11.1.3, 7.8
+  | IntLit a Int -- ^ @42@, spec 11.1.3, 7.8
+  | BoolLit a Bool -- ^ @true@, spec 11.1.3, 7.8
+  | NullLit a -- ^ @null@, spec 11.1.3, 7.8
+  | ArrayLit a [Expression a] -- ^ @[1,2,3]@, spec 11.1.4
+  | ObjectLit a [(Prop a, Expression a)] -- ^ @{foo:\"bar\", baz: 42}@, spec 11.1.5
+  | ThisRef a -- ^ @this@, spec 11.1.1
+  | VarRef a (Id a) -- ^ @foo@, spec 11.1.2
+  | DotRef a (Expression a) (Id a) -- ^ @foo.bar@, spec 11.2.1
+  | BracketRef a (Expression a) {- container -} (Expression a) {- key -} 
+    -- ^ @foo[bar@, spec 11.2.1
+  | NewExpr a (Expression a) {- constructor -} [Expression a] 
+    -- ^ @new foo(bar)@, spec 11.2.2
+  | PrefixExpr a PrefixOp (Expression a) 
+    -- ^ @\@e@, spec 11.4 (excluding 11.4.4, 111.4.5)
+  | UnaryAssignExpr a UnaryAssignOp (LValue a) 
+    -- ^ @++x@, @x--@ etc., spec 11.3, 11.4.4, 11.4.5
+  | InfixExpr a InfixOp (Expression a) (Expression a) 
+    -- ^ @e1\@e2@, spec 11.5, 11.6, 11.7, 11.8, 11.9, 11.10, 11.11
+  | CondExpr a (Expression a) (Expression a) (Expression a)
+    -- ^ @e1 ? e2 : e3@, spec 11.12
+  | AssignExpr a AssignOp (LValue a) (Expression a)
+    -- ^ @e1 \@=e2@, spec 11.13
+  | ParenExpr a (Expression a) -- ^ @(e)@, spec 11.1.6
+  | ListExpr a [Expression a] -- ^ @e1, e2@, spec 11.14
+  | CallExpr a (Expression a) [Expression a] -- ^ @f(x,y,z)@, spec 11.2.3
+  --funcexprs are optionally named
+  | FuncExpr a (Maybe (Id a)) [Id a] (Statement a) 
+    -- ^ @function f (x,y,z) {...}@, spec 11.2.5, 13
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+
+-- | Case clauses, spec 12.11
+data CaseClause a = CaseClause a (Expression a) [Statement a]
+                    -- ^ @case e: stmts;@
+                  | CaseDefault a [Statement a]
+                    -- ^ @default: stmts;@
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+
+-- | Catch clause, spec 12.14
+data CatchClause a = CatchClause a (Id a) (Statement a) 
+                     -- ^ @catch (x) {...}@
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+
+-- | A variable declaration, spec 12.2
+data VarDecl a = VarDecl a (Id a) (Maybe (Expression a)) 
+                 -- ^ @var x = e;@
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+  
+-- | for initializer, spec 12.6
+data ForInit a = NoInit -- ^ empty
+               | VarInit [VarDecl a] -- ^ @var x, y=42@
+               | ExprInit (Expression a) -- ^ @expr@
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+
+-- | for..in initializer, spec 12.6
+data ForInInit a = ForInVar (Id a) -- ^ @var x@
+                 | ForInLVal (LValue a) -- ^ @foo.baz@, @foo[bar]@, @z@
+ deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)
+  
+-- | Statements, spec 12.
+data Statement a 
+  = BlockStmt a [Statement a] -- ^ @{stmts}@, spec 12.1
+  | EmptyStmt a -- ^ @;@, spec 12.3
+  | ExprStmt a (Expression a) -- ^ @expr;@, spec 12.4
+  | IfStmt a (Expression a) (Statement a) (Statement a) 
+    -- ^ @if (e) stmt@, spec 12.5
+  | IfSingleStmt a (Expression a) (Statement a)
+    -- ^ @if (e) stmt1 else stmt2@, spec 12.5
+  | SwitchStmt a (Expression a) [CaseClause a]
+    -- ^ @switch (e) clauses@, spec 12.11
+  | WhileStmt a (Expression a) (Statement a)
+    -- ^ @while (e) do stmt@, spec 12.6
+  | DoWhileStmt a (Statement a) (Expression a)
+    -- ^ @do stmt while (e);@, spec 12.6
+  | BreakStmt a (Maybe (Id a)) -- ^ @break lab;@, spec 12.8
+  | ContinueStmt a (Maybe (Id a)) -- ^ @continue lab;@, spec 12.7
+  | LabelledStmt a (Id a) (Statement a) -- ^ @lab: stmt@, spec 12.12
+  | ForInStmt a (ForInInit a) (Expression a) (Statement a) 
+    -- ^ @for (x in o) stmt@, spec 12.6
+  | ForStmt a (ForInit a)        
+              (Maybe (Expression a)) -- test
+              (Maybe (Expression a)) -- increment
+              (Statement a)          -- body 
+    -- ^ @ForStmt a init test increment body@, @for (init; test,
+    -- increment) body@, spec 12.6
+  | TryStmt a (Statement a) {-body-} (Maybe (CatchClause a))
+      (Maybe (Statement a)) {-finally-}
+    -- ^ @try stmt catch(x) stmt finally stmt@, spec 12.14
+  | ThrowStmt a (Expression a)
+    -- ^ @throw expr;@, spec 12.13
+  | ReturnStmt a (Maybe (Expression a))
+    -- ^ @return expr;@, spec 12.9
+  | WithStmt a (Expression a) (Statement a)
+    -- ^ @with (o) stmt@, spec 12.10
+  | VarDeclStmt a [VarDecl a]
+    -- ^ @var x, y=42;@, spec 12.2
+  | FunctionStmt a (Id a) {-name-} [Id a] {-args-} (Statement a) {-body-}
+    -- ^ @function f(x, y, z) {...}@, spec 13
+  deriving (Show,Data,Typeable,Eq,Ord,Functor,Foldable,Traversable)  
+
+-- | Returns 'True' if the statement is an /IterationStatement/
+-- according to spec 12.6.
+isIterationStmt :: Statement a -> Bool
+isIterationStmt s = case s of
+  WhileStmt {}   -> True
+  DoWhileStmt {} -> True
+  ForStmt {} -> True
+  ForInStmt {} -> True
+  _                 -> False
+  
diff --git a/src/Language/ECMAScript3/Syntax/Annotations.hs b/src/Language/ECMAScript3/Syntax/Annotations.hs
new file mode 100644
index 0000000..a467319
--- /dev/null
+++ b/src/Language/ECMAScript3/Syntax/Annotations.hs
@@ -0,0 +1,115 @@
+-- | A few helpers to work with the AST annotations
+module Language.ECMAScript3.Syntax.Annotations where
+
+import Language.ECMAScript3.Syntax
+import Data.Traversable
+import Control.Applicative
+import Control.Arrow
+import Control.Monad.State hiding (mapM)
+import Prelude hiding (mapM)
+
+-- | Removes annotations from a tree
+removeAnnotations :: Traversable t => t a -> t ()
+removeAnnotations = reannotate (const ())
+
+-- | Changes all the labels in the tree to another one, given by a
+-- function.
+reannotate :: Traversable t => (a -> b) -> t a -> t b
+reannotate f tree = traverse (pure . f) tree ()
+
+-- | add an extra field to the AST labels (the label would look like @
+-- (a, b) @)
+addExtraAnnotationField :: Traversable t => b -> t a -> t (a, b)
+addExtraAnnotationField def t = traverse (\z -> pure (z, def)) t ()
+
+-- | remove an extra field
+removeExtraAnnotationField :: Traversable t => t (a, b) -> t a
+removeExtraAnnotationField t = traverse (pure . fst) t ()
+
+
+-- | Assigns unique numeric (Int) ids to each node in the AST. Returns
+-- a pair: the tree annotated with UID's and the last ID that was
+-- assigned.
+assignUniqueIds :: Traversable t => Int -- ^ starting id
+                                 -> t a -- ^ tree root
+                                 -> (t (a, Int), Int) 
+assignUniqueIds first tree =
+  (returnA *** \i -> i-1) $ runState (mapM f tree) first
+  where f :: a -> State Int (a, Int)
+        f a = do i <- get
+                 put (i+1)
+                 return (a, i)
+
+class HasAnnotation a where
+  -- | Returns the annotation of the root of the tree
+  getAnnotation :: a b -> b
+
+instance HasAnnotation Expression where
+  getAnnotation e = case e of
+   (StringLit a s)              -> a
+   (RegexpLit a s g ci)         -> a
+   (NumLit a d)                 -> a
+   (IntLit a i)                 -> a
+   (BoolLit a b)                -> a
+   (NullLit a)                  -> a
+   (ArrayLit a exps)            -> a
+   (ObjectLit a props)          -> a
+   (ThisRef a)                  -> a
+   (VarRef a id)                -> a
+   (DotRef a exp id)            -> a
+   (BracketRef a container key) -> a
+   (NewExpr a ctor params)      -> a
+   (PrefixExpr a op e)          -> a
+   (UnaryAssignExpr a op lv)    -> a
+   (InfixExpr a op e1 e2)       -> a
+   (CondExpr a g et ef)         -> a
+   (AssignExpr a op lv e)       -> a
+   (ParenExpr a e)              -> a
+   (ListExpr a es)              -> a
+   (CallExpr a fn params)       -> a
+   (FuncExpr a mid args s)      -> a
+
+instance HasAnnotation Statement where
+  getAnnotation s = case s of
+    BlockStmt a _        -> a
+    EmptyStmt a          -> a
+    ExprStmt a _         -> a
+    IfStmt a _ _ _       -> a
+    IfSingleStmt a _ _   -> a
+    SwitchStmt a _ _     -> a
+    WhileStmt a _ _      -> a
+    DoWhileStmt a _ _    -> a
+    BreakStmt a _        -> a
+    ContinueStmt a _     -> a
+    LabelledStmt a _ _   -> a
+    ForInStmt a _ _ _    -> a
+    ForStmt a _ _ _ _    -> a
+    TryStmt a _ _ _      -> a
+    ThrowStmt a _        -> a
+    ReturnStmt a _       -> a
+    WithStmt a _ _       -> a
+    VarDeclStmt a _      -> a
+    FunctionStmt a _ _ _ -> a
+    
+instance HasAnnotation LValue where
+  getAnnotation lv = case lv of
+    LVar a _ -> a
+    LDot a _ _ -> a
+    LBracket a _ _ -> a
+  
+instance HasAnnotation VarDecl where
+  getAnnotation (VarDecl a _ _) = a
+
+instance HasAnnotation Prop  where
+  getAnnotation p = case p of
+    PropId a _ -> a
+    PropString a _ -> a
+    PropNum a _ -> a
+  
+instance HasAnnotation CaseClause where
+  getAnnotation c = case c of
+    CaseClause a _ _ -> a
+    CaseDefault a _ -> a
+    
+instance HasAnnotation CatchClause where
+  getAnnotation (CatchClause a _ _) = a
diff --git a/src/UnitTest.hs b/src/UnitTest.hs
new file mode 100644
index 0000000..27c34c8
--- /dev/null
+++ b/src/UnitTest.hs
@@ -0,0 +1,31 @@
+module Main where
+
+import Test.HUnit
+import System.Exit
+import System.Directory
+import qualified System.FilePath as FilePath
+import Language.ECMAScript3.Parser
+import Language.ECMAScript3.PrettyPrint
+import Language.ECMAScript3.Syntax
+
+testDir = "tests/parse-pretty"
+
+parsePrettyTest filename = TestLabel filename $ TestCase $ do
+  js <- parseJavaScriptFromFile filename
+  let str = renderStatements js
+  case parseScriptFromString "" str of
+    Left err -> assertFailure (show err)
+    Right (Script _ js') -> do
+      let str' = renderStatements js'
+      assertBool "pretty-printed code should re-parse" (str == str')
+
+main = do
+  allFiles <- getDirectoryContents testDir
+  let files =  map (testDir `FilePath.combine`) $ 
+        filter (\x -> FilePath.takeExtension x == ".js") allFiles
+  let parsePretty = TestLabel "parser - printer composition" 
+        (TestList (map parsePrettyTest files))
+  results <- runTestTT parsePretty
+  if errors results > 0 || failures results > 0 
+    then exitFailure
+    else putStrLn "All tests passed."