language-java 0.2.0 → 0.2.1

raw patch · 3 files changed

+1649/−1656 lines, 3 filesdep +sybdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: syb

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Language/Java/Parser.hs +1163/−1163
• Language/Java/Syntax.hs +478/−484
• language-java.cabal +8/−9

@@ -1,1163 +1,1163 @@-module Language.Java.Parser (
-    parser, 
-    
-    compilationUnit, packageDecl, importDecl, typeDecl,
-    
-    classDecl, interfaceDecl,
-    
-    memberDecl, fieldDecl, methodDecl, constrDecl,
-    interfaceMemberDecl, absMethodDecl,
-    
-    formalParams, formalParam,
-    
-    modifier,
-    
-    varDecls, varDecl,
-    
-    block, blockStmt, stmt,
-    
-    stmtExp, exp, primary, literal,
-    
-    ttype, primType, refType, classType, resultType,
-    
-    typeParams, typeParam,
-    
-    name, ident,
-    
-    
-    empty, list, list1, seplist, seplist1, opt, bopt, lopt,
-    
-    comma, semiColon, period, colon
-    
-    ) where
-
-import Language.Java.Lexer ( L(..), Token(..), lexer)
-import Language.Java.Syntax
-import Language.Java.Pretty (pretty)
-
-import Text.Parsec hiding ( Empty )
-import Text.Parsec.Pos
-
-import Prelude hiding ( exp, catch, (>>), (>>=) )
-import qualified Prelude as P ( (>>), (>>=) ) 
-import Data.Maybe ( isJust, catMaybes )
-import Control.Monad ( ap )
-import Control.Applicative ( (<$>), (<$), (<*) )
-
-
-type P = Parsec [L Token] ()
-
--- A trick to allow >> and >>=, normally infixr 1, to be
--- used inside branches of <|>, which is declared as infixl 1.
--- There are no clashes with other operators of precedence 2.
-(>>) = (P.>>)
-(>>=) = (P.>>=)
-infixr 2 >>, >>=
--- Note also when reading that <$> is infixl 4 and thus has 
--- lower precedence than all the others (>>, >>=, and <|>).
-
--- Since I cba to find the instance Monad m => Applicative m declaration.
-(<*>) :: Monad m => m (a -> b) -> m a -> m b
-(<*>) = ap
-infixl 4 <*>
-
-----------------------------------------------------------------------------
--- Top-level parsing
-
-parseCompilationUnit :: String -> Either ParseError CompilationUnit
-parseCompilationUnit inp = 
-    runParser compilationUnit () "" (lexer inp)
-
-parser p = runParser p () "" . lexer
-
---class Parse a where
---  parse :: String -> a
-
-----------------------------------------------------------------------------
--- Packages and compilation units
-
-compilationUnit :: P CompilationUnit
-compilationUnit = do
-    mpd <- opt packageDecl
-    ids <- list importDecl
-    tds <- list typeDecl
-    return $ CompilationUnit mpd ids (catMaybes tds)
-
-packageDecl :: P PackageDecl
-packageDecl = do
-    tok KW_Package
-    n <- name
-    semiColon
-    return $ PackageDecl n
-    
-importDecl :: P ImportDecl
-importDecl = do
-    tok KW_Import
-    st <- bopt $ tok KW_Static
-    n  <- name
-    ds <- bopt $ period >> tok Op_Star
-    semiColon
-    return $ ImportDecl st n ds
-
-typeDecl :: P (Maybe TypeDecl)
-typeDecl = Just <$> classOrInterfaceDecl <|> 
-            const Nothing <$> semiColon
-
-----------------------------------------------------------------------------
--- Declarations
-
--- Class declarations
-
-classOrInterfaceDecl :: P TypeDecl
-classOrInterfaceDecl = do
-    ms <- list modifier
-    de <- (do cd <- classDecl
-              return $ \ms -> ClassTypeDecl (cd ms)) <|>
-          (do id <- interfaceDecl
-              return $ \ms -> InterfaceTypeDecl (id ms))
-    return $ de ms
-
-classDecl :: P (Mod ClassDecl)
-classDecl = normalClassDecl <|> enumClassDecl
-
-normalClassDecl :: P (Mod ClassDecl)
-normalClassDecl = do
-    tok KW_Class
-    i   <- ident
-    tps <- lopt typeParams
-    mex <- opt extends
-    imp <- lopt implements
-    bod <- classBody
-    return $ \ms -> ClassDecl ms i tps ((fmap head) mex) imp bod
-
-extends :: P [RefType]
-extends = tok KW_Extends >> refTypeList
-
-implements :: P [RefType]
-implements = tok KW_Implements >> refTypeList
-
-enumClassDecl :: P (Mod ClassDecl)
-enumClassDecl = do
-    tok KW_Enum
-    i   <- ident
-    imp <- lopt implements
-    bod <- enumBody
-    return $ \ms -> EnumDecl ms i imp bod
-
-classBody :: P ClassBody
-classBody = ClassBody <$> braces classBodyDecls
-
-enumBody :: P EnumBody
-enumBody = braces $ do
-    ecs <- seplist enumConst comma
-    optional comma
-    eds <- lopt enumBodyDecls
-    return $ EnumBody ecs eds
-    
-enumConst :: P EnumConstant
-enumConst = do
-    id  <- ident
-    as  <- lopt args
-    mcb <- opt classBody
-    return $ EnumConstant id as mcb
-
-enumBodyDecls :: P [Decl]
-enumBodyDecls = semiColon >> classBodyDecls
-
-classBodyDecls :: P [Decl]
-classBodyDecls = list classBodyDecl
-
--- Interface declarations
-
-interfaceDecl :: P (Mod InterfaceDecl)
-interfaceDecl = do
-    tok KW_Interface
-    id  <- ident
-    tps <- lopt typeParams
-    exs <- lopt extends
-    bod <- interfaceBody
-    return $ \ms -> InterfaceDecl ms id tps exs bod
-
-interfaceBody :: P InterfaceBody
-interfaceBody = InterfaceBody . catMaybes <$> 
-    braces (list interfaceBodyDecl)
-
--- Declarations
-
-classBodyDecl :: P Decl
-classBodyDecl = 
-    (try $ do 
-        mst <- bopt (tok KW_Static)
-        blk <- block
-        return $ InitDecl mst blk) <|> 
-    (do ms  <- list modifier
-        dec <- memberDecl
-        return $ MemberDecl (dec ms))
-    
-memberDecl :: P (Mod MemberDecl)
-memberDecl = 
-    (try $ do 
-        cd  <- classDecl
-        return $ \ms -> MemberClassDecl (cd ms)) <|>
-    (try $ do 
-        id  <- interfaceDecl
-        return $ \ms -> MemberInterfaceDecl (id ms)) <|> 
-    try fieldDecl <|> 
-    try methodDecl <|> 
-    constrDecl
-
-fieldDecl :: P (Mod MemberDecl)
-fieldDecl = endSemi $ do
-    typ <- ttype
-    vds <- varDecls
-    return $ \ms -> FieldDecl ms typ vds
-
-methodDecl :: P (Mod MemberDecl)
-methodDecl = do
-    tps <- lopt typeParams
-    rt  <- resultType
-    id  <- ident
-    fps <- formalParams
-    thr <- lopt throws
-    bod <- methodBody
-    return $ \ms -> MethodDecl ms tps rt id fps thr bod
-
-methodBody :: P MethodBody
-methodBody = MethodBody <$> 
-    (const Nothing <$> semiColon <|> Just <$> block)
-
-constrDecl :: P (Mod MemberDecl)
-constrDecl = do
-    tps <- lopt typeParams
-    id  <- ident
-    fps <- formalParams
-    thr <- lopt throws
-    bod <- constrBody
-    return $ \ms -> ConstructorDecl ms tps id fps thr bod
-
-constrBody :: P ConstructorBody
-constrBody = braces $ do
-    mec <- opt (try explConstrInv)
-    bss <- list blockStmt
-    return $ ConstructorBody mec bss
-    
-explConstrInv :: P ExplConstrInv
-explConstrInv = endSemi $
-    (try $ do
-        tas <- lopt refTypeArgs
-        tok KW_This
-        as  <- args
-        return $ ThisInvoke tas as) <|> 
-    (try $ do
-        tas <- lopt refTypeArgs
-        tok KW_Super
-        as  <- args
-        return $ SuperInvoke tas as) <|> 
-    (do pri <- primary
-        period
-        tas <- lopt refTypeArgs
-        tok KW_Super
-        as  <- args
-        return $ PrimarySuperInvoke pri tas as)
-
--- TODO: This should be parsed like class bodies, and post-checked.
---       That would give far better error messages.
-interfaceBodyDecl :: P (Maybe MemberDecl)
-interfaceBodyDecl = semiColon >> return Nothing <|> 
-    do ms  <- list modifier
-       imd <- interfaceMemberDecl
-       return $ Just (imd ms)
-    
-interfaceMemberDecl :: P (Mod MemberDecl)
-interfaceMemberDecl =
-    (do cd  <- classDecl
-        return $ \ms -> MemberClassDecl (cd ms)) <|>
-    (do id  <- interfaceDecl
-        return $ \ms -> MemberInterfaceDecl (id ms)) <|> 
-    try fieldDecl <|> 
-    absMethodDecl
-
-absMethodDecl :: P (Mod MemberDecl)
-absMethodDecl = do
-    tps <- lopt typeParams
-    rt  <- resultType
-    id  <- ident
-    fps <- formalParams
-    thr <- lopt throws
-    semiColon
-    return $ \ms -> MethodDecl ms tps rt id fps thr (MethodBody Nothing)
-
-throws :: P [RefType]
-throws = tok KW_Throws >> refTypeList
-
--- Formal parameters
-
-formalParams :: P [FormalParam]
-formalParams = parens $ do
-    fps <- seplist formalParam comma
-    if validateFPs fps
-     then return fps
-     else fail "Only the last formal parameter may be of variable arity"
-  where validateFPs :: [FormalParam] -> Bool
-        validateFPs [] = True
-        validateFPs [_] = True
-        validateFPs (FormalParam _ _ b _ :xs) = not b
-
-formalParam :: P FormalParam
-formalParam = do
-    ms  <- list modifier
-    typ <- ttype
-    var <- bopt ellipsis
-    vid <- varDeclId
-    return $ FormalParam ms typ var vid
-
-ellipsis :: P ()
-ellipsis = period >> period >> period
-
--- Modifiers
-
-modifier :: P Modifier
-modifier = 
-        tok KW_Public      >> return Public    
-    <|> tok KW_Protected   >> return Protected 
-    <|> tok KW_Private     >> return Private   
-    <|> tok KW_Abstract    >> return Abstract  
-    <|> tok KW_Static      >> return Static    
-    <|> tok KW_Strictfp    >> return StrictFP  
-    <|> tok KW_Final       >> return Final     
-    <|> tok KW_Native      >> return Native    
-    <|> tok KW_Transient   >> return Transient 
-    <|> tok KW_Volatile    >> return Volatile  
-    <|> Annotation <$> annotation
-    
-annotation :: P Annotation
-annotation = flip ($) <$ tok Op_AtSign <*> name <*> (
-               try (flip NormalAnnotation <$> parens evlist)
-           <|> try (flip SingleElementAnnotation <$> parens elementValue)
-           <|> try (MarkerAnnotation <$ return ())
-        )
-
-evlist :: P [(Ident, ElementValue)]
-evlist = seplist1 elementValuePair comma
-
-elementValuePair :: P (Ident, ElementValue)
-elementValuePair = (,) <$> ident <* tok Op_Equal <*> elementValue
-
-elementValue :: P ElementValue
-elementValue = 
-    EVVal <$> (    InitArray <$> arrayInit 
-               <|> InitExp   <$> condExp )
-    <|> EVAnn <$> annotation
-
-
-----------------------------------------------------------------------------
--- Variable declarations
-
-varDecls :: P [VarDecl]
-varDecls = seplist1 varDecl comma
-
-varDecl :: P VarDecl
-varDecl = do
-    vid <- varDeclId
-    mvi <- opt $ tok Op_Equal >> varInit
-    return $ VarDecl vid mvi
-
-varDeclId :: P VarDeclId
-varDeclId = do
-    id  <- ident
-    abs <- list arrBrackets
-    return $ foldl (\f _ -> VarDeclArray . f) VarId abs id
-
-arrBrackets :: P ()
-arrBrackets = brackets $ return ()
-
-localVarDecl :: P ([Modifier], Type, [VarDecl])
-localVarDecl = do
-    ms  <- list modifier
-    typ <- ttype
-    vds <- varDecls
-    return (ms, typ, vds)
-
-varInit :: P VarInit
-varInit = 
-    InitArray <$> arrayInit <|> 
-    InitExp   <$> exp
-
-arrayInit :: P ArrayInit
-arrayInit = braces $ do
-    vis <- seplist varInit comma
-    opt comma
-    return $ ArrayInit vis
-
-----------------------------------------------------------------------------
--- Statements
-
-block :: P Block
-block = braces $ Block <$> list blockStmt
-
-blockStmt :: P BlockStmt
-blockStmt = 
-    (try $ do
-        ms  <- list modifier
-        cd  <- classDecl
-        return $ LocalClass (cd ms)) <|> 
-    (try $ do
-        (m,t,vds) <- endSemi $ localVarDecl
-        return $ LocalVars m t vds) <|> 
-    BlockStmt <$> stmt
-
-stmt :: P Stmt
-stmt = 
-    -- ifThen and ifThenElse, with a common prefix
-    (do tok KW_If
-        e   <- parens exp
-        (try $ 
-            do th <- stmtNSI
-               tok KW_Else
-               el <- stmt
-               return $ IfThenElse e th el) <|> 
-           (do th <- stmt
-               return $ IfThen e th)) <|> 
-    -- while loops
-    (do tok KW_While
-        e   <- parens exp
-        s   <- stmt
-        return $ While e s) <|>
-    -- basic and enhanced for
-    (do tok KW_For
-        f <- parens $ 
-            (try $ do
-                fi <- opt forInit
-                semiColon
-                e  <- opt exp
-                semiColon
-                fu <- opt forUp
-                return $ BasicFor fi e fu) <|> 
-            (do ms <- list modifier
-                t  <- ttype
-                i  <- ident
-                colon
-                e  <- exp
-                return $ EnhancedFor ms t i e)
-        s <- stmt
-        return $ f s) <|> 
-    -- labeled statements
-    (try $ do
-        lbl <- ident
-        colon
-        s   <- stmt
-        return $ Labeled lbl s) <|>
-    -- the rest
-    stmtNoTrail
-
-stmtNSI :: P Stmt
-stmtNSI =
-    -- if statements - only full ifThenElse
-    (do tok KW_If
-        e  <- parens exp
-        th <- stmtNSI
-        tok KW_Else
-        el <- stmtNSI
-        return $ IfThenElse e th el) <|>
-    -- while loops
-    (do tok KW_While
-        e <- parens exp
-        s <- stmtNSI
-        return $ While e s) <|>
-    -- for loops, both basic and enhanced
-    (do tok KW_For
-        f <- parens $ (try $ do
-            fi <- opt forInit
-            semiColon
-            e  <- opt exp
-            semiColon
-            fu <- opt forUp
-            return $ BasicFor fi e fu)
-            <|> (do
-            ms <- list modifier
-            t  <- ttype
-            i  <- ident
-            colon
-            e  <- exp
-            return $ EnhancedFor ms t i e)
-        s <- stmtNSI
-        return $ f s) <|>
-    -- labeled stmts
-    (try $ do
-        i <- ident
-        colon
-        s <- stmtNSI
-        return $ Labeled i s) <|>
-    -- the rest
-    stmtNoTrail
-
-
-stmtNoTrail :: P Stmt
-stmtNoTrail = 
-    -- empty statement
-    const Empty <$> semiColon <|>
-    -- inner block
-    StmtBlock <$> block <|>
-    -- assertions
-    (endSemi $ do 
-        tok KW_Assert
-        e   <- exp
-        me2 <- opt $ colon >> exp
-        return $ Assert e me2) <|>
-    -- switch stmts
-    (do tok KW_Switch
-        e  <- parens exp
-        sb <- switchBlock
-        return $ Switch e sb) <|>
-    -- do-while loops
-    (endSemi $ do 
-        tok KW_Do
-        s <- stmt
-        tok KW_While
-        e <- parens exp
-        return $ Do s e) <|>
-    -- break
-    (endSemi $ do
-        tok KW_Break
-        mi <- opt ident
-        return $ Break mi) <|>
-    -- continue
-    (endSemi $ do
-        tok KW_Continue
-        mi <- opt ident
-        return $ Continue mi) <|>
-    -- return
-    (endSemi $ do
-        tok KW_Return
-        me <- opt exp
-        return $ Return me) <|>
-    -- synchronized
-    (do tok KW_Synchronized
-        e <- parens exp
-        b <- block
-        return $ Synchronized e b) <|>
-    -- throw
-    (endSemi $ do
-        tok KW_Throw
-        e <- exp
-        return $ Throw e) <|>
-    -- try-catch, both with and without a finally clause
-    (do tok KW_Try
-        b <- block
-        c <- list catch
-        mf <- opt $ tok KW_Finally >> block
-        -- TODO: here we should check that there exists at
-        -- least one catch or finally clause
-        return $ Try b c mf) <|>
-    -- expressions as stmts
-    ExpStmt <$> endSemi stmtExp
-
--- For loops
-
-forInit :: P ForInit
-forInit = (do
-    (m,t,vds) <- localVarDecl
-    return $ ForLocalVars m t vds) <|>
-    (seplist1 stmtExp comma >>= return . ForInitExps)
-
-forUp :: P [Exp]
-forUp = seplist1 stmtExp comma
-
--- Switches
-
-switchBlock :: P [SwitchBlock]
-switchBlock = braces $ list switchStmt
-
-switchStmt :: P SwitchBlock
-switchStmt = do
-    lbl <- switchLabel
-    bss <- list blockStmt
-    return $ SwitchBlock lbl bss
-
-switchLabel :: P SwitchLabel
-switchLabel = (tok KW_Default >> colon >> return Default) <|> 
-    (do tok KW_Case 
-        e <- exp 
-        colon
-        return $ SwitchCase e)
-
--- Try-catch clauses
-
-catch :: P Catch
-catch = do
-    tok KW_Catch
-    fp <- parens formalParam
-    b  <- block
-    return $ Catch fp b
-
-----------------------------------------------------------------------------
--- Expressions
-
-stmtExp :: P Exp
-stmtExp = try preIncDec
-    <|> try postIncDec
-    <|> try assignment
-    -- There are sharing gains to be made by unifying these two
-    <|> try instanceCreation
-    <|> methodInvocationExp
-
-preIncDec :: P Exp
-preIncDec = do
-    op <- preIncDecOp
-    e <- unaryExp
-    return $ op e
-
-postIncDec :: P Exp
-postIncDec = do
-    e <- postfixExpNES
-    ops <- list1 postfixOp
-    return $ foldl (\a s -> s a) e ops
-
-assignment :: P Exp
-assignment = do
-    lh <- lhs
-    op <- assignOp
-    e  <- assignExp
-    return $ Assign lh op e
-
-lhs :: P Lhs
-lhs = try (FieldLhs <$> fieldAccess)
-    <|> try (ArrayLhs <$> arrayAccess)
-    <|> NameLhs <$> name
-
-
-
-exp :: P Exp
-exp = assignExp
-
-assignExp :: P Exp
-assignExp = try assignment <|> condExp
-
-condExp :: P Exp
-condExp = do
-    ie <- infixExp
-    ces <- list condExpSuffix
-    return $ foldl (\a s -> s a) ie ces
-
-condExpSuffix :: P (Exp -> Exp)
-condExpSuffix = do
-    tok Op_Query
-    th <- exp
-    colon
-    el <- condExp
-    return $ \ce -> Cond ce th el
-
-infixExp :: P Exp
-infixExp = do
-    ue <- unaryExp
-    ies <- list infixExpSuffix
-    return $ foldl (\a s -> s a) ue ies
-
-infixExpSuffix :: P (Exp -> Exp)
-infixExpSuffix =
-    (do op <- infixOp
-        e2 <- unaryExp
-        return $ \e1 -> BinOp e1 op e2) <|> 
-    (do tok KW_Instanceof
-        t  <- refType
-        return $ \e1 -> InstanceOf e1 t)
-    
-unaryExp :: P Exp
-unaryExp = try preIncDec <|>
-    try (do
-        op <- prefixOp
-        ue <- unaryExp
-        return $ op ue) <|>
-    try (do
-        t <- parens ttype
-        e <- unaryExp
-        return $ Cast t e) <|>
-    postfixExp
-
-postfixExpNES :: P Exp
-postfixExpNES = -- try postIncDec <|>
-    try primary <|>
-    ExpName <$> name
-
-postfixExp :: P Exp
-postfixExp = do 
-    pe <- postfixExpNES
-    ops <- list postfixOp
-    return $ foldl (\a s -> s a) pe ops
-    
-
-primary :: P Exp
-primary = primaryNPS |>> primarySuffix
-
-primaryNPS :: P Exp
-primaryNPS = try arrayCreation <|> primaryNoNewArrayNPS
-
-primaryNoNewArray = startSuff primaryNoNewArrayNPS primarySuffix
-
-primaryNoNewArrayNPS :: P Exp
-primaryNoNewArrayNPS = 
-    Lit <$> literal <|>
-    const This <$> tok KW_This <|>
-    parens exp <|> 
-    -- TODO: These two following should probably be merged more
-    (try $ do 
-        rt <- resultType 
-        period >> tok KW_Class
-        return $ ClassLit rt) <|>
-    (try $ do 
-        n <- name
-        period >> tok KW_This
-        return $ ThisClass n) <|>
-    try instanceCreationNPS <|>
-    try (MethodInv <$> methodInvocationNPS) <|>
-    try (FieldAccess <$> fieldAccessNPS) <|>
-    ArrayAccess <$> arrayAccessNPS
-
-primarySuffix :: P (Exp -> Exp)
-primarySuffix = try instanceCreationSuffix <|>
-    try ((ArrayAccess .) <$> arrayAccessSuffix) <|>
-    try ((MethodInv .) <$> methodInvocationSuffix) <|>
-    (FieldAccess .) <$> fieldAccessSuffix
-
-
-instanceCreationNPS :: P Exp
-instanceCreationNPS = 
-    do tok KW_New
-       tas <- lopt typeArgs
-       ct  <- classType
-       as  <- args
-       mcb <- opt classBody
-       return $ InstanceCreation tas ct as mcb
-
-instanceCreationSuffix :: P (Exp -> Exp)
-instanceCreationSuffix =
-     do period >> tok KW_New
-        tas <- lopt typeArgs
-        i   <- ident
-        as  <- args
-        mcb <- opt classBody
-        return $ \p -> QualInstanceCreation p tas i as mcb
-
-instanceCreation :: P Exp
-instanceCreation = try instanceCreationNPS <|> do
-    p <- primaryNPS
-    ss <- list primarySuffix
-    let icp = foldl (\a s -> s a) p ss
-    case icp of
-     QualInstanceCreation {} -> return icp
-     _ -> fail ""
-
-{- 
-instanceCreation = 
-    (do tok KW_New
-        tas <- lopt typeArgs
-        ct  <- classType
-        as  <- args
-        mcb <- opt classBody
-        return $ InstanceCreation tas ct as mcb) <|>
-    (do p   <- primary
-        period >> tok KW_New
-        tas <- lopt typeArgs
-        i   <- ident
-        as  <- args
-        mcb <- opt classBody
-        return $ QualInstanceCreation p tas i as mcb) 
--}
-
-fieldAccessNPS :: P FieldAccess
-fieldAccessNPS =
-    (do tok KW_Super >> period
-        i <- ident
-        return $ SuperFieldAccess i) <|>
-    (do n <- name
-        period >> tok KW_Super >> period
-        i <- ident
-        return $ ClassFieldAccess n i)    
-
-fieldAccessSuffix :: P (Exp -> FieldAccess)
-fieldAccessSuffix = do
-    period
-    i <- ident
-    return $ \p -> PrimaryFieldAccess p i
-
-fieldAccess :: P FieldAccess
-fieldAccess = try fieldAccessNPS <|> do
-    p <- primaryNPS
-    ss <- list primarySuffix
-    let fap = foldl (\a s -> s a) p ss
-    case fap of
-     FieldAccess fa -> return fa
-     _ -> fail ""
-
-{-
-fieldAccess :: P FieldAccess
-fieldAccess = try fieldAccessNPS <|> do
-    p <- primary
-    fs <- fieldAccessSuffix 
-    return (fs p)
--}
-
-{-
-fieldAccess :: P FieldAccess
-fieldAccess =
-    (do tok KW_Super >> period
-        i <- ident
-        return $ SuperFieldAccess i) <|>
-    (try $ do
-        n <- name
-        period >> tok KW_Super >> period
-        i <- ident
-        return $ ClassFieldAccess n i) <|>
-    (do p <- primary
-        period
-        i <- ident
-        return $ PrimaryFieldAccess p i) 
--}
-
-methodInvocationNPS :: P MethodInvocation
-methodInvocationNPS =
-    (do tok KW_Super >> period
-        rts <- lopt refTypeArgs
-        i   <- ident
-        as  <- args
-        return $ SuperMethodCall rts i as) <|>
-    (do n <- name
-        f <- (do as <- args
-                 return $ \n -> MethodCall n as) <|>
-             (period >> do
-                msp <- opt (tok KW_Super >> period)
-                rts <- lopt refTypeArgs
-                i   <- ident
-                as  <- args
-                let mc = maybe TypeMethodCall (const ClassMethodCall) msp
-                return $ \n -> mc n rts i as)
-        return $ f n)
-
-methodInvocationSuffix :: P (Exp -> MethodInvocation)
-methodInvocationSuffix = do
-        period
-        rts <- lopt refTypeArgs
-        i   <- ident
-        as  <- args
-        return $ \p -> PrimaryMethodCall p [] i as
-
-methodInvocationExp :: P Exp
-methodInvocationExp = try (MethodInv <$> methodInvocationNPS) <|> do
-    p <- primaryNPS
-    ss <- list primarySuffix
-    let mip = foldl (\a s -> s a) p ss
-    case mip of
-     MethodInv _ -> return mip
-     _ -> fail ""
-
-{-
-methodInvocation :: P MethodInvocation
-methodInvocation =
-    (do tok KW_Super >> period
-        rts <- lopt refTypeArgs
-        i   <- ident
-        as  <- args
-        return $ SuperMethodCall rts i as) <|>
-    (do p <- primary
-        period
-        rts <- lopt refTypeArgs
-        i   <- ident
-        as  <- args
-        return $ PrimaryMethodCall p rts i as) <|>
-    (do n <- name
-        f <- (do as <- args
-                 return $ \n -> MethodCall n as) <|>
-             (period >> do
-                msp <- opt (tok KW_Super >> period)
-                rts <- lopt refTypeArgs
-                i   <- ident
-                as  <- args
-                let mc = maybe TypeMethodCall (const ClassMethodCall) msp
-                return $ \n -> mc n rts i as)
-        return $ f n)
--}
-
-args :: P [Argument]
-args = parens $ seplist exp comma
-
--- Arrays
-
-arrayAccessNPS :: P ArrayIndex
-arrayAccessNPS = do
-    n <- name
-    e <- brackets exp
-    return $ ArrayIndex (ExpName n) e
-
-arrayAccessSuffix :: P (Exp -> ArrayIndex)
-arrayAccessSuffix = do
-    e <- brackets exp
-    return $ \ref -> ArrayIndex ref e
-    
-arrayAccess = try arrayAccessNPS <|> do
-    p <- primaryNoNewArrayNPS
-    ss <- list primarySuffix
-    let aap = foldl (\a s -> s a) p ss
-    case aap of
-     ArrayAccess ain -> return ain
-     _ -> fail ""
-
-{-
-arrayAccess :: P (Exp, Exp)
-arrayAccess = do
-    ref <- arrayRef
-    e   <- brackets exp
-    return (ref, e)
-
-arrayRef :: P Exp
-arrayRef = ExpName <$> name <|> primaryNoNewArray
--}
-
-arrayCreation :: P Exp
-arrayCreation = do
-    tok KW_New
-    t <- nonArrayType
-    f <- (try $ do
-             ds <- list1 $ brackets empty
-             ai <- arrayInit
-             return $ \t -> ArrayCreateInit t (length ds) ai) <|> 
-         (do des <- list1 $ brackets exp
-             ds  <- list  $ brackets empty
-             return $ \t -> ArrayCreate t des (length ds))
-    return $ f t
-
-literal :: P Literal
-literal = 
-    javaToken $ \t -> case t of
-        IntTok     i -> Just (Int i)
-        LongTok    l -> Just (Word l)
-        DoubleTok  d -> Just (Double d)
-        FloatTok   f -> Just (Float f)
-        CharTok    c -> Just (Char c)
-        StringTok  s -> Just (String s)
-        BoolTok    b -> Just (Boolean b)
-        NullTok      -> Just Null
-        _ -> Nothing
-
--- Operators
-
-preIncDecOp, prefixOp, postfixOp :: P (Exp -> Exp)
-preIncDecOp =
-    (tok Op_PPlus >> return PreIncrement) <|> 
-    (tok Op_MMinus >> return PreDecrement)
-prefixOp = 
-    (tok Op_Bang  >> return PreNot      ) <|>
-    (tok Op_Tilde >> return PreBitCompl ) <|>
-    (tok Op_Plus  >> return PrePlus     ) <|>
-    (tok Op_Minus >> return PreMinus    )
-postfixOp =
-    (tok Op_PPlus  >> return PostIncrement) <|>
-    (tok Op_MMinus >> return PostDecrement)
-
-assignOp :: P AssignOp
-assignOp =
-    (tok Op_Equal    >> return EqualA   ) <|>
-    (tok Op_StarE    >> return MultA    ) <|>
-    (tok Op_SlashE   >> return DivA     ) <|>
-    (tok Op_PercentE >> return RemA     ) <|>
-    (tok Op_PlusE    >> return AddA     ) <|>
-    (tok Op_MinusE   >> return SubA     ) <|>
-    (tok Op_LShiftE  >> return LShiftA  ) <|>
-    (tok Op_RShiftE  >> return RShiftA  ) <|>
-    (tok Op_RRShiftE >> return RRShiftA ) <|>
-    (tok Op_AndE     >> return AndA     ) <|>
-    (tok Op_CaretE   >> return XorA     ) <|>
-    (tok Op_OrE      >> return OrA      )
-
-infixOp :: P Op
-infixOp =
-    (tok Op_Star    >> return Mult      ) <|>
-    (tok Op_Slash   >> return Div       ) <|>
-    (tok Op_Percent >> return Rem       ) <|>
-    (tok Op_Plus    >> return Add       ) <|>
-    (tok Op_Minus   >> return Sub       ) <|>
-    (tok Op_LShift  >> return LShift    ) <|>
-    (tok Op_RShift  >> return RShift    ) <|>
-    (tok Op_RRShift >> return RRShift   ) <|>
-    (tok Op_LThan   >> return LThan     ) <|>
-    (tok Op_GThan   >> return GThan     ) <|>
-    (tok Op_LThanE  >> return LThanE    ) <|>
-    (tok Op_GThanE  >> return GThanE    ) <|>
-    (tok Op_Equals  >> return Equal     ) <|>
-    (tok Op_BangE   >> return NotEq     ) <|>
-    (tok Op_And     >> return And       ) <|>
-    (tok Op_Caret   >> return Xor       ) <|>
-    (tok Op_Or      >> return Or        ) <|>
-    (tok Op_AAnd    >> return CAnd      ) <|>
-    (tok Op_OOr     >> return COr       )
-
-
-----------------------------------------------------------------------------
--- Types
-
-ttype :: P Type
-ttype = try (RefType <$> refType) <|> PrimType <$> primType
-
-primType :: P PrimType
-primType =
-    tok KW_Boolean >> return BooleanT  <|>
-    tok KW_Byte    >> return ByteT     <|>
-    tok KW_Short   >> return ShortT    <|>
-    tok KW_Int     >> return IntT      <|>
-    tok KW_Long    >> return LongT     <|>
-    tok KW_Char    >> return CharT     <|>
-    tok KW_Float   >> return FloatT    <|>
-    tok KW_Double  >> return DoubleT   
-    
-refType :: P RefType
-refType =
-    (do pt <- primType
-        (_:bs) <- list1 arrBrackets
-        return $ foldl (\f _ -> ArrayType . RefType . f) 
-                        (ArrayType . PrimType) bs pt) <|>
-    (do ct <- classType
-        bs <- list arrBrackets
-        return $ foldl (\f _ -> ArrayType . RefType . f)
-                            ClassRefType bs ct) <?> "refType"
-
-nonArrayType :: P Type
-nonArrayType = PrimType <$> primType <|> 
-    RefType <$> ClassRefType <$> classType
-
-classType :: P ClassType
-classType = ClassType <$> seplist1 classTypeSpec period
-
-classTypeSpec :: P (Ident, [TypeArgument])
-classTypeSpec = do
-    i   <- ident
-    tas <- lopt typeArgs
-    return (i, tas)
-
-resultType :: P (Maybe Type)
-resultType = tok KW_Void >> return Nothing <|> Just <$> ttype <?> "resultType"
-
-refTypeList :: P [RefType]
-refTypeList = seplist1 refType comma
-
-----------------------------------------------------------------------------
--- Type parameters and arguments
-
-typeParams :: P [TypeParam]
-typeParams = angles $ seplist1 typeParam comma
-
-typeParam :: P TypeParam
-typeParam = do
-    i  <- ident
-    bs <- lopt bounds
-    return $ TypeParam i bs
-
-bounds :: P [RefType]
-bounds = tok KW_Extends >> seplist1 refType (tok Op_And)
-
-typeArgs :: P [TypeArgument]
-typeArgs = angles $ seplist1 typeArg comma
-
-typeArg :: P TypeArgument
-typeArg = tok Op_Query >> Wildcard <$> opt wildcardBound
-    <|> ActualType <$> refType
-
-wildcardBound :: P WildcardBound
-wildcardBound = tok KW_Extends >> ExtendsBound <$> refType
-    <|> tok KW_Super >> SuperBound <$> refType
-
-refTypeArgs :: P [RefType]
-refTypeArgs = angles refTypeList
-
-----------------------------------------------------------------------------
--- Names
-
-name :: P Name
-name = Name <$> seplist1 ident period
-
-ident :: P Ident
-ident = javaToken $ \t -> case t of
-    IdentTok s -> Just $ Ident s
-    _ -> Nothing
-
-------------------------------------------------------------
-
-empty :: P ()
-empty = return ()
-
-opt :: P a -> P (Maybe a)
-opt = optionMaybe
-
-bopt :: P a -> P Bool
-bopt p = opt p >>= \ma -> return $ isJust ma
-
-lopt :: P [a] -> P [a]
-lopt p = do mas <- opt p
-            case mas of
-             Nothing -> return []
-             Just as -> return as
-
-list :: P a -> P [a]
-list = option [] . list1
-
-list1 :: P a -> P [a]
-list1 = many1
-
-seplist :: P a -> P sep -> P [a]
---seplist = sepBy
-seplist p sep = option [] $ seplist1 p sep
-
-seplist1 :: P a -> P sep -> P [a]
---seplist1 = sepBy1
-seplist1 p sep = 
-    p >>= \a -> 
-        try (do sep
-                as <- seplist1 p sep
-                return (a:as)) 
-        <|> return [a]
-
-startSuff, (|>>) :: P a -> P (a -> a) -> P a
-startSuff start suffix = do
-    x <- start
-    ss <- list suffix
-    return $ foldl (\a s -> s a) x ss
-
-(|>>) = startSuff
-
-------------------------------------------------------------
-
-javaToken :: (Token -> Maybe a) -> P a
-javaToken test = token showT posT testT
-  where showT (L _ t) = show t
-        posT  (L p _) = pos2sourcePos p
-        testT (L _ t) = test t
-
-tok, matchToken :: Token -> P ()
-tok = matchToken
-matchToken t = javaToken (\r -> if r == t then Just () else Nothing)
-
-pos2sourcePos :: (Int, Int) -> SourcePos
-pos2sourcePos (l,c) = newPos "" l c
-
-type Mod a = [Modifier] -> a
-
-parens, braces, brackets, angles :: P a -> P a
-parens   = between (tok OpenParen)  (tok CloseParen)
-braces   = between (tok OpenCurly)  (tok CloseCurly)
-brackets = between (tok OpenSquare) (tok CloseSquare)
-angles   = between (tok Op_LThan)   (tok Op_GThan)
-
-endSemi :: P a -> P a
-endSemi p = p >>= \a -> semiColon >> return a
-
-comma, colon, semiColon, period :: P ()
-comma     = tok Comma
-colon     = tok Op_Colon
-semiColon = tok SemiColon
-period    = tok Period
-
-------------------------------------------------------------
-
-test = "public class Foo { }"
-testFile file = do
-  i <- readFile file
-  let r = parseCompilationUnit i
-  putStrLn$ either (("Parsing error:\n"++) . show) (show . pretty) r
+module Language.Java.Parser (+    parser,++    compilationUnit, packageDecl, importDecl, typeDecl,++    classDecl, interfaceDecl,++    memberDecl, fieldDecl, methodDecl, constrDecl,+    interfaceMemberDecl, absMethodDecl,++    formalParams, formalParam,++    modifier,++    varDecls, varDecl,++    block, blockStmt, stmt,++    stmtExp, exp, primary, literal,++    ttype, primType, refType, classType, resultType,++    typeParams, typeParam,++    name, ident,+++    empty, list, list1, seplist, seplist1, opt, bopt, lopt,++    comma, semiColon, period, colon++    ) where++import Language.Java.Lexer ( L(..), Token(..), lexer)+import Language.Java.Syntax+import Language.Java.Pretty (pretty)++import Text.Parsec hiding ( Empty )+import Text.Parsec.Pos++import Prelude hiding ( exp, catch, (>>), (>>=) )+import qualified Prelude as P ( (>>), (>>=) )+import Data.Maybe ( isJust, catMaybes )+import Control.Monad ( ap )+import Control.Applicative ( (<$>), (<$), (<*) )+++type P = Parsec [L Token] ()++-- A trick to allow >> and >>=, normally infixr 1, to be+-- used inside branches of <|>, which is declared as infixl 1.+-- There are no clashes with other operators of precedence 2.+(>>) = (P.>>)+(>>=) = (P.>>=)+infixr 2 >>, >>=+-- Note also when reading that <$> is infixl 4 and thus has+-- lower precedence than all the others (>>, >>=, and <|>).++-- Since I cba to find the instance Monad m => Applicative m declaration.+(<*>) :: Monad m => m (a -> b) -> m a -> m b+(<*>) = ap+infixl 4 <*>++----------------------------------------------------------------------------+-- Top-level parsing++parseCompilationUnit :: String -> Either ParseError CompilationUnit+parseCompilationUnit inp =+    runParser compilationUnit () "" (lexer inp)++parser p = runParser p () "" . lexer++--class Parse a where+--  parse :: String -> a++----------------------------------------------------------------------------+-- Packages and compilation units++compilationUnit :: P CompilationUnit+compilationUnit = do+    mpd <- opt packageDecl+    ids <- list importDecl+    tds <- list typeDecl+    return $ CompilationUnit mpd ids (catMaybes tds)++packageDecl :: P PackageDecl+packageDecl = do+    tok KW_Package+    n <- name+    semiColon+    return $ PackageDecl n++importDecl :: P ImportDecl+importDecl = do+    tok KW_Import+    st <- bopt $ tok KW_Static+    n  <- name+    ds <- bopt $ period >> tok Op_Star+    semiColon+    return $ ImportDecl st n ds++typeDecl :: P (Maybe TypeDecl)+typeDecl = Just <$> classOrInterfaceDecl <|>+            const Nothing <$> semiColon++----------------------------------------------------------------------------+-- Declarations++-- Class declarations++classOrInterfaceDecl :: P TypeDecl+classOrInterfaceDecl = do+    ms <- list modifier+    de <- (do cd <- classDecl+              return $ \ms -> ClassTypeDecl (cd ms)) <|>+          (do id <- interfaceDecl+              return $ \ms -> InterfaceTypeDecl (id ms))+    return $ de ms++classDecl :: P (Mod ClassDecl)+classDecl = normalClassDecl <|> enumClassDecl++normalClassDecl :: P (Mod ClassDecl)+normalClassDecl = do+    tok KW_Class+    i   <- ident+    tps <- lopt typeParams+    mex <- opt extends+    imp <- lopt implements+    bod <- classBody+    return $ \ms -> ClassDecl ms i tps ((fmap head) mex) imp bod++extends :: P [RefType]+extends = tok KW_Extends >> refTypeList++implements :: P [RefType]+implements = tok KW_Implements >> refTypeList++enumClassDecl :: P (Mod ClassDecl)+enumClassDecl = do+    tok KW_Enum+    i   <- ident+    imp <- lopt implements+    bod <- enumBody+    return $ \ms -> EnumDecl ms i imp bod++classBody :: P ClassBody+classBody = ClassBody <$> braces classBodyDecls++enumBody :: P EnumBody+enumBody = braces $ do+    ecs <- seplist enumConst comma+    optional comma+    eds <- lopt enumBodyDecls+    return $ EnumBody ecs eds++enumConst :: P EnumConstant+enumConst = do+    id  <- ident+    as  <- lopt args+    mcb <- opt classBody+    return $ EnumConstant id as mcb++enumBodyDecls :: P [Decl]+enumBodyDecls = semiColon >> classBodyDecls++classBodyDecls :: P [Decl]+classBodyDecls = list classBodyDecl++-- Interface declarations++interfaceDecl :: P (Mod InterfaceDecl)+interfaceDecl = do+    tok KW_Interface+    id  <- ident+    tps <- lopt typeParams+    exs <- lopt extends+    bod <- interfaceBody+    return $ \ms -> InterfaceDecl ms id tps exs bod++interfaceBody :: P InterfaceBody+interfaceBody = InterfaceBody . catMaybes <$>+    braces (list interfaceBodyDecl)++-- Declarations++classBodyDecl :: P Decl+classBodyDecl =+    (try $ do+        mst <- bopt (tok KW_Static)+        blk <- block+        return $ InitDecl mst blk) <|>+    (do ms  <- list modifier+        dec <- memberDecl+        return $ MemberDecl (dec ms))++memberDecl :: P (Mod MemberDecl)+memberDecl =+    (try $ do+        cd  <- classDecl+        return $ \ms -> MemberClassDecl (cd ms)) <|>+    (try $ do+        id  <- interfaceDecl+        return $ \ms -> MemberInterfaceDecl (id ms)) <|>+    try fieldDecl <|>+    try methodDecl <|>+    constrDecl++fieldDecl :: P (Mod MemberDecl)+fieldDecl = endSemi $ do+    typ <- ttype+    vds <- varDecls+    return $ \ms -> FieldDecl ms typ vds++methodDecl :: P (Mod MemberDecl)+methodDecl = do+    tps <- lopt typeParams+    rt  <- resultType+    id  <- ident+    fps <- formalParams+    thr <- lopt throws+    bod <- methodBody+    return $ \ms -> MethodDecl ms tps rt id fps thr bod++methodBody :: P MethodBody+methodBody = MethodBody <$>+    (const Nothing <$> semiColon <|> Just <$> block)++constrDecl :: P (Mod MemberDecl)+constrDecl = do+    tps <- lopt typeParams+    id  <- ident+    fps <- formalParams+    thr <- lopt throws+    bod <- constrBody+    return $ \ms -> ConstructorDecl ms tps id fps thr bod++constrBody :: P ConstructorBody+constrBody = braces $ do+    mec <- opt (try explConstrInv)+    bss <- list blockStmt+    return $ ConstructorBody mec bss++explConstrInv :: P ExplConstrInv+explConstrInv = endSemi $+    (try $ do+        tas <- lopt refTypeArgs+        tok KW_This+        as  <- args+        return $ ThisInvoke tas as) <|>+    (try $ do+        tas <- lopt refTypeArgs+        tok KW_Super+        as  <- args+        return $ SuperInvoke tas as) <|>+    (do pri <- primary+        period+        tas <- lopt refTypeArgs+        tok KW_Super+        as  <- args+        return $ PrimarySuperInvoke pri tas as)++-- TODO: This should be parsed like class bodies, and post-checked.+--       That would give far better error messages.+interfaceBodyDecl :: P (Maybe MemberDecl)+interfaceBodyDecl = semiColon >> return Nothing <|>+    do ms  <- list modifier+       imd <- interfaceMemberDecl+       return $ Just (imd ms)++interfaceMemberDecl :: P (Mod MemberDecl)+interfaceMemberDecl =+    (do cd  <- classDecl+        return $ \ms -> MemberClassDecl (cd ms)) <|>+    (do id  <- interfaceDecl+        return $ \ms -> MemberInterfaceDecl (id ms)) <|>+    try fieldDecl <|>+    absMethodDecl++absMethodDecl :: P (Mod MemberDecl)+absMethodDecl = do+    tps <- lopt typeParams+    rt  <- resultType+    id  <- ident+    fps <- formalParams+    thr <- lopt throws+    semiColon+    return $ \ms -> MethodDecl ms tps rt id fps thr (MethodBody Nothing)++throws :: P [RefType]+throws = tok KW_Throws >> refTypeList++-- Formal parameters++formalParams :: P [FormalParam]+formalParams = parens $ do+    fps <- seplist formalParam comma+    if validateFPs fps+     then return fps+     else fail "Only the last formal parameter may be of variable arity"+  where validateFPs :: [FormalParam] -> Bool+        validateFPs [] = True+        validateFPs [_] = True+        validateFPs (FormalParam _ _ b _ :xs) = not b++formalParam :: P FormalParam+formalParam = do+    ms  <- list modifier+    typ <- ttype+    var <- bopt ellipsis+    vid <- varDeclId+    return $ FormalParam ms typ var vid++ellipsis :: P ()+ellipsis = period >> period >> period++-- Modifiers++modifier :: P Modifier+modifier =+        tok KW_Public      >> return Public+    <|> tok KW_Protected   >> return Protected+    <|> tok KW_Private     >> return Private+    <|> tok KW_Abstract    >> return Abstract+    <|> tok KW_Static      >> return Static+    <|> tok KW_Strictfp    >> return StrictFP+    <|> tok KW_Final       >> return Final+    <|> tok KW_Native      >> return Native+    <|> tok KW_Transient   >> return Transient+    <|> tok KW_Volatile    >> return Volatile+    <|> Annotation <$> annotation++annotation :: P Annotation+annotation = flip ($) <$ tok Op_AtSign <*> name <*> (+               try (flip NormalAnnotation <$> parens evlist)+           <|> try (flip SingleElementAnnotation <$> parens elementValue)+           <|> try (MarkerAnnotation <$ return ())+        )++evlist :: P [(Ident, ElementValue)]+evlist = seplist1 elementValuePair comma++elementValuePair :: P (Ident, ElementValue)+elementValuePair = (,) <$> ident <* tok Op_Equal <*> elementValue++elementValue :: P ElementValue+elementValue =+    EVVal <$> (    InitArray <$> arrayInit+               <|> InitExp   <$> condExp )+    <|> EVAnn <$> annotation+++----------------------------------------------------------------------------+-- Variable declarations++varDecls :: P [VarDecl]+varDecls = seplist1 varDecl comma++varDecl :: P VarDecl+varDecl = do+    vid <- varDeclId+    mvi <- opt $ tok Op_Equal >> varInit+    return $ VarDecl vid mvi++varDeclId :: P VarDeclId+varDeclId = do+    id  <- ident+    abs <- list arrBrackets+    return $ foldl (\f _ -> VarDeclArray . f) VarId abs id++arrBrackets :: P ()+arrBrackets = brackets $ return ()++localVarDecl :: P ([Modifier], Type, [VarDecl])+localVarDecl = do+    ms  <- list modifier+    typ <- ttype+    vds <- varDecls+    return (ms, typ, vds)++varInit :: P VarInit+varInit =+    InitArray <$> arrayInit <|>+    InitExp   <$> exp++arrayInit :: P ArrayInit+arrayInit = braces $ do+    vis <- seplist varInit comma+    opt comma+    return $ ArrayInit vis++----------------------------------------------------------------------------+-- Statements++block :: P Block+block = braces $ Block <$> list blockStmt++blockStmt :: P BlockStmt+blockStmt =+    (try $ do+        ms  <- list modifier+        cd  <- classDecl+        return $ LocalClass (cd ms)) <|>+    (try $ do+        (m,t,vds) <- endSemi $ localVarDecl+        return $ LocalVars m t vds) <|>+    BlockStmt <$> stmt++stmt :: P Stmt+stmt =+    -- ifThen and ifThenElse, with a common prefix+    (do tok KW_If+        e   <- parens exp+        (try $+            do th <- stmtNSI+               tok KW_Else+               el <- stmt+               return $ IfThenElse e th el) <|>+           (do th <- stmt+               return $ IfThen e th)) <|>+    -- while loops+    (do tok KW_While+        e   <- parens exp+        s   <- stmt+        return $ While e s) <|>+    -- basic and enhanced for+    (do tok KW_For+        f <- parens $+            (try $ do+                fi <- opt forInit+                semiColon+                e  <- opt exp+                semiColon+                fu <- opt forUp+                return $ BasicFor fi e fu) <|>+            (do ms <- list modifier+                t  <- ttype+                i  <- ident+                colon+                e  <- exp+                return $ EnhancedFor ms t i e)+        s <- stmt+        return $ f s) <|>+    -- labeled statements+    (try $ do+        lbl <- ident+        colon+        s   <- stmt+        return $ Labeled lbl s) <|>+    -- the rest+    stmtNoTrail++stmtNSI :: P Stmt+stmtNSI =+    -- if statements - only full ifThenElse+    (do tok KW_If+        e  <- parens exp+        th <- stmtNSI+        tok KW_Else+        el <- stmtNSI+        return $ IfThenElse e th el) <|>+    -- while loops+    (do tok KW_While+        e <- parens exp+        s <- stmtNSI+        return $ While e s) <|>+    -- for loops, both basic and enhanced+    (do tok KW_For+        f <- parens $ (try $ do+            fi <- opt forInit+            semiColon+            e  <- opt exp+            semiColon+            fu <- opt forUp+            return $ BasicFor fi e fu)+            <|> (do+            ms <- list modifier+            t  <- ttype+            i  <- ident+            colon+            e  <- exp+            return $ EnhancedFor ms t i e)+        s <- stmtNSI+        return $ f s) <|>+    -- labeled stmts+    (try $ do+        i <- ident+        colon+        s <- stmtNSI+        return $ Labeled i s) <|>+    -- the rest+    stmtNoTrail+++stmtNoTrail :: P Stmt+stmtNoTrail =+    -- empty statement+    const Empty <$> semiColon <|>+    -- inner block+    StmtBlock <$> block <|>+    -- assertions+    (endSemi $ do+        tok KW_Assert+        e   <- exp+        me2 <- opt $ colon >> exp+        return $ Assert e me2) <|>+    -- switch stmts+    (do tok KW_Switch+        e  <- parens exp+        sb <- switchBlock+        return $ Switch e sb) <|>+    -- do-while loops+    (endSemi $ do+        tok KW_Do+        s <- stmt+        tok KW_While+        e <- parens exp+        return $ Do s e) <|>+    -- break+    (endSemi $ do+        tok KW_Break+        mi <- opt ident+        return $ Break mi) <|>+    -- continue+    (endSemi $ do+        tok KW_Continue+        mi <- opt ident+        return $ Continue mi) <|>+    -- return+    (endSemi $ do+        tok KW_Return+        me <- opt exp+        return $ Return me) <|>+    -- synchronized+    (do tok KW_Synchronized+        e <- parens exp+        b <- block+        return $ Synchronized e b) <|>+    -- throw+    (endSemi $ do+        tok KW_Throw+        e <- exp+        return $ Throw e) <|>+    -- try-catch, both with and without a finally clause+    (do tok KW_Try+        b <- block+        c <- list catch+        mf <- opt $ tok KW_Finally >> block+        -- TODO: here we should check that there exists at+        -- least one catch or finally clause+        return $ Try b c mf) <|>+    -- expressions as stmts+    ExpStmt <$> endSemi stmtExp++-- For loops++forInit :: P ForInit+forInit = (do+    (m,t,vds) <- localVarDecl+    return $ ForLocalVars m t vds) <|>+    (seplist1 stmtExp comma >>= return . ForInitExps)++forUp :: P [Exp]+forUp = seplist1 stmtExp comma++-- Switches++switchBlock :: P [SwitchBlock]+switchBlock = braces $ list switchStmt++switchStmt :: P SwitchBlock+switchStmt = do+    lbl <- switchLabel+    bss <- list blockStmt+    return $ SwitchBlock lbl bss++switchLabel :: P SwitchLabel+switchLabel = (tok KW_Default >> colon >> return Default) <|>+    (do tok KW_Case+        e <- exp+        colon+        return $ SwitchCase e)++-- Try-catch clauses++catch :: P Catch+catch = do+    tok KW_Catch+    fp <- parens formalParam+    b  <- block+    return $ Catch fp b++----------------------------------------------------------------------------+-- Expressions++stmtExp :: P Exp+stmtExp = try preIncDec+    <|> try postIncDec+    <|> try assignment+    -- There are sharing gains to be made by unifying these two+    <|> try instanceCreation+    <|> methodInvocationExp++preIncDec :: P Exp+preIncDec = do+    op <- preIncDecOp+    e <- unaryExp+    return $ op e++postIncDec :: P Exp+postIncDec = do+    e <- postfixExpNES+    ops <- list1 postfixOp+    return $ foldl (\a s -> s a) e ops++assignment :: P Exp+assignment = do+    lh <- lhs+    op <- assignOp+    e  <- assignExp+    return $ Assign lh op e++lhs :: P Lhs+lhs = try (FieldLhs <$> fieldAccess)+    <|> try (ArrayLhs <$> arrayAccess)+    <|> NameLhs <$> name++++exp :: P Exp+exp = assignExp++assignExp :: P Exp+assignExp = try assignment <|> condExp++condExp :: P Exp+condExp = do+    ie <- infixExp+    ces <- list condExpSuffix+    return $ foldl (\a s -> s a) ie ces++condExpSuffix :: P (Exp -> Exp)+condExpSuffix = do+    tok Op_Query+    th <- exp+    colon+    el <- condExp+    return $ \ce -> Cond ce th el++infixExp :: P Exp+infixExp = do+    ue <- unaryExp+    ies <- list infixExpSuffix+    return $ foldl (\a s -> s a) ue ies++infixExpSuffix :: P (Exp -> Exp)+infixExpSuffix =+    (do op <- infixOp+        e2 <- unaryExp+        return $ \e1 -> BinOp e1 op e2) <|>+    (do tok KW_Instanceof+        t  <- refType+        return $ \e1 -> InstanceOf e1 t)++unaryExp :: P Exp+unaryExp = try preIncDec <|>+    try (do+        op <- prefixOp+        ue <- unaryExp+        return $ op ue) <|>+    try (do+        t <- parens ttype+        e <- unaryExp+        return $ Cast t e) <|>+    postfixExp++postfixExpNES :: P Exp+postfixExpNES = -- try postIncDec <|>+    try primary <|>+    ExpName <$> name++postfixExp :: P Exp+postfixExp = do+    pe <- postfixExpNES+    ops <- list postfixOp+    return $ foldl (\a s -> s a) pe ops+++primary :: P Exp+primary = primaryNPS |>> primarySuffix++primaryNPS :: P Exp+primaryNPS = try arrayCreation <|> primaryNoNewArrayNPS++primaryNoNewArray = startSuff primaryNoNewArrayNPS primarySuffix++primaryNoNewArrayNPS :: P Exp+primaryNoNewArrayNPS =+    Lit <$> literal <|>+    const This <$> tok KW_This <|>+    parens exp <|>+    -- TODO: These two following should probably be merged more+    (try $ do+        rt <- resultType+        period >> tok KW_Class+        return $ ClassLit rt) <|>+    (try $ do+        n <- name+        period >> tok KW_This+        return $ ThisClass n) <|>+    try instanceCreationNPS <|>+    try (MethodInv <$> methodInvocationNPS) <|>+    try (FieldAccess <$> fieldAccessNPS) <|>+    ArrayAccess <$> arrayAccessNPS++primarySuffix :: P (Exp -> Exp)+primarySuffix = try instanceCreationSuffix <|>+    try ((ArrayAccess .) <$> arrayAccessSuffix) <|>+    try ((MethodInv .) <$> methodInvocationSuffix) <|>+    (FieldAccess .) <$> fieldAccessSuffix+++instanceCreationNPS :: P Exp+instanceCreationNPS =+    do tok KW_New+       tas <- lopt typeArgs+       ct  <- classType+       as  <- args+       mcb <- opt classBody+       return $ InstanceCreation tas ct as mcb++instanceCreationSuffix :: P (Exp -> Exp)+instanceCreationSuffix =+     do period >> tok KW_New+        tas <- lopt typeArgs+        i   <- ident+        as  <- args+        mcb <- opt classBody+        return $ \p -> QualInstanceCreation p tas i as mcb++instanceCreation :: P Exp+instanceCreation = try instanceCreationNPS <|> do+    p <- primaryNPS+    ss <- list primarySuffix+    let icp = foldl (\a s -> s a) p ss+    case icp of+     QualInstanceCreation {} -> return icp+     _ -> fail ""++{-+instanceCreation =+    (do tok KW_New+        tas <- lopt typeArgs+        ct  <- classType+        as  <- args+        mcb <- opt classBody+        return $ InstanceCreation tas ct as mcb) <|>+    (do p   <- primary+        period >> tok KW_New+        tas <- lopt typeArgs+        i   <- ident+        as  <- args+        mcb <- opt classBody+        return $ QualInstanceCreation p tas i as mcb)+-}++fieldAccessNPS :: P FieldAccess+fieldAccessNPS =+    (do tok KW_Super >> period+        i <- ident+        return $ SuperFieldAccess i) <|>+    (do n <- name+        period >> tok KW_Super >> period+        i <- ident+        return $ ClassFieldAccess n i)++fieldAccessSuffix :: P (Exp -> FieldAccess)+fieldAccessSuffix = do+    period+    i <- ident+    return $ \p -> PrimaryFieldAccess p i++fieldAccess :: P FieldAccess+fieldAccess = try fieldAccessNPS <|> do+    p <- primaryNPS+    ss <- list primarySuffix+    let fap = foldl (\a s -> s a) p ss+    case fap of+     FieldAccess fa -> return fa+     _ -> fail ""++{-+fieldAccess :: P FieldAccess+fieldAccess = try fieldAccessNPS <|> do+    p <- primary+    fs <- fieldAccessSuffix+    return (fs p)+-}++{-+fieldAccess :: P FieldAccess+fieldAccess =+    (do tok KW_Super >> period+        i <- ident+        return $ SuperFieldAccess i) <|>+    (try $ do+        n <- name+        period >> tok KW_Super >> period+        i <- ident+        return $ ClassFieldAccess n i) <|>+    (do p <- primary+        period+        i <- ident+        return $ PrimaryFieldAccess p i)+-}++methodInvocationNPS :: P MethodInvocation+methodInvocationNPS =+    (do tok KW_Super >> period+        rts <- lopt refTypeArgs+        i   <- ident+        as  <- args+        return $ SuperMethodCall rts i as) <|>+    (do n <- name+        f <- (do as <- args+                 return $ \n -> MethodCall n as) <|>+             (period >> do+                msp <- opt (tok KW_Super >> period)+                rts <- lopt refTypeArgs+                i   <- ident+                as  <- args+                let mc = maybe TypeMethodCall (const ClassMethodCall) msp+                return $ \n -> mc n rts i as)+        return $ f n)++methodInvocationSuffix :: P (Exp -> MethodInvocation)+methodInvocationSuffix = do+        period+        rts <- lopt refTypeArgs+        i   <- ident+        as  <- args+        return $ \p -> PrimaryMethodCall p [] i as++methodInvocationExp :: P Exp+methodInvocationExp = try (MethodInv <$> methodInvocationNPS) <|> do+    p <- primaryNPS+    ss <- list primarySuffix+    let mip = foldl (\a s -> s a) p ss+    case mip of+     MethodInv _ -> return mip+     _ -> fail ""++{-+methodInvocation :: P MethodInvocation+methodInvocation =+    (do tok KW_Super >> period+        rts <- lopt refTypeArgs+        i   <- ident+        as  <- args+        return $ SuperMethodCall rts i as) <|>+    (do p <- primary+        period+        rts <- lopt refTypeArgs+        i   <- ident+        as  <- args+        return $ PrimaryMethodCall p rts i as) <|>+    (do n <- name+        f <- (do as <- args+                 return $ \n -> MethodCall n as) <|>+             (period >> do+                msp <- opt (tok KW_Super >> period)+                rts <- lopt refTypeArgs+                i   <- ident+                as  <- args+                let mc = maybe TypeMethodCall (const ClassMethodCall) msp+                return $ \n -> mc n rts i as)+        return $ f n)+-}++args :: P [Argument]+args = parens $ seplist exp comma++-- Arrays++arrayAccessNPS :: P ArrayIndex+arrayAccessNPS = do+    n <- name+    e <- brackets exp+    return $ ArrayIndex (ExpName n) e++arrayAccessSuffix :: P (Exp -> ArrayIndex)+arrayAccessSuffix = do+    e <- brackets exp+    return $ \ref -> ArrayIndex ref e++arrayAccess = try arrayAccessNPS <|> do+    p <- primaryNoNewArrayNPS+    ss <- list primarySuffix+    let aap = foldl (\a s -> s a) p ss+    case aap of+     ArrayAccess ain -> return ain+     _ -> fail ""++{-+arrayAccess :: P (Exp, Exp)+arrayAccess = do+    ref <- arrayRef+    e   <- brackets exp+    return (ref, e)++arrayRef :: P Exp+arrayRef = ExpName <$> name <|> primaryNoNewArray+-}++arrayCreation :: P Exp+arrayCreation = do+    tok KW_New+    t <- nonArrayType+    f <- (try $ do+             ds <- list1 $ brackets empty+             ai <- arrayInit+             return $ \t -> ArrayCreateInit t (length ds) ai) <|>+         (do des <- list1 $ brackets exp+             ds  <- list  $ brackets empty+             return $ \t -> ArrayCreate t des (length ds))+    return $ f t++literal :: P Literal+literal =+    javaToken $ \t -> case t of+        IntTok     i -> Just (Int i)+        LongTok    l -> Just (Word l)+        DoubleTok  d -> Just (Double d)+        FloatTok   f -> Just (Float f)+        CharTok    c -> Just (Char c)+        StringTok  s -> Just (String s)+        BoolTok    b -> Just (Boolean b)+        NullTok      -> Just Null+        _ -> Nothing++-- Operators++preIncDecOp, prefixOp, postfixOp :: P (Exp -> Exp)+preIncDecOp =+    (tok Op_PPlus >> return PreIncrement) <|>+    (tok Op_MMinus >> return PreDecrement)+prefixOp =+    (tok Op_Bang  >> return PreNot      ) <|>+    (tok Op_Tilde >> return PreBitCompl ) <|>+    (tok Op_Plus  >> return PrePlus     ) <|>+    (tok Op_Minus >> return PreMinus    )+postfixOp =+    (tok Op_PPlus  >> return PostIncrement) <|>+    (tok Op_MMinus >> return PostDecrement)++assignOp :: P AssignOp+assignOp =+    (tok Op_Equal    >> return EqualA   ) <|>+    (tok Op_StarE    >> return MultA    ) <|>+    (tok Op_SlashE   >> return DivA     ) <|>+    (tok Op_PercentE >> return RemA     ) <|>+    (tok Op_PlusE    >> return AddA     ) <|>+    (tok Op_MinusE   >> return SubA     ) <|>+    (tok Op_LShiftE  >> return LShiftA  ) <|>+    (tok Op_RShiftE  >> return RShiftA  ) <|>+    (tok Op_RRShiftE >> return RRShiftA ) <|>+    (tok Op_AndE     >> return AndA     ) <|>+    (tok Op_CaretE   >> return XorA     ) <|>+    (tok Op_OrE      >> return OrA      )++infixOp :: P Op+infixOp =+    (tok Op_Star    >> return Mult      ) <|>+    (tok Op_Slash   >> return Div       ) <|>+    (tok Op_Percent >> return Rem       ) <|>+    (tok Op_Plus    >> return Add       ) <|>+    (tok Op_Minus   >> return Sub       ) <|>+    (tok Op_LShift  >> return LShift    ) <|>+    (tok Op_RShift  >> return RShift    ) <|>+    (tok Op_RRShift >> return RRShift   ) <|>+    (tok Op_LThan   >> return LThan     ) <|>+    (tok Op_GThan   >> return GThan     ) <|>+    (tok Op_LThanE  >> return LThanE    ) <|>+    (tok Op_GThanE  >> return GThanE    ) <|>+    (tok Op_Equals  >> return Equal     ) <|>+    (tok Op_BangE   >> return NotEq     ) <|>+    (tok Op_And     >> return And       ) <|>+    (tok Op_Caret   >> return Xor       ) <|>+    (tok Op_Or      >> return Or        ) <|>+    (tok Op_AAnd    >> return CAnd      ) <|>+    (tok Op_OOr     >> return COr       )+++----------------------------------------------------------------------------+-- Types++ttype :: P Type+ttype = try (RefType <$> refType) <|> PrimType <$> primType++primType :: P PrimType+primType =+    tok KW_Boolean >> return BooleanT  <|>+    tok KW_Byte    >> return ByteT     <|>+    tok KW_Short   >> return ShortT    <|>+    tok KW_Int     >> return IntT      <|>+    tok KW_Long    >> return LongT     <|>+    tok KW_Char    >> return CharT     <|>+    tok KW_Float   >> return FloatT    <|>+    tok KW_Double  >> return DoubleT++refType :: P RefType+refType =+    (do pt <- primType+        (_:bs) <- list1 arrBrackets+        return $ foldl (\f _ -> ArrayType . RefType . f)+                        (ArrayType . PrimType) bs pt) <|>+    (do ct <- classType+        bs <- list arrBrackets+        return $ foldl (\f _ -> ArrayType . RefType . f)+                            ClassRefType bs ct) <?> "refType"++nonArrayType :: P Type+nonArrayType = PrimType <$> primType <|>+    RefType <$> ClassRefType <$> classType++classType :: P ClassType+classType = ClassType <$> seplist1 classTypeSpec period++classTypeSpec :: P (Ident, [TypeArgument])+classTypeSpec = do+    i   <- ident+    tas <- lopt typeArgs+    return (i, tas)++resultType :: P (Maybe Type)+resultType = tok KW_Void >> return Nothing <|> Just <$> ttype <?> "resultType"++refTypeList :: P [RefType]+refTypeList = seplist1 refType comma++----------------------------------------------------------------------------+-- Type parameters and arguments++typeParams :: P [TypeParam]+typeParams = angles $ seplist1 typeParam comma++typeParam :: P TypeParam+typeParam = do+    i  <- ident+    bs <- lopt bounds+    return $ TypeParam i bs++bounds :: P [RefType]+bounds = tok KW_Extends >> seplist1 refType (tok Op_And)++typeArgs :: P [TypeArgument]+typeArgs = angles $ seplist1 typeArg comma++typeArg :: P TypeArgument+typeArg = tok Op_Query >> Wildcard <$> opt wildcardBound+    <|> ActualType <$> refType++wildcardBound :: P WildcardBound+wildcardBound = tok KW_Extends >> ExtendsBound <$> refType+    <|> tok KW_Super >> SuperBound <$> refType++refTypeArgs :: P [RefType]+refTypeArgs = angles refTypeList++----------------------------------------------------------------------------+-- Names++name :: P Name+name = Name <$> seplist1 ident period++ident :: P Ident+ident = javaToken $ \t -> case t of+    IdentTok s -> Just $ Ident s+    _ -> Nothing++------------------------------------------------------------++empty :: P ()+empty = return ()++opt :: P a -> P (Maybe a)+opt = optionMaybe++bopt :: P a -> P Bool+bopt p = opt p >>= \ma -> return $ isJust ma++lopt :: P [a] -> P [a]+lopt p = do mas <- opt p+            case mas of+             Nothing -> return []+             Just as -> return as++list :: P a -> P [a]+list = option [] . list1++list1 :: P a -> P [a]+list1 = many1++seplist :: P a -> P sep -> P [a]+--seplist = sepBy+seplist p sep = option [] $ seplist1 p sep++seplist1 :: P a -> P sep -> P [a]+--seplist1 = sepBy1+seplist1 p sep =+    p >>= \a ->+        try (do sep+                as <- seplist1 p sep+                return (a:as))+        <|> return [a]++startSuff, (|>>) :: P a -> P (a -> a) -> P a+startSuff start suffix = do+    x <- start+    ss <- list suffix+    return $ foldl (\a s -> s a) x ss++(|>>) = startSuff++------------------------------------------------------------++javaToken :: (Token -> Maybe a) -> P a+javaToken test = token showT posT testT+  where showT (L _ t) = show t+        posT  (L p _) = pos2sourcePos p+        testT (L _ t) = test t++tok, matchToken :: Token -> P ()+tok = matchToken+matchToken t = javaToken (\r -> if r == t then Just () else Nothing)++pos2sourcePos :: (Int, Int) -> SourcePos+pos2sourcePos (l,c) = newPos "" l c++type Mod a = [Modifier] -> a++parens, braces, brackets, angles :: P a -> P a+parens   = between (tok OpenParen)  (tok CloseParen)+braces   = between (tok OpenCurly)  (tok CloseCurly)+brackets = between (tok OpenSquare) (tok CloseSquare)+angles   = between (tok Op_LThan)   (tok Op_GThan)++endSemi :: P a -> P a+endSemi p = p >>= \a -> semiColon >> return a++comma, colon, semiColon, period :: P ()+comma     = tok Comma+colon     = tok Op_Colon+semiColon = tok SemiColon+period    = tok Period++------------------------------------------------------------++test = "public class Foo { }"+testFile file = do+  i <- readFile file+  let r = parseCompilationUnit i+  putStrLn$ either (("Parsing error:\n"++) . show) (show . pretty) r

@@ -1,484 +1,478 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}
-module Language.Java.Syntax where
-
-#ifdef __GLASGOW_HASKELL__
-#ifdef BASE4
-import Data.Data
-#define DERIVE deriving (Eq,Ord,Show,Typeable,Data)
-#else
-import Data.Generics (Data(..),Typeable(..))
-#define DERIVE deriving (Eq,Ord,Show)
-#endif
-#endif
-
------------------------------------------------------------------------
--- Packages
-
-
--- | A compilation unit is the top level syntactic goal symbol of a Java program.
-data CompilationUnit = CompilationUnit (Maybe PackageDecl) [ImportDecl] [TypeDecl]
-  DERIVE
-
-
--- | A package declaration appears within a compilation unit to indicate the package to which the compilation unit belongs.
-data PackageDecl = PackageDecl Name
-  DERIVE
-
--- | An import declaration allows a static member or a named type to be referred to by a single unqualified identifier. 
---   The first argument signals whether the declaration only imports static members.
---   The last argument signals whether the declaration brings all names in the named type or package, or only brings
---   a single name into scope.
-data ImportDecl
-    = ImportDecl Bool {- static? -} Name Bool {- .*? -}
-  DERIVE
-
-
------------------------------------------------------------------------
--- Declarations
-
--- | A type declaration declares a class type or an interface type.
-data TypeDecl
-    = ClassTypeDecl ClassDecl
-    | InterfaceTypeDecl InterfaceDecl
-  DERIVE
-
--- | A class declaration specifies a new named reference type.
-data ClassDecl
-    = ClassDecl [Modifier] Ident [TypeParam] (Maybe RefType) [RefType] ClassBody
-    | EnumDecl  [Modifier] Ident                             [RefType] EnumBody
-  DERIVE
-
--- | A class body may contain declarations of members of the class, that is, 
---   fields, classes, interfaces and methods. 
---   A class body may also contain instance initializers, static 
---   initializers, and declarations of constructors for the class.
-data ClassBody = ClassBody [Decl]
-  DERIVE
-
--- | The body of an enum type may contain enum constants.
-data EnumBody = EnumBody [EnumConstant] [Decl]
-  DERIVE
-
--- | An enum constant defines an instance of the enum type.
-data EnumConstant = EnumConstant Ident [Argument] (Maybe ClassBody)
-  DERIVE
-
--- | An interface declaration introduces a new reference type whose members 
---   are classes, interfaces, constants and abstract methods. This type has 
---   no implementation, but otherwise unrelated classes can implement it by 
---   providing implementations for its abstract methods.
-data InterfaceDecl
-    = InterfaceDecl [Modifier] Ident [TypeParam] [RefType] InterfaceBody
-  DERIVE
-
--- | The body of an interface may declare members of the interface.
-data InterfaceBody
-    = InterfaceBody [MemberDecl]
-  DERIVE
-
--- | A declaration is either a member declaration, or a declaration of an
---   initializer, which may be static.
-data Decl
-    = MemberDecl MemberDecl
-    | InitDecl Bool Block
-  DERIVE
-
-
--- | A class or interface member can be an inner class or interface, a field or
---   constant, or a method or constructor. An interface may only have as members
---   constants (not fields), abstract methods, and no constructors.
-data MemberDecl
-    -- | The variables of a class type are introduced by field declarations.
-    = FieldDecl [Modifier] Type [VarDecl]
-    -- | A method declares executable code that can be invoked, passing a fixed number of values as arguments.
-    | MethodDecl      [Modifier] [TypeParam] (Maybe Type) Ident [FormalParam] [ExceptionType] MethodBody
-    -- | A constructor is used in the creation of an object that is an instance of a class.
-    | ConstructorDecl [Modifier] [TypeParam]              Ident [FormalParam] [ExceptionType] ConstructorBody
-    -- | A member class is a class whose declaration is directly enclosed in another class or interface declaration.
-    | MemberClassDecl ClassDecl
-    -- | A member interface is an interface whose declaration is directly enclosed in another class or interface declaration.
-    | MemberInterfaceDecl InterfaceDecl
-  DERIVE
-
-
--- | A declaration of a variable, which may be explicitly initialized.
-data VarDecl
-    = VarDecl VarDeclId (Maybe VarInit)
-  DERIVE
-
--- | The name of a variable in a declaration, which may be an array.
-data VarDeclId
-    = VarId Ident
-    | VarDeclArray VarDeclId        
-    -- ^ Multi-dimensional arrays are represented by nested applications of 'VarDeclArray'.
-  DERIVE
-
--- | Explicit initializer for a variable declaration.
-data VarInit
-    = InitExp Exp
-    | InitArray ArrayInit
-  DERIVE
-
--- | A formal parameter in method declaration. The last parameter
---   for a given declaration may be marked as variable arity,
---   indicated by the boolean argument.
-data FormalParam = FormalParam [Modifier] Type Bool VarDeclId
-  DERIVE
-
--- | A method body is either a block of code that implements the method or simply a 
---   semicolon, indicating the lack of an implementation (modelled by 'Nothing').
-data MethodBody = MethodBody (Maybe Block)
-  DERIVE
-
--- | The first statement of a constructor body may be an explicit invocation of
---   another constructor of the same class or of the direct superclass.
-data ConstructorBody = ConstructorBody (Maybe ExplConstrInv) [BlockStmt]
-  DERIVE
-
--- | An explicit constructor invocation invokes another constructor of the 
---   same class, or a constructor of the direct superclass, which may
---   be qualified to explicitly specify the newly created object's immediately 
---   enclosing instance. 
-data ExplConstrInv
-    = ThisInvoke             [RefType] [Argument]
-    | SuperInvoke            [RefType] [Argument]
-    | PrimarySuperInvoke Exp [RefType] [Argument]
-  DERIVE
-
-
--- | A modifier specifying properties of a given declaration. In general only
---   a few of these modifiers are allowed for each declaration type, for instance
---   a member type declaration may only specify one of public, private or protected.
-data Modifier
-    = Public
-    | Private
-    | Protected
-    | Abstract
-    | Final
-    | Static
-    | StrictFP
-    | Transient
-    | Volatile
-    | Native
-    | Annotation Annotation
-  DERIVE
-
--- | Annotations have three different forms: no-parameter, single-parameter or key-value pairs
-data Annotation = NormalAnnotation        { annName :: Name -- Not type because not type generics not allowed
-                                          , annKV   :: [(Ident, ElementValue)] }
-                | SingleElementAnnotation { annName :: Name
-                                          , annValue:: ElementValue }
-                | MarkerAnnotation        { annName :: Name }
-  DERIVE
-
-desugarAnnotation (MarkerAnnotation n)          = (n, [])
-desugarAnnotation (SingleElementAnnotation n e) = (n, [(Ident "value", e)])
-desugarAnnotation (NormalAnnotation n kv)       = (n, kv)
-desugarAnnotation' = uncurry NormalAnnotation . desugarAnnotation
-
--- | Annotations may contain  annotations or (loosely) expressions
-data ElementValue = EVVal VarInit
-                  | EVAnn Annotation
-  DERIVE
-
------------------------------------------------------------------------
--- Statements
-
--- | A block is a sequence of statements, local class declarations 
---   and local variable declaration statements within braces.
-data Block = Block [BlockStmt]
-  DERIVE
-
-
-
--- | A block statement is either a normal statement, a local 
---   class declaration or a local variable declaration.
-data BlockStmt
-    = BlockStmt Stmt
-    | LocalClass ClassDecl
-    | LocalVars [Modifier] Type [VarDecl]
-  DERIVE
-
-
--- | A Java statement.
-data Stmt
-    -- | A statement can be a nested block.
-    = StmtBlock Block
-    -- | The @if-then@ statement allows conditional execution of a statement.
-    | IfThen Exp Stmt
-    -- | The @if-then-else@ statement allows conditional choice of two statements, executing one or the other but not both.
-    | IfThenElse Exp Stmt Stmt
-    -- | The @while@ statement executes an expression and a statement repeatedly until the value of the expression is false.
-    | While Exp Stmt
-    -- | The basic @for@ statement executes some initialization code, then executes an expression, a statement, and some 
-    --   update code repeatedly until the value of the expression is false.
-    | BasicFor (Maybe ForInit) (Maybe Exp) (Maybe [Exp]) Stmt
-    -- | The enhanced @for@ statement iterates over an array or a value of a class that implements the @iterator@ interface.
-    | EnhancedFor [Modifier] Type Ident Exp Stmt
-    -- | An empty statement does nothing.
-    | Empty
-    -- | Certain kinds of expressions may be used as statements by following them with semicolons:
-    --   assignments, pre- or post-inc- or decrementation, method invocation or class instance
-    --   creation expressions.
-    | ExpStmt Exp
-    -- | An assertion is a statement containing a boolean expression, where an error is reported if the expression 
-    --   evaluates to false.
-    | Assert Exp (Maybe Exp)
-    -- | The switch statement transfers control to one of several statements depending on the value of an expression.
-    | Switch Exp [SwitchBlock]
-    -- | The @do@ statement executes a statement and an expression repeatedly until the value of the expression is false.
-    | Do Stmt Exp
-    -- | A @break@ statement transfers control out of an enclosing statement.
-    | Break (Maybe Ident)
-    -- | A @continue@ statement may occur only in a while, do, or for statement. Control passes to the loop-continuation 
-    --   point of that statement.
-    | Continue (Maybe Ident)
-    -- A @return@ statement returns control to the invoker of a method or constructor.
-    | Return (Maybe Exp)
-    -- | A @synchronized@ statement acquires a mutual-exclusion lock on behalf of the executing thread, executes a block, 
-    --   then releases the lock. While the executing thread owns the lock, no other thread may acquire the lock.
-    | Synchronized Exp Block
-    -- | A @throw@ statement causes an exception to be thrown. 
-    | Throw Exp
-    -- | A try statement executes a block. If a value is thrown and the try statement has one or more catch clauses that 
-    --   can catch it, then control will be transferred to the first such catch clause. If the try statement has a finally 
-    --   clause, then another block of code is executed, no matter whether the try block completes normally or abruptly, 
-    --   and no matter whether a catch clause is first given control.
-    | Try Block [Catch] (Maybe {- finally -} Block)
-    -- | Statements may have label prefixes.
-    | Labeled Ident Stmt
-  DERIVE
-
--- | If a value is thrown and the try statement has one or more catch clauses that can catch it, then control will be 
---   transferred to the first such catch clause.
-data Catch = Catch FormalParam Block
-  DERIVE
-
--- | A block of code labelled with a @case@ or @default@ within a @switch@ statement.
-data SwitchBlock
-    = SwitchBlock SwitchLabel [BlockStmt]    
-  DERIVE
-
--- | A label within a @switch@ statement. 
-data SwitchLabel
-    -- | The expression contained in the @case@ must be a 'Lit' or an @enum@ constant.
-    = SwitchCase Exp
-    | Default
-  DERIVE
-
--- | Initialization code for a basic @for@ statement.
-data ForInit
-    = ForLocalVars [Modifier] Type [VarDecl]
-    | ForInitExps [Exp]
-  DERIVE
-
--- | An exception type has to be a class type or a type variable.
-type ExceptionType = RefType -- restricted to ClassType or TypeVariable
-
-
------------------------------------------------------------------------
--- Expressions
-
--- | Arguments to methods and constructors are expressions.
-type Argument = Exp
-
--- | A Java expression.
-data Exp
-    -- | A literal denotes a fixed, unchanging value.
-    = Lit Literal
-    -- | A class literal, which is an expression consisting of the name of a class, interface, array, 
-    --   or primitive type, or the pseudo-type void (modelled by 'Nothing'), followed by a `.' and the token class.
-    | ClassLit (Maybe Type)
-    -- | The keyword @this@ denotes a value that is a reference to the object for which the instance method
-    --   was invoked, or to the object being constructed.
-    | This
-    -- | Any lexically enclosing instance can be referred to by explicitly qualifying the keyword this.
-    | ThisClass Name
-    -- | A class instance creation expression is used to create new objects that are instances of classes.
-    -- | The first argument is a list of non-wildcard type arguments to a generic constructor.
-    --   What follows is the type to be instantiated, the list of arguments passed to the constructor, and
-    --   optionally a class body that makes the constructor result in an object of an /anonymous/ class.
-    | InstanceCreation [TypeArgument] ClassType [Argument] (Maybe ClassBody)
-    -- | A qualified class instance creation expression enables the creation of instances of inner member classes 
-    --   and their anonymous subclasses.
-    | QualInstanceCreation Exp [TypeArgument] Ident [Argument] (Maybe ClassBody)
-    -- | An array instance creation expression is used to create new arrays. The last argument denotes the number
-    --   of dimensions that have no explicit length given. These dimensions must be given last.
-    | ArrayCreate Type [Exp] Int
-    -- | An array instance creation expression may come with an explicit initializer. Such expressions may not
-    --   be given explicit lengths for any of its dimensions.
-    | ArrayCreateInit Type Int ArrayInit
-    -- | A field access expression.
-    | FieldAccess FieldAccess
-    -- | A method invocation expression.
-    | MethodInv MethodInvocation
-    -- | An array access expression refers to a variable that is a component of an array.
-    | ArrayAccess ArrayIndex
-{-    | ArrayAccess Exp Exp -- Should this be made into a datatype, for consistency and use with Lhs? -}
-    -- | An expression name, e.g. a variable.
-    | ExpName Name
-    -- | Post-incrementation expression, i.e. an expression followed by @++@.
-    | PostIncrement Exp
-    -- | Post-decrementation expression, i.e. an expression followed by @--@.
-    | PostDecrement Exp
-    -- | Pre-incrementation expression, i.e. an expression preceded by @++@.
-    | PreIncrement  Exp
-    -- | Pre-decrementation expression, i.e. an expression preceded by @--@.
-    | PreDecrement  Exp
-    -- | Unary plus, the promotion of the value of the expression to a primitive numeric type.
-    | PrePlus  Exp
-    -- | Unary minus, the promotion of the negation of the value of the expression to a primitive numeric type.
-    | PreMinus Exp
-    -- | Unary bitwise complementation: note that, in all cases, @~x@ equals @(-x)-1@.
-    | PreBitCompl Exp
-    -- | Logical complementation of boolean values.
-    | PreNot  Exp
-    -- | A cast expression converts, at run time, a value of one numeric type to a similar value of another 
-    --   numeric type; or confirms, at compile time, that the type of an expression is boolean; or checks, 
-    --   at run time, that a reference value refers to an object whose class is compatible with a specified 
-    --   reference type.
-    | Cast  Type Exp
-    -- | The application of a binary operator to two operand expressions.
-    | BinOp Exp Op Exp
-    -- | Testing whether the result of an expression is an instance of some reference type.
-    | InstanceOf Exp RefType
-    -- | The conditional operator @? :@ uses the boolean value of one expression to decide which of two other 
-    --   expressions should be evaluated.
-    | Cond Exp Exp Exp
-    -- | Assignment of the result of an expression to a variable.
-    | Assign Lhs AssignOp Exp
-  DERIVE
-
--- | A literal denotes a fixed, unchanging value.
-data Literal
-    = Int Integer
-    | Word Integer
-    | Float Double
-    | Double Double
-    | Boolean Bool
-    | Char Char
-    | String String
-    | Null
-  DERIVE
-
--- | A binary infix operator.
-data Op = Mult | Div | Rem | Add | Sub | LShift | RShift | RRShift
-        | LThan | GThan | LThanE | GThanE | Equal | NotEq
-        | And | Or | Xor | CAnd | COr
-  DERIVE
-
--- | An assignment operator.
-data AssignOp = EqualA | MultA | DivA | RemA | AddA | SubA
-              | LShiftA | RShiftA | RRShiftA | AndA | XorA | OrA
-  DERIVE
-
--- | The left-hand side of an assignment expression. This operand may be a named variable, such as a local 
---   variable or a field of the current object or class, or it may be a computed variable, as can result from 
---   a field access or an array access.
-data Lhs
-    = NameLhs Name          -- ^ Assign to a variable
-    | FieldLhs FieldAccess  -- ^ Assign through a field access
-    | ArrayLhs ArrayIndex   -- ^ Assign to an array
-  DERIVE
-
--- | Array access
-data ArrayIndex = ArrayIndex Exp Exp    -- ^ Index into an array
-  DERIVE
-
--- | A field access expression may access a field of an object or array, a reference to which is the value 
---   of either an expression or the special keyword super.
-data FieldAccess
-    = PrimaryFieldAccess Exp Ident      -- ^ Accessing a field of an object or array computed from an expression.
-    | SuperFieldAccess Ident            -- ^ Accessing a field of the superclass.
-    | ClassFieldAccess Name Ident       -- ^ Accessing a (static) field of a named class.
-  DERIVE
-
-
--- | A method invocation expression is used to invoke a class or instance method.
-data MethodInvocation
-    -- | Invoking a specific named method. 
-    = MethodCall Name [Argument]
-    -- | Invoking a method of a class computed from a primary expression, giving arguments for any generic type parameters.
-    | PrimaryMethodCall Exp [RefType] Ident [Argument]
-    -- | Invoking a method of the super class, giving arguments for any generic type parameters.
-    | SuperMethodCall [RefType] Ident [Argument]
-    -- | Invoking a method of the superclass of a named class, giving arguments for any generic type parameters.
-    | ClassMethodCall Name [RefType] Ident [Argument]
-    -- | Invoking a method of a named type, giving arguments for any generic type parameters.
-    | TypeMethodCall  Name [RefType] Ident [Argument]
-  DERIVE
-
--- | An array initializer may be specified in a declaration, or as part of an array creation expression, creating an 
---   array and providing some initial values
-data ArrayInit
-    = ArrayInit [VarInit]
-  DERIVE
-
-
------------------------------------------------------------------------
--- Types
-
-
--- | There are two kinds of types in the Java programming language: primitive types and reference types.
-data Type
-    = PrimType PrimType
-    | RefType RefType
-  DERIVE
-
--- | There are three kinds of reference types: class types, interface types, and array types. 
---   Reference types may be parameterized with type arguments.
---   Type variables cannot be syntactically distinguished from class type identifiers,
---   and are thus represented uniformly as single ident class types.
-data RefType
-    = ClassRefType ClassType
-    {- | TypeVariable Ident -}
-    | ArrayType Type
-  DERIVE
-
--- | A class or interface type consists of a type declaration specifier, 
---   optionally followed by type arguments (in which case it is a parameterized type).
-data ClassType
-    = ClassType [(Ident, [TypeArgument])]
-  DERIVE
-
--- | Type arguments may be either reference types or wildcards.
-data TypeArgument
-    = Wildcard (Maybe WildcardBound)
-    | ActualType RefType
-  DERIVE
-
--- | Wildcards may be given explicit bounds, either upper (@extends@) or lower (@super@) bounds.
-data WildcardBound
-    = ExtendsBound RefType
-    | SuperBound RefType
-  DERIVE
-
--- | A primitive type is predefined by the Java programming language and named by its reserved keyword.
-data PrimType
-    = BooleanT
-    | ByteT
-    | ShortT
-    | IntT
-    | LongT
-    | CharT
-    | FloatT
-    | DoubleT
-  DERIVE
-
-
--- | A class is generic if it declares one or more type variables. These type variables are known 
---   as the type parameters of the class.
-data TypeParam = TypeParam Ident [RefType]
-  DERIVE
-
-
------------------------------------------------------------------------
--- Names and identifiers
-
--- | A single identifier.
-data Ident = Ident String
-  DERIVE
-
--- | A name, i.e. a period-separated list of identifiers.
-data Name = Name [Ident]
-  DERIVE
+{-# LANGUAGE CPP, DeriveDataTypeable #-}+module Language.Java.Syntax where++import Data.Data++#define DERIVE deriving (Eq,Ord,Show,Typeable,Data)++-----------------------------------------------------------------------+-- Packages+++-- | A compilation unit is the top level syntactic goal symbol of a Java program.+data CompilationUnit = CompilationUnit (Maybe PackageDecl) [ImportDecl] [TypeDecl]+  DERIVE+++-- | A package declaration appears within a compilation unit to indicate the package to which the compilation unit belongs.+data PackageDecl = PackageDecl Name+  DERIVE++-- | An import declaration allows a static member or a named type to be referred to by a single unqualified identifier.+--   The first argument signals whether the declaration only imports static members.+--   The last argument signals whether the declaration brings all names in the named type or package, or only brings+--   a single name into scope.+data ImportDecl+    = ImportDecl Bool {- static? -} Name Bool {- .*? -}+  DERIVE+++-----------------------------------------------------------------------+-- Declarations++-- | A type declaration declares a class type or an interface type.+data TypeDecl+    = ClassTypeDecl ClassDecl+    | InterfaceTypeDecl InterfaceDecl+  DERIVE++-- | A class declaration specifies a new named reference type.+data ClassDecl+    = ClassDecl [Modifier] Ident [TypeParam] (Maybe RefType) [RefType] ClassBody+    | EnumDecl  [Modifier] Ident                             [RefType] EnumBody+  DERIVE++-- | A class body may contain declarations of members of the class, that is,+--   fields, classes, interfaces and methods.+--   A class body may also contain instance initializers, static+--   initializers, and declarations of constructors for the class.+data ClassBody = ClassBody [Decl]+  DERIVE++-- | The body of an enum type may contain enum constants.+data EnumBody = EnumBody [EnumConstant] [Decl]+  DERIVE++-- | An enum constant defines an instance of the enum type.+data EnumConstant = EnumConstant Ident [Argument] (Maybe ClassBody)+  DERIVE++-- | An interface declaration introduces a new reference type whose members+--   are classes, interfaces, constants and abstract methods. This type has+--   no implementation, but otherwise unrelated classes can implement it by+--   providing implementations for its abstract methods.+data InterfaceDecl+    = InterfaceDecl [Modifier] Ident [TypeParam] [RefType] InterfaceBody+  DERIVE++-- | The body of an interface may declare members of the interface.+data InterfaceBody+    = InterfaceBody [MemberDecl]+  DERIVE++-- | A declaration is either a member declaration, or a declaration of an+--   initializer, which may be static.+data Decl+    = MemberDecl MemberDecl+    | InitDecl Bool Block+  DERIVE+++-- | A class or interface member can be an inner class or interface, a field or+--   constant, or a method or constructor. An interface may only have as members+--   constants (not fields), abstract methods, and no constructors.+data MemberDecl+    -- | The variables of a class type are introduced by field declarations.+    = FieldDecl [Modifier] Type [VarDecl]+    -- | A method declares executable code that can be invoked, passing a fixed number of values as arguments.+    | MethodDecl      [Modifier] [TypeParam] (Maybe Type) Ident [FormalParam] [ExceptionType] MethodBody+    -- | A constructor is used in the creation of an object that is an instance of a class.+    | ConstructorDecl [Modifier] [TypeParam]              Ident [FormalParam] [ExceptionType] ConstructorBody+    -- | A member class is a class whose declaration is directly enclosed in another class or interface declaration.+    | MemberClassDecl ClassDecl+    -- | A member interface is an interface whose declaration is directly enclosed in another class or interface declaration.+    | MemberInterfaceDecl InterfaceDecl+  DERIVE+++-- | A declaration of a variable, which may be explicitly initialized.+data VarDecl+    = VarDecl VarDeclId (Maybe VarInit)+  DERIVE++-- | The name of a variable in a declaration, which may be an array.+data VarDeclId+    = VarId Ident+    | VarDeclArray VarDeclId+    -- ^ Multi-dimensional arrays are represented by nested applications of 'VarDeclArray'.+  DERIVE++-- | Explicit initializer for a variable declaration.+data VarInit+    = InitExp Exp+    | InitArray ArrayInit+  DERIVE++-- | A formal parameter in method declaration. The last parameter+--   for a given declaration may be marked as variable arity,+--   indicated by the boolean argument.+data FormalParam = FormalParam [Modifier] Type Bool VarDeclId+  DERIVE++-- | A method body is either a block of code that implements the method or simply a+--   semicolon, indicating the lack of an implementation (modelled by 'Nothing').+data MethodBody = MethodBody (Maybe Block)+  DERIVE++-- | The first statement of a constructor body may be an explicit invocation of+--   another constructor of the same class or of the direct superclass.+data ConstructorBody = ConstructorBody (Maybe ExplConstrInv) [BlockStmt]+  DERIVE++-- | An explicit constructor invocation invokes another constructor of the+--   same class, or a constructor of the direct superclass, which may+--   be qualified to explicitly specify the newly created object's immediately+--   enclosing instance.+data ExplConstrInv+    = ThisInvoke             [RefType] [Argument]+    | SuperInvoke            [RefType] [Argument]+    | PrimarySuperInvoke Exp [RefType] [Argument]+  DERIVE+++-- | A modifier specifying properties of a given declaration. In general only+--   a few of these modifiers are allowed for each declaration type, for instance+--   a member type declaration may only specify one of public, private or protected.+data Modifier+    = Public+    | Private+    | Protected+    | Abstract+    | Final+    | Static+    | StrictFP+    | Transient+    | Volatile+    | Native+    | Annotation Annotation+  DERIVE++-- | Annotations have three different forms: no-parameter, single-parameter or key-value pairs+data Annotation = NormalAnnotation        { annName :: Name -- Not type because not type generics not allowed+                                          , annKV   :: [(Ident, ElementValue)] }+                | SingleElementAnnotation { annName :: Name+                                          , annValue:: ElementValue }+                | MarkerAnnotation        { annName :: Name }+  DERIVE++desugarAnnotation (MarkerAnnotation n)          = (n, [])+desugarAnnotation (SingleElementAnnotation n e) = (n, [(Ident "value", e)])+desugarAnnotation (NormalAnnotation n kv)       = (n, kv)+desugarAnnotation' = uncurry NormalAnnotation . desugarAnnotation++-- | Annotations may contain  annotations or (loosely) expressions+data ElementValue = EVVal VarInit+                  | EVAnn Annotation+  DERIVE++-----------------------------------------------------------------------+-- Statements++-- | A block is a sequence of statements, local class declarations+--   and local variable declaration statements within braces.+data Block = Block [BlockStmt]+  DERIVE++++-- | A block statement is either a normal statement, a local+--   class declaration or a local variable declaration.+data BlockStmt+    = BlockStmt Stmt+    | LocalClass ClassDecl+    | LocalVars [Modifier] Type [VarDecl]+  DERIVE+++-- | A Java statement.+data Stmt+    -- | A statement can be a nested block.+    = StmtBlock Block+    -- | The @if-then@ statement allows conditional execution of a statement.+    | IfThen Exp Stmt+    -- | The @if-then-else@ statement allows conditional choice of two statements, executing one or the other but not both.+    | IfThenElse Exp Stmt Stmt+    -- | The @while@ statement executes an expression and a statement repeatedly until the value of the expression is false.+    | While Exp Stmt+    -- | The basic @for@ statement executes some initialization code, then executes an expression, a statement, and some+    --   update code repeatedly until the value of the expression is false.+    | BasicFor (Maybe ForInit) (Maybe Exp) (Maybe [Exp]) Stmt+    -- | The enhanced @for@ statement iterates over an array or a value of a class that implements the @iterator@ interface.+    | EnhancedFor [Modifier] Type Ident Exp Stmt+    -- | An empty statement does nothing.+    | Empty+    -- | Certain kinds of expressions may be used as statements by following them with semicolons:+    --   assignments, pre- or post-inc- or decrementation, method invocation or class instance+    --   creation expressions.+    | ExpStmt Exp+    -- | An assertion is a statement containing a boolean expression, where an error is reported if the expression+    --   evaluates to false.+    | Assert Exp (Maybe Exp)+    -- | The switch statement transfers control to one of several statements depending on the value of an expression.+    | Switch Exp [SwitchBlock]+    -- | The @do@ statement executes a statement and an expression repeatedly until the value of the expression is false.+    | Do Stmt Exp+    -- | A @break@ statement transfers control out of an enclosing statement.+    | Break (Maybe Ident)+    -- | A @continue@ statement may occur only in a while, do, or for statement. Control passes to the loop-continuation+    --   point of that statement.+    | Continue (Maybe Ident)+    -- A @return@ statement returns control to the invoker of a method or constructor.+    | Return (Maybe Exp)+    -- | A @synchronized@ statement acquires a mutual-exclusion lock on behalf of the executing thread, executes a block,+    --   then releases the lock. While the executing thread owns the lock, no other thread may acquire the lock.+    | Synchronized Exp Block+    -- | A @throw@ statement causes an exception to be thrown.+    | Throw Exp+    -- | A try statement executes a block. If a value is thrown and the try statement has one or more catch clauses that+    --   can catch it, then control will be transferred to the first such catch clause. If the try statement has a finally+    --   clause, then another block of code is executed, no matter whether the try block completes normally or abruptly,+    --   and no matter whether a catch clause is first given control.+    | Try Block [Catch] (Maybe {- finally -} Block)+    -- | Statements may have label prefixes.+    | Labeled Ident Stmt+  DERIVE++-- | If a value is thrown and the try statement has one or more catch clauses that can catch it, then control will be+--   transferred to the first such catch clause.+data Catch = Catch FormalParam Block+  DERIVE++-- | A block of code labelled with a @case@ or @default@ within a @switch@ statement.+data SwitchBlock+    = SwitchBlock SwitchLabel [BlockStmt]+  DERIVE++-- | A label within a @switch@ statement.+data SwitchLabel+    -- | The expression contained in the @case@ must be a 'Lit' or an @enum@ constant.+    = SwitchCase Exp+    | Default+  DERIVE++-- | Initialization code for a basic @for@ statement.+data ForInit+    = ForLocalVars [Modifier] Type [VarDecl]+    | ForInitExps [Exp]+  DERIVE++-- | An exception type has to be a class type or a type variable.+type ExceptionType = RefType -- restricted to ClassType or TypeVariable+++-----------------------------------------------------------------------+-- Expressions++-- | Arguments to methods and constructors are expressions.+type Argument = Exp++-- | A Java expression.+data Exp+    -- | A literal denotes a fixed, unchanging value.+    = Lit Literal+    -- | A class literal, which is an expression consisting of the name of a class, interface, array,+    --   or primitive type, or the pseudo-type void (modelled by 'Nothing'), followed by a `.' and the token class.+    | ClassLit (Maybe Type)+    -- | The keyword @this@ denotes a value that is a reference to the object for which the instance method+    --   was invoked, or to the object being constructed.+    | This+    -- | Any lexically enclosing instance can be referred to by explicitly qualifying the keyword this.+    | ThisClass Name+    -- | A class instance creation expression is used to create new objects that are instances of classes.+    -- | The first argument is a list of non-wildcard type arguments to a generic constructor.+    --   What follows is the type to be instantiated, the list of arguments passed to the constructor, and+    --   optionally a class body that makes the constructor result in an object of an /anonymous/ class.+    | InstanceCreation [TypeArgument] ClassType [Argument] (Maybe ClassBody)+    -- | A qualified class instance creation expression enables the creation of instances of inner member classes+    --   and their anonymous subclasses.+    | QualInstanceCreation Exp [TypeArgument] Ident [Argument] (Maybe ClassBody)+    -- | An array instance creation expression is used to create new arrays. The last argument denotes the number+    --   of dimensions that have no explicit length given. These dimensions must be given last.+    | ArrayCreate Type [Exp] Int+    -- | An array instance creation expression may come with an explicit initializer. Such expressions may not+    --   be given explicit lengths for any of its dimensions.+    | ArrayCreateInit Type Int ArrayInit+    -- | A field access expression.+    | FieldAccess FieldAccess+    -- | A method invocation expression.+    | MethodInv MethodInvocation+    -- | An array access expression refers to a variable that is a component of an array.+    | ArrayAccess ArrayIndex+{-    | ArrayAccess Exp Exp -- Should this be made into a datatype, for consistency and use with Lhs? -}+    -- | An expression name, e.g. a variable.+    | ExpName Name+    -- | Post-incrementation expression, i.e. an expression followed by @++@.+    | PostIncrement Exp+    -- | Post-decrementation expression, i.e. an expression followed by @--@.+    | PostDecrement Exp+    -- | Pre-incrementation expression, i.e. an expression preceded by @++@.+    | PreIncrement  Exp+    -- | Pre-decrementation expression, i.e. an expression preceded by @--@.+    | PreDecrement  Exp+    -- | Unary plus, the promotion of the value of the expression to a primitive numeric type.+    | PrePlus  Exp+    -- | Unary minus, the promotion of the negation of the value of the expression to a primitive numeric type.+    | PreMinus Exp+    -- | Unary bitwise complementation: note that, in all cases, @~x@ equals @(-x)-1@.+    | PreBitCompl Exp+    -- | Logical complementation of boolean values.+    | PreNot  Exp+    -- | A cast expression converts, at run time, a value of one numeric type to a similar value of another+    --   numeric type; or confirms, at compile time, that the type of an expression is boolean; or checks,+    --   at run time, that a reference value refers to an object whose class is compatible with a specified+    --   reference type.+    | Cast  Type Exp+    -- | The application of a binary operator to two operand expressions.+    | BinOp Exp Op Exp+    -- | Testing whether the result of an expression is an instance of some reference type.+    | InstanceOf Exp RefType+    -- | The conditional operator @? :@ uses the boolean value of one expression to decide which of two other+    --   expressions should be evaluated.+    | Cond Exp Exp Exp+    -- | Assignment of the result of an expression to a variable.+    | Assign Lhs AssignOp Exp+  DERIVE++-- | A literal denotes a fixed, unchanging value.+data Literal+    = Int Integer+    | Word Integer+    | Float Double+    | Double Double+    | Boolean Bool+    | Char Char+    | String String+    | Null+  DERIVE++-- | A binary infix operator.+data Op = Mult | Div | Rem | Add | Sub | LShift | RShift | RRShift+        | LThan | GThan | LThanE | GThanE | Equal | NotEq+        | And | Or | Xor | CAnd | COr+  DERIVE++-- | An assignment operator.+data AssignOp = EqualA | MultA | DivA | RemA | AddA | SubA+              | LShiftA | RShiftA | RRShiftA | AndA | XorA | OrA+  DERIVE++-- | The left-hand side of an assignment expression. This operand may be a named variable, such as a local+--   variable or a field of the current object or class, or it may be a computed variable, as can result from+--   a field access or an array access.+data Lhs+    = NameLhs Name          -- ^ Assign to a variable+    | FieldLhs FieldAccess  -- ^ Assign through a field access+    | ArrayLhs ArrayIndex   -- ^ Assign to an array+  DERIVE++-- | Array access+data ArrayIndex = ArrayIndex Exp Exp    -- ^ Index into an array+  DERIVE++-- | A field access expression may access a field of an object or array, a reference to which is the value+--   of either an expression or the special keyword super.+data FieldAccess+    = PrimaryFieldAccess Exp Ident      -- ^ Accessing a field of an object or array computed from an expression.+    | SuperFieldAccess Ident            -- ^ Accessing a field of the superclass.+    | ClassFieldAccess Name Ident       -- ^ Accessing a (static) field of a named class.+  DERIVE+++-- | A method invocation expression is used to invoke a class or instance method.+data MethodInvocation+    -- | Invoking a specific named method.+    = MethodCall Name [Argument]+    -- | Invoking a method of a class computed from a primary expression, giving arguments for any generic type parameters.+    | PrimaryMethodCall Exp [RefType] Ident [Argument]+    -- | Invoking a method of the super class, giving arguments for any generic type parameters.+    | SuperMethodCall [RefType] Ident [Argument]+    -- | Invoking a method of the superclass of a named class, giving arguments for any generic type parameters.+    | ClassMethodCall Name [RefType] Ident [Argument]+    -- | Invoking a method of a named type, giving arguments for any generic type parameters.+    | TypeMethodCall  Name [RefType] Ident [Argument]+  DERIVE++-- | An array initializer may be specified in a declaration, or as part of an array creation expression, creating an+--   array and providing some initial values+data ArrayInit+    = ArrayInit [VarInit]+  DERIVE+++-----------------------------------------------------------------------+-- Types+++-- | There are two kinds of types in the Java programming language: primitive types and reference types.+data Type+    = PrimType PrimType+    | RefType RefType+  DERIVE++-- | There are three kinds of reference types: class types, interface types, and array types.+--   Reference types may be parameterized with type arguments.+--   Type variables cannot be syntactically distinguished from class type identifiers,+--   and are thus represented uniformly as single ident class types.+data RefType+    = ClassRefType ClassType+    {- | TypeVariable Ident -}+    | ArrayType Type+  DERIVE++-- | A class or interface type consists of a type declaration specifier,+--   optionally followed by type arguments (in which case it is a parameterized type).+data ClassType+    = ClassType [(Ident, [TypeArgument])]+  DERIVE++-- | Type arguments may be either reference types or wildcards.+data TypeArgument+    = Wildcard (Maybe WildcardBound)+    | ActualType RefType+  DERIVE++-- | Wildcards may be given explicit bounds, either upper (@extends@) or lower (@super@) bounds.+data WildcardBound+    = ExtendsBound RefType+    | SuperBound RefType+  DERIVE++-- | A primitive type is predefined by the Java programming language and named by its reserved keyword.+data PrimType+    = BooleanT+    | ByteT+    | ShortT+    | IntT+    | LongT+    | CharT+    | FloatT+    | DoubleT+  DERIVE+++-- | A class is generic if it declares one or more type variables. These type variables are known+--   as the type parameters of the class.+data TypeParam = TypeParam Ident [RefType]+  DERIVE+++-----------------------------------------------------------------------+-- Names and identifiers++-- | A single identifier.+data Ident = Ident String+  DERIVE++-- | A name, i.e. a period-separated list of identifiers.+data Name = Name [Ident]+  DERIVE

@@ -1,5 +1,5 @@ Name:                   language-java-Version:                0.2.0+Version:                0.2.1 License:                BSD3 License-File:           LICENSE Author:                 Niklas Broberg@@ -24,17 +24,16 @@   type:                 git   location:             git://github.com/vincenthz/language-java -Flag base4- Library   Build-Tools:          alex >= 2.3-  Build-Depends:        array >= 0.1, pretty >= 1.0, cpphs >= 1.3, parsec >= 3.0-  if flag(base4)-    Build-depends:      base >= 4 && < 5-    cpp-options:        -DBASE4-  else-    Build-depends:      base >= 3 && < 4+  Build-Depends:        base >= 4 && < 5+                      , array >= 0.1+                      , pretty >= 1.0+                      , cpphs >= 1.3+                      , parsec >= 3.0 +  if impl(ghc < 7.6)+    Build-Depends:      syb    Exposed-modules:      Language.Java.Lexer,                         Language.Java.Syntax,