diff --git a/javahc.cabal b/javahc.cabal index 9966236..21a4919 100644 --- a/javahc.cabal +++ b/javahc.cabal @@ -22,15 +22,9 @@ library ClassTypeParameter JavaClass JavaClassAccess - JavaClassField - JavaClassFieldVisibility JavaClassModifier - JavaExpression JavaFile - JavaLanguage - JavaVariableInitializer Lib - LiteralExpression PrimitiveTypes Syntax other-modules: diff --git a/src/Annotation.hs b/src/Annotation.hs deleted file mode 100644 index 9156c39..0000000 --- a/src/Annotation.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Annotation (Annotation(..) ) -where - -import JavaExpression (JavaExpression) - -import Data.Map (Map) - -data Annotation = Normal String (Map String JavaExpression) diff --git a/src/ClassLiteral.hs b/src/ClassLiteral.hs deleted file mode 100644 index 998bc46..0000000 --- a/src/ClassLiteral.hs +++ /dev/null @@ -1,31 +0,0 @@ -module ClassLiteral (ClassLiteral(..), parseClassLiteral ) where - -import qualified Data.List as List -import Numeric.Natural (Natural) - -import PrimitiveTypes (PrimitiveType, primitiveType) -import JavaLanguage (m_reserved, m_lexeme, m_identifier) - -import Text.Parsec (choice, string', many, sepBy, char, manyTill, lookAhead) -import Text.Parsec.String (Parser) - -data ClassLiteral = Void - | Primitive PrimitiveType Natural -- type, array dimension - | Type String Natural -- type, array dimension - deriving Show - -parseClassLiteral :: Parser ClassLiteral -parseClassLiteral = choice - [ m_reserved "void" *> return Void - , primitiveType >>= parseArrayDims . Primitive - , typeName >>= parseArrayDims . Type - ] <* string' ".class" - -typeName :: Parser String -typeName = do - start <- m_identifier - paths <- manyTill (char '.' *> m_identifier) (choice [ lookAhead $ string' ".class" , lookAhead $ string' "[]" ]) - return . List.intercalate "." $ (start:paths) - -parseArrayDims :: (Natural -> ClassLiteral) -> Parser ClassLiteral -parseArrayDims f = m_lexeme $ many (string' "[]") >>= return . f . fromInteger . toInteger . List.length diff --git a/src/JavaClass.hs b/src/JavaClass.hs index 537c415..2ba3e7f 100644 --- a/src/JavaClass.hs +++ b/src/JavaClass.hs @@ -14,7 +14,5 @@ data JavaClass = JavaClass { name :: String , isAbstract :: Bool , typeParameters :: [ClassTypeParameter] , extends :: Maybe ClassType - , implements :: [ClassType] - , permits :: [String] } deriving Show diff --git a/src/JavaClassField.hs b/src/JavaClassField.hs deleted file mode 100644 index 37cc5d9..0000000 --- a/src/JavaClassField.hs +++ /dev/null @@ -1,28 +0,0 @@ -module JavaClassField (module JavaClassField) where - -import JavaClassFieldVisibility (JavaClassFieldVisibility) -import PrimitiveTypes (PrimitiveType) -import ClassTypeParameter (ClassType, ArrayType) -import JavaVariableInitializer (JavaVariableInitializer) - -import Data.Set (Set) - -data JavaClassField = JavaClassField { name :: String - , visiblity :: JavaClassFieldVisibility - , modifiers :: Set JavaClassFieldModifier - , type_ :: JavaClassFieldType - , initializer :: Maybe JavaVariableInitializer - } - deriving Show - -data JavaClassFieldModifier = Static - | Final - | Transient - | Volatile - deriving (Show, Ord, Eq) - -data JavaClassFieldType = PrimitiveFieldType PrimitiveType - | ClassFieldType ClassType - | VariableFieldType String - | ArrayFieldType ArrayType - deriving Show diff --git a/src/JavaClassFieldVisibility.hs b/src/JavaClassFieldVisibility.hs deleted file mode 100644 index f22162a..0000000 --- a/src/JavaClassFieldVisibility.hs +++ /dev/null @@ -1,4 +0,0 @@ -module JavaClassFieldVisibility (JavaClassFieldVisibility(..) ) where - -data JavaClassFieldVisibility = Public | Protected | Private | Package - deriving Show diff --git a/src/JavaLanguage.hs b/src/JavaLanguage.hs deleted file mode 100644 index 7dad1b2..0000000 --- a/src/JavaLanguage.hs +++ /dev/null @@ -1,65 +0,0 @@ -module JavaLanguage -( javaLanguageDef -, m_paren -, m_identifier -, m_reserved -, m_lexeme -, m_symbol -, m_commaSep1 -, m_commaSep -, m_angles -, m_braces -, m_reservedOp -) where - -import Text.Parsec -import Text.Parsec.Language -import Text.Parsec.Token - -import Data.Functor.Identity - -javaLanguageDef :: GenLanguageDef String u Identity -javaLanguageDef = emptyDef{ commentStart = "/*" - , commentEnd = "*/" - , commentLine = "//" - , nestedComments = False - , identStart = letter <|> char '_' - , identLetter = alphaNum <|> char '_' - , opStart = oneOf ".+-*/;" - , opLetter = oneOf ".+-*/;" - , reservedOpNames = [";"] - , reservedNames = [ "true" - , "false" - , "package" - , "class" - , "interface" - , "void" - , "boolean" - , "char" - , "short" - , "int" - , "float" - , "long" - , "double" - , "instanceof" - , "public" - , "private" - , "protected" - , "static" - , "final" - , "volatile" - , "transient" - ] - , caseSensitive = True - } - -TokenParser{ parens = m_paren - , identifier = m_identifier - , reserved = m_reserved - , lexeme = m_lexeme - , symbol = m_symbol - , commaSep1 = m_commaSep1 - , commaSep = m_commaSep - , angles = m_angles - , braces = m_braces - , reservedOp = m_reservedOp } = makeTokenParser javaLanguageDef diff --git a/src/JavaVariableInitializer.hs b/src/JavaVariableInitializer.hs deleted file mode 100644 index 2e3ef15..0000000 --- a/src/JavaVariableInitializer.hs +++ /dev/null @@ -1,7 +0,0 @@ -module JavaVariableInitializer (JavaVariableInitializer(..) ) where - -import JavaExpression (JavaExpression) - -data JavaVariableInitializer = ArrayVariableInitializer [JavaVariableInitializer] - | ExpressionVariableInitializer JavaExpression - deriving Show diff --git a/src/LiteralExpression.hs b/src/LiteralExpression.hs deleted file mode 100644 index 8354078..0000000 --- a/src/LiteralExpression.hs +++ /dev/null @@ -1,140 +0,0 @@ -module LiteralExpression (LiteralExpression(..)) -where - -import Data.Ratio ((%)) -import Data.Int (Int16) -import qualified Data.Char as Char - -import JavaLanguage (m_lexeme, m_reserved) - -import Text.Parsec (many1, digit, oneOf, option, char, choice, many, try, satisfy, manyTill, string', endOfLine, space) -import Text.Parsec.String (Parser) - -data LiteralExpression = NullLiteral - | IntegerLiteral Integer IntegerLiteralType - | FloatingLiteral Rational DecimalLiteralType - | BooleanLiteral Bool - | CharacterLiteral Char - | StringLiteral String - | TextLiteral String - deriving Show - -data IntegerLiteralType = IntLiteral | LongLiteral - deriving Show -data DecimalLiteralType = DoubleLiteral | FloatLiteral - deriving Show - -signedInteger :: Parser Integer -signedInteger = do - signFactor <- option 1 (char '-' *> return (-1)) - digits <- many1 digit - return (signFactor * read digits) - -parseNullLiteral :: Parser LiteralExpression -parseNullLiteral = m_reserved "null" *> return NullLiteral - --- TODO: Hex, Oct, Bin -parseDecimalIntegerLiteral :: Parser LiteralExpression -parseDecimalIntegerLiteral = m_lexeme $ do - negative <- option False (char '-' *> return True) - digitString <- many1 digit - literalType <- option IntLiteral (oneOf "Ll" *> return LongLiteral) - let positiveNumber = read digitString :: Integer - let number = (if (negative) then negate else id) positiveNumber - return (IntegerLiteral number literalType) - --- TODO: Hex -parseDecimalFloatingLiteral :: Parser LiteralExpression -parseDecimalFloatingLiteral = do - prefix <- option "0" $ many1 digit - _ <- option '.' (char '.') - suffix <- many digit - exponent <- option 0 (char 'e' *> signedInteger) - literalType <- option FloatLiteral $ choice [ - oneOf "fF" *> return FloatLiteral - , oneOf "dD" *> return DoubleLiteral - ] - let suffixLength = length suffix - let prefixPower = 10 ^ suffixLength :: Integer - let iprefix = read prefix :: Integer - let isuffix = if (suffixLength == 0) then 0 else read suffix :: Integer - let exponentPower = (if exponent > 0 then 10 ^ exponent else 1) % (if exponent < 0 then 10^(-exponent) else 1) - let rational = ((iprefix * prefixPower + isuffix) % prefixPower) * exponentPower - return (FloatingLiteral rational literalType) - - -parseBooleanLiteral :: Parser LiteralExpression -parseBooleanLiteral = choice - [ m_reserved "true" *> return (BooleanLiteral True) - , m_reserved "false" *> return (BooleanLiteral False) - ] - -parseCharLiteral :: Parser LiteralExpression -parseCharLiteral = (char '\'' *> choice [ - parseEscapedChar - , satisfy (not . flip elem "'\\") - ] <* char '\'') >>= return . CharacterLiteral - --- TODO: Support double line terminator -parseEscapedChar :: Parser Char -parseEscapedChar = char '\\' *> choice [ - char 'b' *> return '\b' - , char 's' *> return ' ' - , char 't' *> return '\t' - , char 'n' *> return '\n' - , char 'f' *> return '\f' - , char 'r' *> return '\r' - , char '"' *> return '"' - , char '\'' *> return '\'' - , char '\\' *> return '\\' - , parseOctalEscapedChar - ] - -parseOctalEscapedChar :: Parser Char -parseOctalEscapedChar = choice [ - try $ tripleOctalEscapedChar - , try $ doubleOctalEscapedChar - , singleOctalEscapedChar - ] - -singleOctalEscapedChar :: Parser Char -singleOctalEscapedChar = do - char1 <- oneOf "01234567" - let num1 = read [char1] :: Int - return . Char.chr $ num1 - -doubleOctalEscapedChar :: Parser Char -doubleOctalEscapedChar = do - char1 <- oneOf "01234567" - char2 <- oneOf "01234567" - let num1 = read [char1] :: Int - let num2 = read [char2] :: Int - let num = num2 + num1 * 8 - return . Char.chr $ num - -tripleOctalEscapedChar :: Parser Char -tripleOctalEscapedChar = do - char1 <- oneOf "0123" - char2 <- oneOf "01234567" - char3 <- oneOf "01234567" - let num1 = read [char1] :: Int - let num2 = read [char2] :: Int - let num3 = read [char3] :: Int - let num = num3 + num2 * 8 + num1 * 64 - return . Char.chr $ num - -parseStringLiteral :: Parser LiteralExpression -parseStringLiteral = do - _ <- char '"' - content <- manyTill (choice - [ parseEscapedChar - , satisfy (not . flip elem "\r\n\"\\") - ]) (char '"') - return (StringLiteral content) - -parseTextLiteral :: Parser LiteralExpression -parseTextLiteral = do - _ <- string' "\"\"\"" - _ <- space `manyTill` endOfLine - content <- (choice [ parseEscapedChar , satisfy (not . flip elem "\\") ] ) `manyTill` (string' "\"\"\"") - return . TextLiteral $ content diff --git a/src/PrimaryExpression.hs b/src/PrimaryExpression.hs deleted file mode 100644 index 454060c..0000000 --- a/src/PrimaryExpression.hs +++ /dev/null @@ -1,26 +0,0 @@ -module PrimaryExpression (PrimaryExpression(..) ) where - -import qualified Data.List as List - -import ClassLiteral (ClassLiteral) -import JavaLanguage (m_identifier) -import LiteralExpression (LiteralExpression) - -import Text.Parsec (manyTill, char, string') -import Text.Parsec.String (Parser) - -data PrimaryExpression = Literal LiteralExpression - | ClassLiteral ClassLiteral - | This - | TypedThis String - | InstanceCreation - deriving Show - -parseThis :: Parser PrimaryExpression -parseThis = string' "this" *> return This - -parseTypedThis :: Parser PrimaryExpression -parseTypedThis = do - start <- m_identifier - paths <- manyTill (char '.' *> m_identifier) (string' ".this") - return . TypedThis . List.intercalate "." $ (start:paths) diff --git a/src/PrimitiveTypes.hs b/src/PrimitiveTypes.hs index 489074e..ab65277 100644 --- a/src/PrimitiveTypes.hs +++ b/src/PrimitiveTypes.hs @@ -1,25 +1,7 @@ -module PrimitiveTypes - ( PrimitiveType(..) - , primitiveType +module PrimitiveTypes ( + module PrimitiveTypes + , PrimitiveType ) where -import JavaLanguage (m_reserved) - -import Text.Parsec (choice) -import Text.Parsec.String (Parser) - data PrimitiveType = PrimitiveBoolean | PrimitiveByte | PrimitiveShort | PrimitiveInt | PrimitiveLong | PrimitiveChar | PrimitiveFloat | PrimitiveDouble deriving Show - -primitiveType :: Parser PrimitiveType -primitiveType = choice [ - m_reserved "boolean" *> return PrimitiveTypes.PrimitiveBoolean - , m_reserved "byte" *> return PrimitiveTypes.PrimitiveByte - , m_reserved "char" *> return PrimitiveTypes.PrimitiveChar - , m_reserved "short" *> return PrimitiveTypes.PrimitiveShort - , m_reserved "int" *> return PrimitiveTypes.PrimitiveInt - , m_reserved "float" *> return PrimitiveTypes.PrimitiveFloat - , m_reserved "long" *> return PrimitiveTypes.PrimitiveLong - , m_reserved "double" *> return PrimitiveTypes.PrimitiveDouble - ] - diff --git a/src/Syntax.hs b/src/Syntax.hs index 5507c3d..1210fe3 100644 --- a/src/Syntax.hs +++ b/src/Syntax.hs @@ -13,17 +13,58 @@ import qualified JavaClassAccess as JavaClassAccess import qualified JavaClassModifier as JavaClassModifier import qualified JavaFile as JavaFile import qualified ClassTypeParameter as ClassTypeParameter -import qualified JavaClassFieldVisibility as JavaClassFieldVisibility -import qualified JavaClassField as JavaClassField import PrimitiveTypes -import JavaLanguage +import Data.Functor.Identity import qualified Data.List as List import qualified Data.Maybe as Maybe -import qualified Data.Set as Set import Numeric.Natural +javaLanguageDef :: GenLanguageDef String u Identity +javaLanguageDef = emptyDef{ commentStart = "/*" + , commentEnd = "*/" + , commentLine = "//" + , nestedComments = False + , identStart = letter <|> char '_' + , identLetter = alphaNum <|> char '_' + , opStart = oneOf ".+-*/;" + , opLetter = oneOf ".+-*/;" + , reservedOpNames = [";"] + , reservedNames = [ "true" + , "false" + , "package" + , "class" + , "interface" + , "void" + , "boolean" + , "char" + , "short" + , "int" + , "float" + , "long" + , "double" + , "instanceof" + , "public" + , "private" + , "protected" + , "static" + , "final" + , "volatile" + , "transient" + ] + , caseSensitive = True + } + +TokenParser{ parens = m_paren + , identifier = m_identifier + , reserved = m_reserved + , lexeme = m_lexeme + , symbol = m_symbol + , commaSep1 = m_commaSep1 + , angles = m_angles + , reservedOp = m_reservedOp } = makeTokenParser javaLanguageDef + javaPathParser = m_identifier `sepBy1` (string ".") semicolon = (m_lexeme . char $ ';') "semicolon" @@ -87,9 +128,20 @@ arrayType = do , classType >>= return . ClassTypeParameter.ClassArrayType , typeIdentifier >>= return . ClassTypeParameter.VariableArrayType ] - arrayDepth <- m_lexeme $ (many1 $ string "[]") >>= return . List.length + arrayDepth <- (many1 $ string "[]") >>= return . List.length return (partialConstructor (fromInteger . toInteger $ arrayDepth)) +primitiveType = choice [ + m_reserved "boolean" *> return PrimitiveTypes.PrimitiveBoolean + , m_reserved "byte" *> return PrimitiveTypes.PrimitiveByte + , m_reserved "char" *> return PrimitiveTypes.PrimitiveChar + , m_reserved "short" *> return PrimitiveTypes.PrimitiveShort + , m_reserved "int" *> return PrimitiveTypes.PrimitiveInt + , m_reserved "float" *> return PrimitiveTypes.PrimitiveFloat + , m_reserved "long" *> return PrimitiveTypes.PrimitiveLong + , m_reserved "double" *> return PrimitiveTypes.PrimitiveDouble + ] + qualifiedClassType = do qualifiedType <- typeIdentifier `sepBy1` (string' ".") >>= return . List.intercalate "." maybeTypeArguments <- optionMaybe $ m_angles (m_commaSep1 typeArgument) @@ -102,13 +154,12 @@ unqualifiedClassType = do let typeArguments = Maybe.fromMaybe [] maybeTypeArguments return (ClassTypeParameter.NonRecursiveTypeBound unqualifiedType typeArguments) --- TODO: Review this, i cancelled the left-recursive rule recursiveClassType = do + classType_ <- classType + _ <- char '.' unqualifiedType <- typeIdentifier maybeTypeArguments <- optionMaybe $ m_angles (m_commaSep1 typeArgument) let typeArguments = Maybe.fromMaybe [] maybeTypeArguments - _ <- char '.' - classType_ <- classType return (ClassTypeParameter.RecursiveTypeBound classType_ unqualifiedType typeArguments) classType = choice [ qualifiedClassType @@ -118,14 +169,13 @@ classType = choice [ qualifiedClassType classTypeParameterClassOrInterfaceBound = do classType_ <- classType - interfaces <- m_commaSep interfaceType + interfaces <- m_commaSep1 interfaceType return (ClassTypeParameter.ClassTypeBound classType_ interfaces) classTypeParameterBound = do _ <- m_reserved' "extends" - bound <- choice [ - try classTypeParameterClassOrInterfaceBound - , typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound + bound <- choice [ typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound + , classTypeParameterClassOrInterfaceBound ] return bound @@ -135,86 +185,17 @@ classTypeParameter = do -- TODO: Interfaces return (ClassTypeParameter.ClassTypeParameter name typeBound []) -classTypeParameters = optionMaybe $ m_angles $ ((classTypeParameter "class type parameter") `sepBy1` (m_symbol ",")) +classTypeParameters = optionMaybe $ m_angles $ (classTypeParameter `sepBy1` (m_symbol ",")) -classPermits = do - _ <- m_reserved "permits" - m_commaSep typeName - -typeName = choice [ - qualifiedTypeIdentifier - , typeIdentifier - ] - -qualifiedTypeIdentifier = do - packagePath <- many (try $ m_identifier <* char '.') - typeName_ <- typeIdentifier - return . List.intercalate "." $ packagePath ++ [typeName_] - ---classBody = many $ choice [ --- classMemberDeclaration --- , classInstanceInitializer --- , classStaticInitializer --- , classConstructorDeclaration --- ] --- ---classMemberDeclaration = choice [ - -- classFieldDeclaration - -- , classMethodDeclaration - -- , classClassDeclaration - -- , classInterfaceDeclaration - -- ] - -- - --- TODO: Support multiple declarations -classFieldDeclaration = do - visibility <- optionMaybe classFieldVisibility >>= return . Maybe.fromMaybe JavaClassFieldVisibility.Package - modifiers <- many $ classFieldModifier - fieldType <- classFieldType - let modifierSet = Set.fromList modifiers - -- TODO: throw errors for duplicates - -- TODO: Support declarator lists - fieldName <- m_identifier - -- maybeInitializer <- optionMaybe $ m_reservedOp "=" *> variableInitializer - return $ JavaClassField.JavaClassField fieldName visibility modifierSet fieldType - ---variableInitializer = choice --- [ - -classFieldType = choice - [ arrayType >>= return . JavaClassField.ArrayFieldType - , primitiveType >>= return . JavaClassField.PrimitiveFieldType - , classType >>= return . JavaClassField.ClassFieldType - , typeIdentifier >>= return . JavaClassField.VariableFieldType - ] - -classFieldModifier = choice [ - m_reserved "final" *> return JavaClassField.Final - , m_reserved "static" *> return JavaClassField.Static - , m_reserved "volatile" *> return JavaClassField.Volatile - , m_reserved "transient" *> return JavaClassField.Transient - ] - -classFieldVisibility = choice [ - m_reserved "public" *> return JavaClassFieldVisibility.Public - , m_reserved "private" *> return JavaClassFieldVisibility.Private - , m_reserved "protected" *> return JavaClassFieldVisibility.Protected - ] - -fileLevelClass = do - accessModifier <- fileLevelClassAccess - _ <- m_reserved' "class" - className <- m_identifier "class name" - maybeModifier <- fileLevelClassModifier +fileLevelClass= do + accessModifier <- fileLevelClassAccess + _ <- m_reserved' "class" + className <- m_identifier "class name" + let isStatic = False + maybeModifier <- fileLevelClassModifier maybeTypeParameters <- classTypeParameters - maybeExtends <- optionMaybe (m_reserved "extends" *> classType) - maybeImplements <- optionMaybe (m_reserved "implements" *> m_commaSep interfaceType) - permits <- optionMaybe classPermits >>= return . Maybe.fromMaybe [] - --body <- m_braces classBody - let isStatic = False let typeParameters = Maybe.fromMaybe [] maybeTypeParameters - let implements = Maybe.fromMaybe [] maybeImplements - return (JavaClass.JavaClass className accessModifier maybeModifier isStatic typeParameters maybeExtends implements permits) + return (JavaClass.JavaClass className accessModifier maybeModifier isStatic typeParameters) fileLevelParser = do package <- packageParser