diff --git a/Language/Java/Parser.hs b/Language/Java/Parser.hs --- a/Language/Java/Parser.hs +++ b/Language/Java/Parser.hs @@ -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 diff --git a/Language/Java/Syntax.hs b/Language/Java/Syntax.hs --- a/Language/Java/Syntax.hs +++ b/Language/Java/Syntax.hs @@ -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 diff --git a/language-java.cabal b/language-java.cabal --- a/language-java.cabal +++ b/language-java.cabal @@ -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,