├── .gitignore ├── .haskell-ci ├── .travis.yml ├── LICENSE ├── Language └── Java │ ├── Lexer.x │ ├── OldGLRParser.ly │ ├── Parser.hs │ ├── Pretty.hs │ ├── Syntax.hs │ └── Syntax │ ├── Exp.hs │ └── Types.hs ├── README.markdown ├── Setup.hs ├── language-java.cabal ├── oldtest ├── LexerQCTest.hs ├── LexerTest.hs ├── Test.hs ├── TokenGen.hs ├── abstract.java ├── miscMath.java ├── miscMath2.java ├── miscMath3.java ├── miscMath3.txt ├── miscMath4.java ├── miscMath5.java ├── rawTypes.java ├── test.java └── typeVarMembers.java └── tests ├── Tests.hs └── java ├── bad ├── DiamondIncorrectPlacement.java ├── empty.java ├── lambdaWrong.java └── syntax.java └── good ├── DiamondTestExtended.java ├── Gauge.java ├── MultidimensionArrays.java ├── NestedTypeArg.java ├── TemplateMethods.java ├── TestArray.java ├── TestForLoop.java ├── TestMethodCall.java ├── VariousMultipleSemicolons.java ├── abstract.java ├── annotation.java ├── colon-after-class.java ├── diamond-operator.java ├── invoke-method-after-creating.java ├── issue_comment.java ├── lambdas.java ├── miscMath.java ├── miscMath2.java ├── miscMath3.java ├── miscMath4.java ├── miscMath5.java ├── nestedComment.java ├── rawTypes.java ├── test.java └── typeVarMembers.java /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | .stack-work/ 3 | *.class 4 | -------------------------------------------------------------------------------- /.haskell-ci: -------------------------------------------------------------------------------- 1 | # compiler supported and their equivalent LTS 2 | compiler: ghc-7.8 lts-2.22 3 | compiler: ghc-7.10 lts-6.35 4 | compiler: ghc-8.0 lts-9.21 5 | compiler: ghc-8.2 lts-10.4 6 | compiler: ghc-8.4 ghc-8.4-alpha2 7 | 8 | # options 9 | # option: alias x=y z=v 10 | 11 | # builds 12 | build: ghc-7.8 nohaddock 13 | build: ghc-8.2 14 | build: ghc-7.10 15 | build: ghc-8.0 16 | build: ghc-8.0 os=osx 17 | #build: ghc-8.4 18 | 19 | # packages 20 | package: '.' 21 | 22 | # extra builds 23 | hlint: allowed-failure 24 | weeder: allowed-failure 25 | coverall: false 26 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # ~*~ auto-generated by haskell-ci with config : 84802dcf9bd9a099e950c4f1bbc90b607c309a2a3944bd73f1430b41a3790e14 ~*~ 2 | 3 | # Use new container infrastructure to enable caching 4 | sudo: false 5 | 6 | # Caching so the next build will be fast too. 7 | cache: 8 | directories: 9 | - $HOME/.ghc 10 | - $HOME/.stack 11 | - $HOME/.local 12 | 13 | matrix: 14 | include: 15 | - { env: BUILD=stack RESOLVER=ghc-7.8, compiler: ghc-7.8, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 16 | - { env: BUILD=stack RESOLVER=ghc-8.2, compiler: ghc-8.2, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 17 | - { env: BUILD=stack RESOLVER=ghc-7.10, compiler: ghc-7.10, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 18 | - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 19 | - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } 20 | - { env: BUILD=hlint, compiler: hlint, language: generic } 21 | - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 22 | allow_failures: 23 | - { env: BUILD=hlint, compiler: hlint, language: generic } 24 | - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 25 | 26 | install: 27 | - export PATH=$HOME/.local/bin::$HOME/.cabal/bin:$PATH 28 | - mkdir -p ~/.local/bin 29 | - | 30 | case "$BUILD" in 31 | stack|weeder) 32 | if [ `uname` = "Darwin" ] 33 | then 34 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 35 | else 36 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 37 | fi 38 | ;; 39 | cabal) 40 | ;; 41 | esac 42 | 43 | script: 44 | - | 45 | set -ex 46 | if [ "x${RUNTEST}" = "xfalse" ]; then exit 0; fi 47 | case "$BUILD" in 48 | stack) 49 | # create the build stack.yaml 50 | case "$RESOLVER" in 51 | ghc-7.8) 52 | echo "{ resolver: lts-2.22, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml 53 | export HADDOCK_OPTs="--no-haddock" 54 | ;; 55 | ghc-8.2) 56 | echo "{ resolver: lts-10.4, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml 57 | export HADDOCK_OPTs="--haddock --no-haddock-deps" 58 | ;; 59 | ghc-7.10) 60 | echo "{ resolver: lts-6.35, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml 61 | export HADDOCK_OPTs="--haddock --no-haddock-deps" 62 | ;; 63 | ghc-8.0) 64 | echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml 65 | export HADDOCK_OPTs="--haddock --no-haddock-deps" 66 | ;; 67 | ghc-8.0) 68 | echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml 69 | export HADDOCK_OPTs="--haddock --no-haddock-deps" 70 | ;; 71 | esac 72 | # build & run test 73 | stack --no-terminal test --install-ghc --coverage --bench --no-run-benchmarks ${HADDOCK_OPTS} 74 | ;; 75 | hlint) 76 | curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s . --cpp-define=__GLASGOW_HASKELL__=800 --cpp-define=x86_64_HOST_ARCH=1 --cpp-define=mingw32_HOST_OS=1 77 | ;; 78 | weeder) 79 | stack --no-terminal build --install-ghc 80 | curl -sL https://raw.github.com/ndmitchell/weeder/master/misc/travis.sh | sh -s . 81 | ;; 82 | esac 83 | set +ex 84 | 85 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions 5 | are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the author nor the names of his contributors 15 | may be used to endorse or promote products derived from this software 16 | without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR 19 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 22 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 26 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 27 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 28 | POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /Language/Java/Lexer.x: -------------------------------------------------------------------------------- 1 | { 2 | {-# LANGUAGE BangPatterns #-} 3 | {-# OPTIONS_GHC -fno-warn-tabs -fno-warn-unused-binds #-} 4 | module Language.Java.Lexer (L(..), Token(..), lexer) where 5 | 6 | import Numeric 7 | import Data.Char 8 | } 9 | 10 | %wrapper "posn" 11 | 12 | $digit = [0-9] 13 | $nonzero = [1-9] 14 | $octdig = [0-7] 15 | $hexdig = [0-9A-Fa-f] 16 | 17 | @lineterm = [\n\r] | \r\n 18 | 19 | -- TODO: this doesn't notice a comment that ends "**/" 20 | @tradcomm = "/*" ( ~[\*] | \*+ (~[\/\*] | \n) | \n )* \*+ "/" 21 | @linecomm = "//" .* @lineterm 22 | @comm = @tradcomm | @linecomm 23 | 24 | $javaLetter = [a-zA-Z\_\$] 25 | $javaDigit = $digit 26 | $javaLetterOrDigit = [a-zA-Z0-9\_\$] 27 | 28 | @octEscape = [0123]? $octdig{1,2} 29 | @hexEscape = u $hexdig{4} 30 | @charEscape = \\ (@octEscape | @hexEscape | [btnfr\"\'\\]) 31 | 32 | @expsuffix = [\+\-]? $digit+ 33 | @exponent = [eE] @expsuffix 34 | @pexponent = [pP] @expsuffix 35 | 36 | tokens :- 37 | 38 | $white+ ; 39 | @comm ; 40 | 41 | "@interface" { \p _ -> L (pos p) $ KW_AnnInterface } 42 | abstract { \p _ -> L (pos p) $ KW_Abstract } 43 | assert { \p _ -> L (pos p) $ KW_Assert } 44 | boolean { \p _ -> L (pos p) $ KW_Boolean } 45 | break { \p _ -> L (pos p) $ KW_Break } 46 | byte { \p _ -> L (pos p) $ KW_Byte } 47 | case { \p _ -> L (pos p) $ KW_Case } 48 | catch { \p _ -> L (pos p) $ KW_Catch } 49 | char { \p _ -> L (pos p) $ KW_Char } 50 | class { \p _ -> L (pos p) $ KW_Class } 51 | const { \p _ -> L (pos p) $ KW_Const } 52 | continue { \p _ -> L (pos p) $ KW_Continue } 53 | default { \p _ -> L (pos p) $ KW_Default } 54 | do { \p _ -> L (pos p) $ KW_Do } 55 | double { \p _ -> L (pos p) $ KW_Double } 56 | else { \p _ -> L (pos p) $ KW_Else } 57 | enum { \p _ -> L (pos p) $ KW_Enum } 58 | extends { \p _ -> L (pos p) $ KW_Extends } 59 | final { \p _ -> L (pos p) $ KW_Final } 60 | finally { \p _ -> L (pos p) $ KW_Finally } 61 | float { \p _ -> L (pos p) $ KW_Float } 62 | for { \p _ -> L (pos p) $ KW_For } 63 | goto { \p _ -> L (pos p) $ KW_Goto } 64 | if { \p _ -> L (pos p) $ KW_If } 65 | implements { \p _ -> L (pos p) $ KW_Implements } 66 | import { \p _ -> L (pos p) $ KW_Import } 67 | instanceof { \p _ -> L (pos p) $ KW_Instanceof } 68 | int { \p _ -> L (pos p) $ KW_Int } 69 | interface { \p _ -> L (pos p) $ KW_Interface } 70 | long { \p _ -> L (pos p) $ KW_Long } 71 | native { \p _ -> L (pos p) $ KW_Native } 72 | new { \p _ -> L (pos p) $ KW_New } 73 | package { \p _ -> L (pos p) $ KW_Package } 74 | private { \p _ -> L (pos p) $ KW_Private } 75 | protected { \p _ -> L (pos p) $ KW_Protected } 76 | public { \p _ -> L (pos p) $ KW_Public } 77 | return { \p _ -> L (pos p) $ KW_Return } 78 | short { \p _ -> L (pos p) $ KW_Short } 79 | static { \p _ -> L (pos p) $ KW_Static } 80 | strictfp { \p _ -> L (pos p) $ KW_Strictfp } 81 | super { \p _ -> L (pos p) $ KW_Super } 82 | switch { \p _ -> L (pos p) $ KW_Switch } 83 | synchronized { \p _ -> L (pos p) $ KW_Synchronized } 84 | this { \p _ -> L (pos p) $ KW_This } 85 | throw { \p _ -> L (pos p) $ KW_Throw } 86 | throws { \p _ -> L (pos p) $ KW_Throws } 87 | transient { \p _ -> L (pos p) $ KW_Transient } 88 | try { \p _ -> L (pos p) $ KW_Try } 89 | void { \p _ -> L (pos p) $ KW_Void } 90 | volatile { \p _ -> L (pos p) $ KW_Volatile } 91 | while { \p _ -> L (pos p) $ KW_While } 92 | 93 | 0 { \p _ -> L (pos p) $ IntTok 0 } 94 | 0 [lL] { \p _ -> L (pos p) $ LongTok 0 } 95 | 0 $digit+ { \p s -> L (pos p) $ IntTok (pickyReadOct s) } 96 | 0 $digit+ [lL] { \p s -> L (pos p) $ LongTok (pickyReadOct (init s)) } 97 | $nonzero $digit* { \p s -> L (pos p) $ IntTok (read s) } 98 | $nonzero $digit* [lL] { \p s -> L (pos p) $ LongTok (read (init s)) } 99 | 0 [xX] $hexdig+ { \p s -> L (pos p) $ IntTok (fst . head $ readHex (drop 2 s)) } 100 | 0 [xX] $hexdig+ [lL] { \p s -> L (pos p) $ LongTok (fst . head $ readHex (init (drop 2 s))) } 101 | 102 | $digit+ \. $digit* @exponent? [dD]? { \p s -> L (pos p) $ DoubleTok (fst . head $ readFloat $ '0':s) } 103 | \. $digit+ @exponent? [dD]? { \p s -> L (pos p) $ DoubleTok (fst . head $ readFloat $ '0':s) } 104 | $digit+ \. $digit* @exponent? [fF] { \p s -> L (pos p) $ FloatTok (fst . head $ readFloat $ '0':s) } 105 | \. $digit+ @exponent? [fF] { \p s -> L (pos p) $ FloatTok (fst . head $ readFloat $ '0':s) } 106 | $digit+ @exponent { \p s -> L (pos p) $ DoubleTok (fst . head $ readFloat s) } 107 | $digit+ @exponent? [dD] { \p s -> L (pos p) $ DoubleTok (fst . head $ readFloat s) } 108 | $digit+ @exponent? [fF] { \p s -> L (pos p) $ FloatTok (fst . head $ readFloat s) } 109 | 0 [xX] $hexdig* \.? $hexdig* @pexponent [dD]? { \p s -> L (pos p) $ DoubleTok (readHexExp (drop 2 s)) } 110 | 0 [xX] $hexdig* \.? $hexdig* @pexponent [fF] { \p s -> L (pos p) $ FloatTok (readHexExp (drop 2 s)) } 111 | 112 | true { \p _ -> L (pos p) $ BoolTok True } 113 | false { \p _ -> L (pos p) $ BoolTok False } 114 | 115 | ' (@charEscape | ~[\\\']) ' { \p s -> L (pos p) $ CharTok (readCharTok s) } 116 | 117 | \" (@charEscape | ~[\\\"])* \" { \p s -> L (pos p) $ StringTok (readStringTok s) } 118 | 119 | null {\p _ -> L (pos p) $ NullTok } 120 | 121 | $javaLetter $javaLetterOrDigit* { \p s -> L (pos p) $ IdentTok s } 122 | 123 | \( { \p _ -> L (pos p) $ OpenParen } 124 | \) { \p _ -> L (pos p) $ CloseParen } 125 | \[ { \p _ -> L (pos p) $ OpenSquare } 126 | \] { \p _ -> L (pos p) $ CloseSquare } 127 | \{ { \p _ -> L (pos p) $ OpenCurly } 128 | \} { \p _ -> L (pos p) $ CloseCurly } 129 | \; { \p _ -> L (pos p) $ SemiColon } 130 | \, { \p _ -> L (pos p) $ Comma } 131 | \. { \p _ -> L (pos p) $ Period } 132 | "->" { \p _ -> L (pos p) $ LambdaArrow } 133 | "::" { \p _ -> L (pos p) $ MethodRefSep } 134 | 135 | "=" { \p _ -> L (pos p) $ Op_Equal } 136 | ">" { \p _ -> L (pos p) $ Op_GThan } 137 | "<" { \p _ -> L (pos p) $ Op_LThan } 138 | "!" { \p _ -> L (pos p) $ Op_Bang } 139 | "~" { \p _ -> L (pos p) $ Op_Tilde } 140 | "?" { \p _ -> L (pos p) $ Op_Query } 141 | ":" { \p _ -> L (pos p) $ Op_Colon } 142 | "==" { \p _ -> L (pos p) $ Op_Equals } 143 | "<=" { \p _ -> L (pos p) $ Op_LThanE } 144 | ">=" { \p _ -> L (pos p) $ Op_GThanE } 145 | "!=" { \p _ -> L (pos p) $ Op_BangE } 146 | "&&" { \p _ -> L (pos p) $ Op_AAnd } 147 | "||" { \p _ -> L (pos p) $ Op_OOr } 148 | "++" { \p _ -> L (pos p) $ Op_PPlus } 149 | "--" { \p _ -> L (pos p) $ Op_MMinus } 150 | "+" { \p _ -> L (pos p) $ Op_Plus } 151 | "-" { \p _ -> L (pos p) $ Op_Minus } 152 | "*" { \p _ -> L (pos p) $ Op_Star } 153 | "/" { \p _ -> L (pos p) $ Op_Slash } 154 | "&" { \p _ -> L (pos p) $ Op_And } 155 | "|" { \p _ -> L (pos p) $ Op_Or } 156 | "^" { \p _ -> L (pos p) $ Op_Caret } 157 | "%" { \p _ -> L (pos p) $ Op_Percent } 158 | "<<" { \p _ -> L (pos p) $ Op_LShift } 159 | "+=" { \p _ -> L (pos p) $ Op_PlusE } 160 | "-=" { \p _ -> L (pos p) $ Op_MinusE } 161 | "*=" { \p _ -> L (pos p) $ Op_StarE } 162 | "/=" { \p _ -> L (pos p) $ Op_SlashE } 163 | "&=" { \p _ -> L (pos p) $ Op_AndE } 164 | "|=" { \p _ -> L (pos p) $ Op_OrE } 165 | "^=" { \p _ -> L (pos p) $ Op_CaretE } 166 | "%=" { \p _ -> L (pos p) $ Op_PercentE } 167 | "<<=" { \p _ -> L (pos p) $ Op_LShiftE } 168 | ">>=" { \p _ -> L (pos p) $ Op_RShiftE } 169 | ">>>=" { \p _ -> L (pos p) $ Op_RRShiftE } 170 | "@" { \p _ -> L (pos p) $ Op_AtSign } 171 | 172 | 173 | { 174 | 175 | pickyReadOct :: String -> Integer 176 | pickyReadOct s = 177 | if not $ null remStr 178 | then lexicalError $ "Non-octal digit '" ++ take 1 remStr ++ "' in \"" ++ s ++ "\"." 179 | else n 180 | where (n,remStr) = head $ readOct s 181 | 182 | readHexExp :: (Floating a, Eq a) => String -> a 183 | readHexExp initial = 184 | let (m, suf) = head $ readHex initial 185 | (e, _) = case suf of 186 | p:s | toLower p == 'p' -> head $ readHex s 187 | _ -> (0, "") 188 | in m ** e 189 | 190 | readCharTok :: String -> Char 191 | readCharTok s = head . convChar . dropQuotes $ s 192 | readStringTok :: String -> String 193 | readStringTok = convChar . dropQuotes 194 | 195 | dropQuotes :: String -> String 196 | dropQuotes s = take (length s - 2) (tail s) 197 | 198 | -- Converts a sequence of (unquoted) Java character literals, including 199 | -- escapes, into the sequence of corresponding Chars. The calls to 200 | -- 'lexicalError' double-check that this function is consistent with 201 | -- the lexer rules for character and string literals. This function 202 | -- could be expressed as another Alex lexer, but it's simple enough 203 | -- to implement by hand. 204 | convChar :: String -> String 205 | convChar ('\\':'u':s@(d1:d2:d3:d4:s')) = 206 | -- TODO: this is the wrong place for handling unicode escapes 207 | -- according to the Java Language Specification. Unicode escapes can 208 | -- appear anywhere in the source text, and are best processed 209 | -- before lexing. 210 | if all isHexDigit [d1,d2,d3,d4] 211 | then toEnum (read ['0','x',d1,d2,d3,d4]):convChar s' 212 | else lexicalError $ "bad unicode escape \"\\u" ++ take 4 s ++ "\"" 213 | convChar ('\\':'u':s) = 214 | lexicalError $ "bad unicode escape \"\\u" ++ take 4 s ++ "\"" 215 | convChar ('\\':c:s) = 216 | if isOctDigit c 217 | then convOctal maxRemainingOctals 218 | else (case c of 219 | 'b' -> '\b' 220 | 'f' -> '\f' 221 | 'n' -> '\n' 222 | 'r' -> '\r' 223 | 't' -> '\t' 224 | '\'' -> '\'' 225 | '\\' -> '\\' 226 | '"' -> '"' 227 | _ -> badEscape):convChar s 228 | where maxRemainingOctals = 229 | if c <= '3' then 2 else 1 230 | convOctal n = 231 | let octals = takeWhile isOctDigit $ take n s 232 | noctals = length octals 233 | toChar = toEnum . fst . head . readOct 234 | in toChar (c:octals):convChar (drop noctals s) 235 | badEscape = lexicalError $ "bad escape \"\\" ++ c:"\"" 236 | convChar ("\\") = 237 | lexicalError "bad escape \"\\\"" 238 | convChar (x:s) = x:convChar s 239 | convChar "" = "" 240 | 241 | lexicalError :: String -> a 242 | lexicalError = error . ("lexical error: " ++) 243 | 244 | data L a = L Pos a 245 | deriving (Show, Eq) 246 | 247 | -- (line, column) 248 | type Pos = (Int, Int) 249 | 250 | pos :: AlexPosn -> Pos 251 | pos (AlexPn _ l c) = (l,c) 252 | 253 | data Token 254 | -- Keywords 255 | = KW_Abstract 256 | | KW_AnnInterface 257 | | KW_Assert 258 | | KW_Boolean 259 | | KW_Break 260 | | KW_Byte 261 | | KW_Case 262 | | KW_Catch 263 | | KW_Char 264 | | KW_Class 265 | | KW_Const 266 | | KW_Continue 267 | | KW_Default 268 | | KW_Do 269 | | KW_Double 270 | | KW_Else 271 | | KW_Enum 272 | | KW_Extends 273 | | KW_Final 274 | | KW_Finally 275 | | KW_Float 276 | | KW_For 277 | | KW_Goto 278 | | KW_If 279 | | KW_Implements 280 | | KW_Import 281 | | KW_Instanceof 282 | | KW_Int 283 | | KW_Interface 284 | | KW_Long 285 | | KW_Native 286 | | KW_New 287 | | KW_Package 288 | | KW_Private 289 | | KW_Protected 290 | | KW_Public 291 | | KW_Return 292 | | KW_Short 293 | | KW_Static 294 | | KW_Strictfp 295 | | KW_Super 296 | | KW_Switch 297 | | KW_Synchronized 298 | | KW_This 299 | | KW_Throw 300 | | KW_Throws 301 | | KW_Transient 302 | | KW_Try 303 | | KW_Void 304 | | KW_Volatile 305 | | KW_While 306 | 307 | -- Separators 308 | | OpenParen 309 | | CloseParen 310 | | OpenSquare 311 | | CloseSquare 312 | | OpenCurly 313 | | CloseCurly 314 | | SemiColon 315 | | Comma 316 | | Period 317 | | LambdaArrow 318 | | MethodRefSep 319 | 320 | -- Literals 321 | | IntTok Integer 322 | | LongTok Integer 323 | | DoubleTok Double 324 | | FloatTok Double 325 | | CharTok Char 326 | | StringTok String 327 | | BoolTok Bool 328 | | NullTok 329 | 330 | -- Identifiers 331 | | IdentTok String 332 | 333 | -- Operators 334 | | Op_Equal 335 | | Op_GThan 336 | | Op_LThan 337 | | Op_Bang 338 | | Op_Tilde 339 | | Op_Query 340 | | Op_Colon 341 | | Op_Equals 342 | | Op_LThanE 343 | | Op_GThanE 344 | | Op_BangE 345 | | Op_AAnd 346 | | Op_OOr 347 | | Op_PPlus 348 | | Op_MMinus 349 | | Op_Plus 350 | | Op_Minus 351 | | Op_Star 352 | | Op_Slash 353 | | Op_And 354 | | Op_Or 355 | | Op_Caret 356 | | Op_Percent 357 | | Op_LShift 358 | | Op_PlusE 359 | | Op_MinusE 360 | | Op_StarE 361 | | Op_SlashE 362 | | Op_AndE 363 | | Op_OrE 364 | | Op_CaretE 365 | | Op_PercentE 366 | | Op_LShiftE 367 | | Op_RShiftE 368 | | Op_RRShiftE 369 | | Op_AtSign 370 | deriving (Show, Eq) 371 | 372 | lexer :: String -> [L Token] 373 | lexer = alexScanTokens 374 | 375 | } 376 | -------------------------------------------------------------------------------- /Language/Java/OldGLRParser.ly: -------------------------------------------------------------------------------- 1 | > { 2 | > module Language.Java.Parser where 3 | > 4 | > import Language.Java.Lexer 5 | > import Language.Java.Syntax 6 | import Language.Java.ParseUtils 7 | > 8 | > import Data.Maybe (catMaybes) 9 | > } 10 | 11 | > %tokentype { Token } 12 | > %token 13 | > 'abstract' { KW_Abstract } 14 | > 'assert' { KW_Assert } 15 | > 'boolean' { KW_Boolean } 16 | > 'break' { KW_Break } 17 | > 'byte' { KW_Byte } 18 | > 'case' { KW_Case } 19 | > 'catch' { KW_Catch } 20 | > 'char' { KW_Char } 21 | > 'class' { KW_Class } 22 | > 'const' { KW_Const } 23 | > 'continue' { KW_Continue } 24 | > 'default' { KW_Default } 25 | > 'do' { KW_Do } 26 | > 'double' { KW_Double } 27 | > 'else' { KW_Else } 28 | > 'enum' { KW_Enum } 29 | > 'extends' { KW_Extends } 30 | > 'final' { KW_Final } 31 | > 'finally' { KW_Finally } 32 | > 'float' { KW_Float } 33 | > 'for' { KW_For } 34 | > 'goto' { KW_Goto } 35 | > 'if' { KW_If } 36 | > 'implements' { KW_Implements } 37 | > 'import' { KW_Import } 38 | > 'instanceof' { KW_Instanceof } 39 | > 'int' { KW_Int } 40 | > 'interface' { KW_Interface } 41 | > 'long' { KW_Long } 42 | > 'native' { KW_Native } 43 | > 'new' { KW_New } 44 | > 'package' { KW_Package } 45 | > 'private' { KW_Private } 46 | > 'protected' { KW_Protected } 47 | > 'public' { KW_Public } 48 | > 'return' { KW_Return } 49 | > 'short' { KW_Short } 50 | > 'static' { KW_Static } 51 | > 'strictfp' { KW_Strictfp } 52 | > 'super' { KW_Super } 53 | > 'switch' { KW_Switch } 54 | > 'synchronized' { KW_Synchronized } 55 | > 'this' { KW_This } 56 | > 'throw' { KW_Throw } 57 | > 'throws' { KW_Throws } 58 | > 'transient' { KW_Transient } 59 | > 'try' { KW_Try } 60 | > 'void' { KW_Void } 61 | > 'volatile' { KW_Volatile } 62 | > 'while' { KW_While } 63 | 64 | > '(' { OpenParen } 65 | > ')' { CloseParen } 66 | > '[' { OpenSquare } 67 | > ']' { CloseSquare } 68 | > '{' { OpenCurly } 69 | > '}' { CloseCurly } 70 | > ';' { SemiColon } 71 | > ',' { Comma } 72 | > '.' { Period } 73 | 74 | > INT { IntTok $$ } 75 | > LONG { LongTok $$ } 76 | > DOUBLE { DoubleTok $$ } 77 | > FLOAT { FloatTok $$ } 78 | > CHAR { CharTok $$ } 79 | > STRING { StringTok $$ } 80 | > BOOLEAN { BoolTok $$ } 81 | > NULL { NullTok } 82 | 83 | > IDENT { IdentTok $$ } 84 | 85 | > '=' { Op_Equal } 86 | > '>' { Op_GThan } 87 | > '<' { Op_LThan } 88 | > '!' { Op_Bang } 89 | > '~' { Op_Tilde } 90 | > '?' { Op_Query } 91 | > ':' { Op_Colon } 92 | > '==' { Op_Equals } 93 | > '<=' { Op_LThanE } 94 | > '>=' { Op_GThanE } 95 | > '!=' { Op_BangE } 96 | > '&&' { Op_AAnd } 97 | > '||' { Op_OOr } 98 | > '++' { Op_PPlus } 99 | > '--' { Op_MMinus } 100 | > '+' { Op_Plus } 101 | > '-' { Op_Minus } 102 | > '*' { Op_Star } 103 | > '/' { Op_Slash } 104 | > '&' { Op_And } 105 | > '|' { Op_Or } 106 | > '^' { Op_Caret } 107 | > '%' { Op_Percent } 108 | > '<<' { Op_LShift } 109 | > '>>' { Op_RShift } 110 | > '>>>' { Op_RRShift } 111 | > '+=' { Op_PlusE } 112 | > '-=' { Op_MinusE } 113 | > '*=' { Op_StarE } 114 | > '/=' { Op_SlashE } 115 | > '&=' { Op_AndE } 116 | > '|=' { Op_OrE } 117 | > '^=' { Op_CaretE } 118 | > '%=' { Op_PercentE } 119 | > '<<=' { Op_LShiftE } 120 | > '>>=' { Op_RShiftE } 121 | > '>>>=' { Op_RRShiftE } 122 | 123 | 124 | > %name mparse compilationUnit 125 | > %% 126 | 127 | ---------------------------------------------------------------------------- 128 | -- Packages and compilation units 129 | 130 | > compilationUnit :: { CompilationUnit } 131 | > : optPackageDecl listImportDecl listTypeDecl 132 | > { CompilationUnit $1 $2 (catMaybes $3) } 133 | 134 | > optPackageDecl :: { Maybe PackageDecl } 135 | > : packageDecl { Just $1 } 136 | > | { Nothing } 137 | 138 | > packageDecl :: { PackageDecl } 139 | > : 'package' name ';' { PackageDecl $2 } 140 | 141 | > listImportDecl :: { [ImportDecl] } 142 | > : importDecl listImportDecl { $1 : $2 } 143 | > | { [] } 144 | 145 | > importDecl :: { ImportDecl } 146 | > : 'import' boptStatic name boptDotStar ';' 147 | > { ImportDecl $2 $3 $4 } 148 | 149 | > boptStatic :: { Bool } 150 | > : 'static' { True } 151 | > | { False } 152 | 153 | > boptDotStar :: { Bool } 154 | > : dotStar { True } 155 | > | { False } 156 | 157 | > dotStar :: { () } 158 | > : '.' '*' { () } 159 | 160 | > listTypeDecl :: { [TypeDecl] } 161 | > : typeDecl listTypeDecl { $1 : $2 } 162 | > | { [] } 163 | 164 | > typeDecl :: { Maybe TypeDecl } 165 | > : classOrInterfaceDecl { Just $1 } 166 | > | ';' { Nothing } 167 | 168 | ---------------------------------------------------------------------------- 169 | -- Declarations 170 | 171 | -- Class declarations 172 | 173 | > classOrInterfaceDecl :: { TypeDecl } 174 | > : listModifier classDecl { ClassTypeDecl ($2 $1) } 175 | -- TODO: modifier = public private protected abstract static strictfp final 176 | > | listModifier interfaceDecl { InterfaceTypeDecl ($2 $1) } 177 | -- TODO: modifier = public private protected abstract static strictfp 178 | 179 | > classDecl :: { Mod ClassDecl } 180 | > : normalClassDecl { $1 } 181 | > | enumClassDecl { $1 } 182 | 183 | > normalClassDecl :: { Mod ClassDecl } 184 | > : 'class' ident loptTypeParams optExtends loptImplements classBody 185 | > { \ms -> ClassDecl ms $2 $3 ((fmap head) $4) $5 $6 } 186 | -- TODO: check that the extends clause only contains one type. 187 | 188 | > enumClassDecl :: { Mod ClassDecl } 189 | > : 'enum' ident loptImplements enumBody 190 | > { \ms -> EnumDecl ms $2 $3 $4 } 191 | 192 | > optExtends :: { Maybe [RefType] } 193 | > : extends { Just $1 } 194 | > | { Nothing } 195 | 196 | > loptExtends :: { [RefType] } 197 | > : optExtends { maybe [] id $1 } 198 | 199 | > extends :: { [RefType] } 200 | > : 'extends' refTypeList { $2 } 201 | 202 | > loptImplements :: { [RefType] } 203 | > : implements { $1 } 204 | > | { [] } 205 | 206 | > implements :: { [RefType] } 207 | > : 'implements' refTypeList { $2 } 208 | 209 | > optClassBody :: { Maybe ClassBody } 210 | > : classBody { Just $1 } 211 | > | { Nothing } 212 | 213 | > classBody :: { ClassBody } 214 | > : '{' classBodyDecls '}' { ClassBody $2 } 215 | 216 | > enumBody :: { EnumBody } 217 | > : '{' seplistEnumConstComma optComma loptEnumBodyDecls '}' 218 | > { EnumBody $2 $4 } 219 | 220 | > optComma :: { () } 221 | > : ',' { () } 222 | > | { () } 223 | 224 | > loptEnumBodyDecls :: { [Decl] } 225 | > : enumBodyDecls { $1 } 226 | > | { [] } 227 | 228 | > enumBodyDecls :: { [Decl] } 229 | > : ';' classBodyDecls { $2 } 230 | 231 | > seplistEnumConstComma :: { [EnumConstant] } 232 | > : seplist1EnumConstComma { $1 } 233 | > | { [] } 234 | 235 | > seplist1EnumConstComma :: { [EnumConstant] } 236 | > : enumConst ',' seplist1EnumConstComma { $1 : $3 } 237 | > | enumConst { [$1] } 238 | 239 | > enumConst :: { EnumConstant } 240 | > : ident loptArgs optClassBody 241 | > { EnumConstant $1 $2 $3 } 242 | 243 | > classBodyDecls :: { [Decl] } 244 | > : listClassBodyDecl { $1 } 245 | 246 | -- Interface declarations 247 | 248 | > interfaceDecl :: { Mod InterfaceDecl } 249 | > : 'interface' ident loptTypeParams loptExtends interfaceBody 250 | > { \ms -> InterfaceDecl ms $2 $3 $4 $5 } 251 | 252 | > interfaceBody :: { InterfaceBody } 253 | > : '{' listInterfaceBodyDecl '}' { InterfaceBody (catMaybes $2) } 254 | 255 | -- Declarations 256 | 257 | > listClassBodyDecl :: { [Decl] } 258 | > : classBodyDecl listClassBodyDecl { $1 : $2 } 259 | > | { [] } 260 | 261 | > classBodyDecl :: { Decl } 262 | > : listModifier memberDecl { MemberDecl ($2 $1) } 263 | -- TODO: Check that the modifiers on the memberDecl are valid 264 | > | boptStatic block { InitDecl $1 $2 } 265 | 266 | > memberDecl :: { Mod MemberDecl } 267 | > : fieldDecl { $1 } 268 | > | methodDecl { $1 } 269 | > | constrDecl { $1 } 270 | > | classDecl { MemberClassDecl . $1 } 271 | > | interfaceDecl { MemberInterfaceDecl . $1 } 272 | 273 | > fieldDecl :: { Mod MemberDecl } 274 | > : type varDecls { \ms -> FieldDecl ms $1 $2 } 275 | 276 | > methodDecl :: { Mod MemberDecl } 277 | > : loptTypeParams resultType ident formalParams loptThrows methodBody 278 | > { \ms -> MethodDecl ms $1 $2 $3 $4 $5 $6 } 279 | 280 | > methodBody :: { MethodBody } 281 | > : ';' { MethodBody Nothing } 282 | > | block { MethodBody (Just $1) } 283 | 284 | > constrDecl :: { Mod MemberDecl } 285 | > : loptTypeParams ident formalParams loptThrows constrBody 286 | > { \ms -> ConstructorDecl ms $1 $2 $3 $4 $5 } 287 | 288 | > constrBody :: { ConstructorBody } 289 | > : '{' optExplConstrInv listBlockStmt '}' 290 | > { ConstructorBody $2 $3 } 291 | 292 | > optExplConstrInv :: { Maybe ExplConstrInv } 293 | > : explConstrInv { Just $1 } 294 | > | { Nothing } 295 | 296 | > explConstrInv :: { ExplConstrInv } 297 | > : loptRefTypeArgs 'this' args ';' { ThisInvoke $1 $3 } 298 | > | loptRefTypeArgs 'super' args ';' { SuperInvoke $1 $3 } 299 | > | primary '.' loptRefTypeArgs 'super' args ';' { PrimarySuperInvoke $1 $3 $5 } 300 | 301 | > listInterfaceBodyDecl :: { [Maybe MemberDecl] } 302 | > : interfaceBodyDecl listInterfaceBodyDecl { $1 : $2 } 303 | > | { [] } 304 | 305 | -- TODO: This should be parsed like class bodies, and post-checked. 306 | -- That would give far better error messages. 307 | > interfaceBodyDecl :: { Maybe MemberDecl } 308 | > : listModifier interfaceMemberDecl { Just ($2 $1) } 309 | > | ';' { Nothing } 310 | 311 | > interfaceMemberDecl :: { Mod MemberDecl } 312 | > : fieldDecl { $1 } 313 | > | absMethodDecl { $1 } 314 | > | classDecl { MemberClassDecl . $1 } 315 | > | interfaceDecl { MemberInterfaceDecl . $1 } 316 | 317 | > absMethodDecl :: { Mod MemberDecl } 318 | > : loptTypeParams resultType ident formalParams loptThrows ';' 319 | > { \ms -> MethodDecl ms $1 $2 $3 $4 $5 (MethodBody Nothing) } 320 | 321 | > loptThrows :: { [RefType] } 322 | > : throws { $1 } 323 | > | { [] } 324 | 325 | > throws :: { [RefType] } 326 | > : 'throws' seplist1RefTypeComma { $2 } 327 | 328 | 329 | -- Formal parameters 330 | 331 | > formalParams :: { [FormalParam] } 332 | > : '(' formalParamsAux ')' { $2 } 333 | 334 | > formalParamsAux :: { [FormalParam] } 335 | > : {- empty -} { [] } 336 | > | lastFormalParam { [$1] } 337 | > | seplist1FormalParamComma ',' lastFormalParam { $1 ++ [$3] } 338 | 339 | > lastFormalParam :: { FormalParam } 340 | > : listModifier type optEllipsis varDeclId 341 | > { FormalParam $1 $2 $3 $4 } -- TODO: modifier = final 342 | 343 | > seplist1FormalParamComma :: { [FormalParam] } 344 | > : formalParam ',' seplist1FormalParamComma { $1 : $3 } 345 | > | formalParam { [$1] } 346 | 347 | > formalParam :: { FormalParam } 348 | > : listModifier type varDeclId 349 | > { FormalParam $1 $2 False $3 } -- TODO: modifier = final 350 | 351 | > optEllipsis :: { Bool } 352 | > : '.' '.' '.' { True } 353 | > | {- empty -} { False } 354 | 355 | 356 | -- Modifiers 357 | 358 | > listModifier :: { [Modifier] } 359 | > : modifier listModifier { $1 : $2 } 360 | > | { [] } 361 | 362 | > modifier :: { Modifier } 363 | > : 'public' { Public } 364 | > | 'protected' { Protected } 365 | > | 'private' { Private } 366 | > | 'abstract' { Abstract } 367 | > | 'static' { Static } 368 | > | 'strictfp' { StrictFP } 369 | > | 'final' { Final } 370 | > | 'native' { Native } 371 | > | 'transient' { Transient } 372 | > | 'volatile' { Volatile } 373 | 374 | ---------------------------------------------------------------------------- 375 | -- Variable declarations 376 | 377 | > varDecls :: { [VarDecl] } 378 | > : seplist1VarDeclComma { $1 } 379 | 380 | > seplist1VarDeclComma :: { [VarDecl] } 381 | > : varDecl ',' seplist1VarDeclComma { $1 : $3 } 382 | > | varDecl { [$1] } 383 | 384 | > varDecl :: { VarDecl } 385 | > : varDeclId optVarInit { VarDecl $1 $2 } 386 | 387 | > varDeclId :: { VarDeclId } 388 | > : ident listArrBrackets 389 | > { foldr (\_ f -> VarDeclArray . f) VarId $2 $1 } 390 | 391 | > listArrBrackets :: { [()] } 392 | > : arrBrackets listArrBrackets { $1 : $2 } 393 | > | { [] } 394 | 395 | > arrBrackets :: { () } 396 | > : '[' ']' { () } 397 | 398 | > localVarDecl :: { ([Modifier], Type, [VarDecl]) } 399 | > : listModifier type varDecls { ($1,$2,$3) } 400 | -- TODO: modifier = public protected private static final transient volatile 401 | 402 | > optVarInit :: { Maybe VarInit } 403 | > : varInit { Just $1 } 404 | > | { Nothing } 405 | 406 | > seplistVarInitComma :: { [VarInit] } 407 | > : seplist1VarInitComma { $1 } 408 | > | { [] } 409 | 410 | > seplist1VarInitComma :: { [VarInit] } 411 | > : varInit ',' seplist1VarInitComma { $1 : $3 } 412 | > | varInit { [$1] } 413 | 414 | > varInit :: { VarInit } 415 | > : '=' exp { InitExp $2 } 416 | > | '=' arrayInit { InitArray $2 } 417 | 418 | > arrayInit :: { ArrayInit } 419 | > : '{' seplistVarInitComma optComma '}' { ArrayInit $2 } 420 | 421 | ---------------------------------------------------------------------------- 422 | -- Statements 423 | 424 | > block :: { Block } 425 | > : '{' listBlockStmt '}' { Block $2 } 426 | 427 | > listBlockStmt :: { [BlockStmt] } 428 | > : blockStmt listBlockStmt { $1 : $2 } 429 | > | { [] } 430 | 431 | > blockStmt :: { BlockStmt } 432 | > : listModifier classDecl { LocalClass ($2 $1) } 433 | > | localVarDecl ';' { let (m,t,vds) = $1 in LocalVars m t vds } 434 | > | stmt { BlockStmt $1 } 435 | 436 | > stmt :: { Stmt } 437 | > : ident ':' stmt { Labeled $1 $3 } 438 | > | 'if' '(' exp ')' stmt { IfThen $3 $5 } 439 | > | 'if' '(' exp ')' stmtNSI 'else' stmt { IfThenElse $3 $5 $7 } 440 | > | 'while' '(' exp ')' stmt { While $3 $5 } 441 | > | 'for' '(' optForInit ';' optExp ';' optForUp ')' stmt 442 | > { BasicFor $3 $5 $7 $9 } 443 | > | 'for' '(' listModifier type ident ':' exp ')' stmt 444 | > { EnhancedFor $3 $4 $5 $7 $9 } 445 | > | stmtNoTrail { $1 } 446 | 447 | > stmtNoTrail :: { Stmt } 448 | > : block { StmtBlock $1 } 449 | > | ';' { Empty } 450 | > | stmtExp ';' { ExpStmt $1 } 451 | > | 'assert' exp optAssertExp2 ';' { Assert $2 $3 } 452 | > | 'switch' '(' exp ')' switchBlock { Switch $3 $5 } 453 | > | 'do' stmt 'while' '(' exp ')' ';' { Do $2 $5 } 454 | > | 'break' optIdent ';' { Break $2 } 455 | > | 'continue' optIdent ';' { Continue $2 } 456 | > | 'return' optExp ';' { Return $2 } 457 | > | 'synchronized' '(' exp ')' block { Synchronized $3 $5 } 458 | > | 'throw' exp ';' { Throw $2 } 459 | > | 'try' block catches { Try $2 $3 Nothing } 460 | > | 'try' block loptCatches 'finally' block { Try $2 $3 (Just $5) } 461 | 462 | > stmtNSI :: { Stmt } 463 | > : stmtNoTrail { $1 } 464 | > | ident ':' stmtNSI { Labeled $1 $3 } 465 | > | 'if' '(' exp ')' stmtNSI 'else' stmtNSI { IfThenElse $3 $5 $7 } 466 | > | 'while' '(' exp ')' stmtNSI { While $3 $5 } 467 | > | 'for' '(' optForInit ';' optExp ';' optForUp ')' stmtNSI 468 | > { BasicFor $3 $5 $7 $9 } 469 | > | 'for' '(' listModifier type ident ':' exp ')' stmtNSI 470 | > { EnhancedFor $3 $4 $5 $7 $9 } 471 | 472 | > optAssertExp2 :: { Maybe Exp } 473 | > : assertExp2 { Just $1 } 474 | > | { Nothing } 475 | 476 | > assertExp2 :: { Exp } 477 | > : ':' exp { $2 } 478 | 479 | -- Switches 480 | 481 | > switchBlock :: { [SwitchBlock] } 482 | > : '{' listSwitchStmt '}' { $2 } 483 | 484 | > listSwitchStmt :: { [SwitchBlock] } 485 | > : switchStmt listSwitchStmt { $1 : $2 } 486 | > | { [] } 487 | 488 | > switchStmt :: { SwitchBlock } 489 | > : switchLabel listBlockStmt { SwitchBlock $1 $2 } 490 | 491 | > switchLabel :: { SwitchLabel } 492 | > : 'case' exp ':' { SwitchCase $2 } 493 | > | 'default' ':' { Default } 494 | 495 | -- For loops 496 | 497 | > optForInit :: { Maybe ForInit } 498 | > : forInit { Just $1 } 499 | > | { Nothing } 500 | 501 | > forInit :: { ForInit } 502 | > : localVarDecl { let (m,t,vds) = $1 in ForLocalVars m t vds } 503 | > | seplist1StmtExpComma { ForInitExps $1 } 504 | 505 | > optForUp :: { Maybe [Exp] } 506 | > : forUp { Just $1 } 507 | > | { Nothing } 508 | 509 | > forUp :: { [Exp] } 510 | > : seplist1StmtExpComma { $1 } 511 | 512 | -- Try-catch clauses 513 | 514 | > loptCatches :: { [Catch] } 515 | > : catches { $1 } 516 | > | { [] } 517 | 518 | > catches :: { [Catch] } 519 | > : list1Catch { $1 } 520 | 521 | > list1Catch :: { [Catch] } 522 | > : catch listCatch { $1 : $2 } 523 | > | catch { [$1] } 524 | 525 | > catch :: { Catch } 526 | > : 'catch' '(' formalParam ')' block { Catch $3 $5 } 527 | 528 | ---------------------------------------------------------------------------- 529 | -- Expressions 530 | 531 | > seplist1StmtExpComma :: { [Exp] } 532 | > : stmtExp ',' seplist1StmtExpComma { $1 : $3 } 533 | > | stmtExp { [$1] } 534 | 535 | > stmtExp :: { Exp } 536 | > : postIncDec { $1 } 537 | > | preIncDec { $1 } 538 | > | assignment { $1 } 539 | > | methodInvocation { MethodInv $1 } 540 | > | instanceCreation { $1 } 541 | 542 | > postIncDec :: { Exp } 543 | > : postfixExp postfixOp { $2 $1 } 544 | 545 | > preIncDec :: { Exp } 546 | > : preIncDecOp unaryExp { $1 $2 } 547 | 548 | > assignment :: { Exp } 549 | > : lhs assignOp assignExp { Assign $1 $2 $3 } 550 | 551 | > lhs :: { Lhs } 552 | > : name { NameLhs $1 } 553 | > | fieldAccess { FieldLhs $1 } 554 | > | arrayAccess { ArrayLhs (fst $1) (snd $1) } 555 | 556 | > optExp :: { Maybe Exp } 557 | > : exp { Just $1 } 558 | > | { Nothing } 559 | 560 | > seplistExpComma :: { [Exp] } 561 | > : seplist1ExpComma { $1 } 562 | > | { [] } 563 | 564 | > seplist1ExpComma :: { [Exp] } 565 | > : exp ',' seplist1ExpComma { $1 : $3 } 566 | > | exp { [$1] } 567 | 568 | > exp :: { Exp } 569 | > : assignExp { $1 } 570 | 571 | > assignExp :: { Exp } 572 | > : assignment { $1 } 573 | > | condExp { $1 } 574 | 575 | > condExp :: { Exp } 576 | > : condExp '?' exp ':' condExp { Cond $1 $3 $5 } 577 | > | infixExp { $1 } 578 | 579 | -- TODO: Fix precedence 580 | > infixExp :: { Exp } 581 | > : infixExp infixOp unaryExp { BinOp $1 $2 $3 } 582 | > | infixExp 'instanceof' refType { InstanceOf $1 $3 } 583 | > | unaryExp { $1 } 584 | 585 | > unaryExp :: { Exp } 586 | > : preIncDec { $1 } 587 | > | prefixOp unaryExp { $1 $2 } 588 | > | '(' type ')' unaryExp { Cast $2 $4 } 589 | > | postfixExp { $1 } 590 | 591 | 592 | > postfixExp :: { Exp } 593 | > : primary { $1 } 594 | > | name { ExpName $1 } 595 | > | postIncDec { $1 } 596 | 597 | 598 | > primary :: { Exp } 599 | > : primaryNoNewArray { $1 } 600 | > | arrayCreation { $1 } 601 | 602 | > primaryNoNewArray :: { Exp } 603 | > : literal { Lit $1 } 604 | > | resultType '.' 'class' { ClassLit $1 } 605 | > | 'this' { This } 606 | > | name '.' 'this' { ThisClass $1 } 607 | > | '(' exp ')' { Paren $2 } 608 | > | instanceCreation { $1 } 609 | > | fieldAccess { FieldAccess $1 } 610 | > | methodInvocation { MethodInv $1 } 611 | > | arrayAccess { ArrayAccess (fst $1) (snd $1) } 612 | 613 | > instanceCreation :: { Exp } 614 | > : 'new' loptTypeArgs classType args optClassBody 615 | > { InstanceCreation $2 $3 $4 $5 } 616 | > | primary '.' 'new' loptTypeArgs ident args optClassBody 617 | > { QualInstanceCreation $1 $4 $5 $6 $7 } 618 | 619 | > fieldAccess :: { FieldAccess } 620 | > : primary '.' ident { PrimaryFieldAccess $1 $3 } 621 | > | 'super' '.' ident { SuperFieldAccess $3 } 622 | > | name '.' 'super' '.' ident { ClassFieldAccess $1 $5 } 623 | 624 | > methodInvocation :: { MethodInvocation } 625 | > : name args { MethodCall $1 $2 } 626 | > | primary '.' loptRefTypeArgs ident args 627 | > { PrimaryMethodCall $1 $3 $4 $5 } 628 | > | 'super' '.' loptRefTypeArgs ident args 629 | > { SuperMethodCall $3 $4 $5 } 630 | > | name '.' 'super' '.' loptRefTypeArgs ident args 631 | > { ClassMethodCall $1 $5 $6 $7 } 632 | > | name '.' loptRefTypeArgs ident args 633 | > { TypeMethodCall $1 $3 $4 $5 } 634 | 635 | > loptArgs :: { [Exp] } 636 | > : args { $1 } 637 | > | { [] } 638 | 639 | > args :: { [Exp] } 640 | > : '(' seplistExpComma ')' { $2 } 641 | 642 | -- Arrays 643 | 644 | > arrayAccess :: { (Exp, Exp) } 645 | > : arrayRef '[' exp ']' { ($1, $3) } 646 | 647 | > arrayRef :: { Exp } 648 | > : name { ExpName $1 } 649 | > | primaryNoNewArray { $1 } 650 | 651 | > arrayCreation :: { Exp } 652 | > : 'new' type list1DimExpr dims { ArrayCreate $2 $3 $4 } 653 | > | 'new' type dims1 arrayInit { ArrayCreateInit $2 $3 $4 } 654 | 655 | > list1DimExpr :: { [Exp] } 656 | > : dimExpr list1DimExpr { $1 : $2 } 657 | > | dimExpr { [$1] } 658 | 659 | > dimExpr :: { Exp } 660 | > : '[' exp ']' { $2 } 661 | 662 | > dims :: { Int } 663 | > : optDims1 { maybe 0 id $1 } 664 | 665 | > optDims1 :: { Maybe Int } 666 | > : dims1 { Just $1 } 667 | > | { Nothing } 668 | 669 | > dims1 :: { Int } 670 | > : list1Dim { length $1 } 671 | 672 | > list1Dim :: { [()] } 673 | > : dim list1Dim { $1 : $2 } 674 | > | dim { [$1] } 675 | 676 | > dim :: { () } 677 | > : '[' ']' { () } 678 | 679 | -- Literals 680 | 681 | > literal :: { Literal } 682 | > : INT { Int $1 } 683 | > | LONG { Word $1 } 684 | > | FLOAT { Float $1 } 685 | > | DOUBLE { Double $1 } 686 | > | BOOLEAN { Boolean $1 } 687 | > | CHAR { Char $1 } 688 | > | STRING { String $1 } 689 | > | NULL { Null } 690 | 691 | 692 | -- Operators 693 | 694 | > infixOp :: { Op } 695 | > : '*' { Mult } 696 | > | '/' { Div } 697 | > | '%' { Rem } 698 | > | '+' { Add } 699 | > | '-' { Sub } 700 | > | '<<' { LShift } 701 | > | '>>' { RShift } 702 | > | '>>>' { RRShift } 703 | > | '<' { LThan } 704 | > | '>' { GThan } 705 | > | '<=' { LThanE } 706 | > | '>=' { GThanE } 707 | > | '==' { Equal } 708 | > | '!=' { NotEq } 709 | > | '&' { And } 710 | > | '^' { Xor } 711 | > | '|' { Or } 712 | > | '&&' { CAnd } 713 | > | '||' { COr } 714 | 715 | > assignOp :: { AssignOp } 716 | > : '=' { EqualA } 717 | > | '*=' { MultA } 718 | > | '/=' { DivA } 719 | > | '%=' { RemA } 720 | > | '+=' { AddA } 721 | > | '-=' { SubA } 722 | > | '<<=' { LShiftA } 723 | > | '>>=' { RShiftA } 724 | > | '>>>=' { RRShiftA } 725 | > | '&=' { AndA } 726 | > | '^=' { XorA } 727 | > | '|=' { OrA } 728 | 729 | > preIncDecOp :: { Exp -> Exp } 730 | > : '++' { PreIncrement } 731 | > | '--' { PreDecrement } 732 | 733 | > prefixOp :: { Exp -> Exp } 734 | > : '!' { PreNot } 735 | > | '~' { PreBitCompl } 736 | > | '+' { PrePlus } 737 | > | '-' { PreMinus } 738 | 739 | > postfixOp :: { Exp -> Exp } 740 | > : '++' { PostIncrement } 741 | > | '--' { PostDecrement } 742 | 743 | ---------------------------------------------------------------------------- 744 | -- Types 745 | 746 | > type :: { Type } 747 | > : refType { RefType $1 } 748 | > | primType { PrimType $1 } 749 | 750 | > primType :: { PrimType } 751 | > : 'boolean' { BooleanT } 752 | > | 'byte' { ByteT } 753 | > | 'short' { ShortT } 754 | > | 'int' { IntT } 755 | > | 'long' { LongT } 756 | > | 'char' { CharT } 757 | > | 'float' { FloatT } 758 | > | 'double' { DoubleT } 759 | 760 | > seplist1RefTypeAnd :: { [RefType] } 761 | > : refType '&' seplist1RefTypeAnd { $1 : $3 } 762 | > | refType { [$1] } 763 | 764 | > refType :: { RefType } 765 | > : type '[' ']' { ArrayType $1 } 766 | > | classType { ClassRefType $1 } 767 | -- No longer relevant: 768 | | ident { TypeVariable $1 } 769 | 770 | > classType :: { ClassType } 771 | > : seplist1ClassTypeSpecPeriod { ClassType $1 } 772 | 773 | > seplist1ClassTypeSpecPeriod :: { [(Ident, [TypeArgument])] } 774 | > : classTypeSpec '.' seplist1ClassTypeSpecPeriod { $1 : $3 } 775 | > | classTypeSpec { [$1] } 776 | 777 | > classTypeSpec :: { (Ident, [TypeArgument]) } 778 | > : ident loptTypeArgs { ($1, $2) } 779 | 780 | > resultType :: { Maybe Type } 781 | > : 'void' { Nothing } 782 | > | type { Just $1 } 783 | 784 | > refTypeList :: { [RefType] } 785 | > : seplist1RefTypeComma { $1 } 786 | 787 | > seplist1RefTypeComma :: { [RefType] } 788 | > : refType ',' seplist1RefTypeComma { $1 : $3 } 789 | > | refType { [1] } 790 | 791 | ---------------------------------------------------------------------------- 792 | -- Type parameters and arguments 793 | 794 | > loptTypeParams :: { [TypeParam] } 795 | > : typeParams { $1 } 796 | > | { [] } 797 | 798 | > typeParams :: { [TypeParam] } 799 | > : '<' seplist1TypeParamComma '>' { $2 } 800 | 801 | > seplist1TypeParamComma :: { [TypeParam] } 802 | > : typeParam ',' seplist1TypeParamComma { $1 : $3 } 803 | > | typeParam { [$1] } 804 | 805 | > typeParam :: { TypeParam } 806 | > : ident loptBounds { TypeParam $1 $2 } 807 | 808 | > loptBounds :: { [RefType] } 809 | > : bounds { $1 } 810 | > | { [] } 811 | 812 | > bounds :: { [RefType] } 813 | > : 'extends' seplist1RefTypeAnd { $2 } 814 | 815 | > loptTypeArgs :: { [TypeArgument] } 816 | > : typeArgs { $1 } 817 | > | { [] } 818 | 819 | > typeArgs :: { [TypeArgument] } 820 | > : '<' seplist1TypeArgComma '>' { $2 } 821 | 822 | > seplist1TypeArgComma :: { [TypeArgument] } 823 | > : typeArg ',' seplist1TypeArgComma { $1 : $3 } 824 | > | typeArg { [$1] } 825 | 826 | > typeArg :: { TypeArgument } 827 | > : refType { ActualType $1 } 828 | > | '?' optWildcardBound { Wildcard $2 } 829 | 830 | > optWildcardBound :: { Maybe WildcardBound } 831 | > : wildcardBound { Just $1 } 832 | > | { Nothing } 833 | 834 | > wildcardBound :: { WildcardBound } 835 | > : 'extends' refType { ExtendsBound $2 } 836 | > | 'super' refType { SuperBound $2 } 837 | 838 | > loptRefTypeArgs :: { [RefType] } 839 | > : refTypeArgs { $1 } 840 | > | { [] } 841 | 842 | > refTypeArgs :: { [RefType] } 843 | > : '<' refTypeList '>' { $2 } 844 | 845 | ---------------------------------------------------------------------------- 846 | -- Names 847 | 848 | > name :: { Name } 849 | > : seplist1IdentComma { Name $1 } 850 | 851 | > optIdent :: { Maybe Ident } 852 | > : ident { Just $1 } 853 | > | { Nothing } 854 | 855 | > seplist1IdentComma :: { [Ident] } 856 | > : ident ',' seplist1IdentComma { $1 : $3 } 857 | > | ident { [$1] } 858 | 859 | > ident :: { Ident } 860 | > : IDENT { Ident $1 } 861 | 862 | ---------------------------------------------------------------------------- 863 | -- Higher-order productions 864 | 865 | opt(p) : p { Just $1 } 866 | | { Nothing } 867 | 868 | lopt(p) : opt(p) { maybe [] id $1 } 869 | 870 | bopt(p) : opt(p) { maybe False (const True) $1 } 871 | 872 | fopt(p) : opt(p) { maybe id id $1 } 873 | 874 | list(p) : list1(p) { $1 } 875 | | { [] } 876 | 877 | list1(p) : p { [$1] } 878 | | p list1(p) { $1 : $2 } 879 | 880 | seplist(p,s) : seplist1(p,s) { $1 } 881 | | { [] } 882 | 883 | seplist1(p,s) : p { [$1] } 884 | | p s seplist1(p,s) { $1 : $3 } 885 | 886 | flist(p) : list(p) { foldr (.) id $1 } 887 | 888 | 889 | ---------------------------------------------------------------------------- 890 | -- Helper functions 891 | 892 | > { 893 | 894 | > happyError = undefined 895 | 896 | > type Mod a = [Modifier] -> a 897 | 898 | > } 899 | -------------------------------------------------------------------------------- /Language/Java/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Language.Java.Parser ( 3 | parser, 4 | 5 | compilationUnit, packageDecl, importDecl, typeDecl, 6 | 7 | classDecl, interfaceDecl, 8 | 9 | memberDecl, fieldDecl, methodDecl, constrDecl, 10 | interfaceMemberDecl, absMethodDecl, 11 | 12 | formalParams, formalParam, 13 | 14 | modifier, 15 | 16 | varDecls, varDecl, 17 | 18 | block, blockStmt, stmt, 19 | 20 | stmtExp, exp, primary, literal, 21 | 22 | ttype, primType, refType, classType, resultType, 23 | 24 | lambdaExp, methodRef, 25 | 26 | typeParams, typeParam, 27 | 28 | name, ident, 29 | 30 | 31 | empty, list, list1, seplist, seplist1, opt, bopt, lopt, 32 | 33 | comma, semiColon, period, colon 34 | 35 | ) where 36 | 37 | import Language.Java.Lexer ( L(..), Token(..), lexer) 38 | import Language.Java.Syntax 39 | import Language.Java.Pretty (pretty) 40 | 41 | import Text.Parsec hiding ( Empty ) 42 | import Text.Parsec.Pos 43 | 44 | import Prelude hiding ( exp, catch, (>>), (>>=) ) 45 | import qualified Prelude as P ( (>>), (>>=) ) 46 | import Data.Maybe ( isJust, catMaybes ) 47 | import Control.Monad ( ap ) 48 | 49 | #if __GLASGOW_HASKELL__ < 707 50 | import Control.Applicative ( (<$>), (<$), (<*) ) 51 | -- Since I cba to find the instance Monad m => Applicative m declaration. 52 | (<*>) :: Monad m => m (a -> b) -> m a -> m b 53 | (<*>) = ap 54 | infixl 4 <*> 55 | #else 56 | import Control.Applicative ( (<$>), (<$), (<*), (<*>) ) 57 | #endif 58 | 59 | type P = Parsec [L Token] () 60 | 61 | -- A trick to allow >> and >>=, normally infixr 1, to be 62 | -- used inside branches of <|>, which is declared as infixl 1. 63 | -- There are no clashes with other operators of precedence 2. 64 | (>>) = (P.>>) 65 | (>>=) = (P.>>=) 66 | infixr 2 >>, >>= 67 | -- Note also when reading that <$> is infixl 4 and thus has 68 | -- lower precedence than all the others (>>, >>=, and <|>). 69 | 70 | ---------------------------------------------------------------------------- 71 | -- Top-level parsing 72 | 73 | parseCompilationUnit :: String -> Either ParseError CompilationUnit 74 | parseCompilationUnit inp = 75 | runParser compilationUnit () "" (lexer inp) 76 | 77 | parser p = runParser p () "" . lexer 78 | 79 | --class Parse a where 80 | -- parse :: String -> a 81 | 82 | ---------------------------------------------------------------------------- 83 | -- Packages and compilation units 84 | 85 | compilationUnit :: P CompilationUnit 86 | compilationUnit = do 87 | mpd <- opt packageDecl 88 | ids <- list importDecl 89 | tds <- list typeDecl 90 | eof 91 | return $ CompilationUnit mpd ids (catMaybes tds) 92 | 93 | packageDecl :: P PackageDecl 94 | packageDecl = do 95 | tok KW_Package 96 | n <- name 97 | semiColon 98 | return $ PackageDecl n 99 | 100 | importDecl :: P ImportDecl 101 | importDecl = do 102 | tok KW_Import 103 | st <- bopt $ tok KW_Static 104 | n <- name 105 | ds <- bopt $ period >> tok Op_Star 106 | semiColon 107 | return $ ImportDecl st n ds 108 | 109 | typeDecl :: P (Maybe TypeDecl) 110 | typeDecl = Just <$> classOrInterfaceDecl <|> 111 | const Nothing <$> semiColon 112 | 113 | ---------------------------------------------------------------------------- 114 | -- Declarations 115 | 116 | -- Class declarations 117 | 118 | classOrInterfaceDecl :: P TypeDecl 119 | classOrInterfaceDecl = do 120 | ms <- list modifier 121 | de <- (do cd <- classDecl 122 | return $ \ms -> ClassTypeDecl (cd ms)) <|> 123 | (do id <- annInterfaceDecl <|> interfaceDecl 124 | return $ \ms -> InterfaceTypeDecl (id ms)) 125 | return $ de ms 126 | 127 | classDecl :: P (Mod ClassDecl) 128 | classDecl = normalClassDecl <|> enumClassDecl 129 | 130 | normalClassDecl :: P (Mod ClassDecl) 131 | normalClassDecl = do 132 | tok KW_Class 133 | i <- ident 134 | tps <- lopt typeParams 135 | mex <- opt extends 136 | imp <- lopt implements 137 | bod <- classBody 138 | return $ \ms -> ClassDecl ms i tps ((fmap head) mex) imp bod 139 | 140 | extends :: P [RefType] 141 | extends = tok KW_Extends >> refTypeList 142 | 143 | implements :: P [RefType] 144 | implements = tok KW_Implements >> refTypeList 145 | 146 | enumClassDecl :: P (Mod ClassDecl) 147 | enumClassDecl = do 148 | tok KW_Enum 149 | i <- ident 150 | imp <- lopt implements 151 | bod <- enumBody 152 | return $ \ms -> EnumDecl ms i imp bod 153 | 154 | classBody :: P ClassBody 155 | classBody = ClassBody <$> braces classBodyStatements 156 | 157 | enumBody :: P EnumBody 158 | enumBody = braces $ do 159 | ecs <- seplist enumConst comma 160 | optional comma 161 | eds <- lopt enumBodyDecls 162 | return $ EnumBody ecs eds 163 | 164 | enumConst :: P EnumConstant 165 | enumConst = do 166 | id <- ident 167 | as <- lopt args 168 | mcb <- opt classBody 169 | return $ EnumConstant id as mcb 170 | 171 | enumBodyDecls :: P [Decl] 172 | enumBodyDecls = semiColon >> classBodyStatements 173 | 174 | classBodyStatements :: P [Decl] 175 | classBodyStatements = catMaybes <$> list classBodyStatement 176 | 177 | -- Interface declarations 178 | 179 | annInterfaceDecl :: P (Mod InterfaceDecl) 180 | annInterfaceDecl = do 181 | tok KW_AnnInterface 182 | id <- ident 183 | tps <- lopt typeParams 184 | exs <- lopt extends 185 | bod <- interfaceBody 186 | return $ \ms -> InterfaceDecl InterfaceAnnotation ms id tps exs bod 187 | 188 | interfaceDecl :: P (Mod InterfaceDecl) 189 | interfaceDecl = do 190 | tok KW_Interface 191 | id <- ident 192 | tps <- lopt typeParams 193 | exs <- lopt extends 194 | bod <- interfaceBody 195 | return $ \ms -> InterfaceDecl InterfaceNormal ms id tps exs bod 196 | 197 | interfaceBody :: P InterfaceBody 198 | interfaceBody = InterfaceBody . catMaybes <$> 199 | braces (list interfaceBodyDecl) 200 | 201 | -- Declarations 202 | 203 | classBodyStatement :: P (Maybe Decl) 204 | classBodyStatement = 205 | (try $ do 206 | list1 semiColon 207 | return Nothing) <|> 208 | (try $ do 209 | mst <- bopt (tok KW_Static) 210 | blk <- block 211 | return $ Just $ InitDecl mst blk) <|> 212 | (do ms <- list modifier 213 | dec <- memberDecl 214 | return $ Just $ MemberDecl (dec ms)) 215 | 216 | memberDecl :: P (Mod MemberDecl) 217 | memberDecl = 218 | (try $ do 219 | cd <- classDecl 220 | return $ \ms -> MemberClassDecl (cd ms)) <|> 221 | (try $ do 222 | id <- try annInterfaceDecl <|> try interfaceDecl 223 | return $ \ms -> MemberInterfaceDecl (id ms)) <|> 224 | 225 | try fieldDecl <|> 226 | try methodDecl <|> 227 | constrDecl 228 | 229 | fieldDecl :: P (Mod MemberDecl) 230 | fieldDecl = endSemi $ do 231 | typ <- ttype 232 | vds <- varDecls 233 | return $ \ms -> FieldDecl ms typ vds 234 | 235 | methodDecl :: P (Mod MemberDecl) 236 | methodDecl = do 237 | tps <- lopt typeParams 238 | rt <- resultType 239 | id <- ident 240 | fps <- formalParams 241 | thr <- lopt throws 242 | bod <- methodBody 243 | return $ \ms -> MethodDecl ms tps rt id fps thr Nothing bod 244 | 245 | methodBody :: P MethodBody 246 | methodBody = MethodBody <$> 247 | (const Nothing <$> semiColon <|> Just <$> block) 248 | 249 | 250 | constrDecl :: P (Mod MemberDecl) 251 | constrDecl = do 252 | tps <- lopt typeParams 253 | id <- ident 254 | fps <- formalParams 255 | thr <- lopt throws 256 | bod <- constrBody 257 | return $ \ms -> ConstructorDecl ms tps id fps thr bod 258 | 259 | constrBody :: P ConstructorBody 260 | constrBody = braces $ do 261 | mec <- opt (try explConstrInv) 262 | bss <- list blockStmt 263 | return $ ConstructorBody mec bss 264 | 265 | explConstrInv :: P ExplConstrInv 266 | explConstrInv = endSemi $ 267 | (try $ do 268 | tas <- lopt refTypeArgs 269 | tok KW_This 270 | as <- args 271 | return $ ThisInvoke tas as) <|> 272 | (try $ do 273 | tas <- lopt refTypeArgs 274 | tok KW_Super 275 | as <- args 276 | return $ SuperInvoke tas as) <|> 277 | (do pri <- primary 278 | period 279 | tas <- lopt refTypeArgs 280 | tok KW_Super 281 | as <- args 282 | return $ PrimarySuperInvoke pri tas as) 283 | 284 | -- TODO: This should be parsed like class bodies, and post-checked. 285 | -- That would give far better error messages. 286 | interfaceBodyDecl :: P (Maybe MemberDecl) 287 | interfaceBodyDecl = semiColon >> return Nothing <|> 288 | do ms <- list modifier 289 | imd <- interfaceMemberDecl 290 | return $ Just (imd ms) 291 | 292 | interfaceMemberDecl :: P (Mod MemberDecl) 293 | interfaceMemberDecl = 294 | (do cd <- classDecl 295 | return $ \ms -> MemberClassDecl (cd ms)) <|> 296 | (do id <- try annInterfaceDecl <|> try interfaceDecl 297 | return $ \ms -> MemberInterfaceDecl (id ms)) <|> 298 | try fieldDecl <|> 299 | absMethodDecl 300 | 301 | absMethodDecl :: P (Mod MemberDecl) 302 | absMethodDecl = do 303 | tps <- lopt typeParams 304 | rt <- resultType 305 | id <- ident 306 | fps <- formalParams 307 | thr <- lopt throws 308 | def <- opt defaultValue 309 | semiColon 310 | return $ \ms -> MethodDecl ms tps rt id fps thr def (MethodBody Nothing) 311 | 312 | defaultValue :: P Exp 313 | defaultValue = tok KW_Default >> exp 314 | 315 | throws :: P [RefType] 316 | throws = tok KW_Throws >> refTypeList 317 | 318 | -- Formal parameters 319 | 320 | formalParams :: P [FormalParam] 321 | formalParams = parens $ do 322 | fps <- seplist formalParam comma 323 | if validateFPs fps 324 | then return fps 325 | else fail "Only the last formal parameter may be of variable arity" 326 | where validateFPs :: [FormalParam] -> Bool 327 | validateFPs [] = True 328 | validateFPs [_] = True 329 | validateFPs (FormalParam _ _ b _ :xs) = not b 330 | 331 | formalParam :: P FormalParam 332 | formalParam = do 333 | ms <- list modifier 334 | typ <- ttype 335 | var <- bopt ellipsis 336 | vid <- varDeclId 337 | return $ FormalParam ms typ var vid 338 | 339 | ellipsis :: P () 340 | ellipsis = period >> period >> period 341 | 342 | -- Modifiers 343 | 344 | modifier :: P Modifier 345 | modifier = 346 | tok KW_Public >> return Public 347 | <|> tok KW_Protected >> return Protected 348 | <|> tok KW_Private >> return Private 349 | <|> tok KW_Abstract >> return Abstract 350 | <|> tok KW_Static >> return Static 351 | <|> tok KW_Strictfp >> return StrictFP 352 | <|> tok KW_Final >> return Final 353 | <|> tok KW_Native >> return Native 354 | <|> tok KW_Transient >> return Transient 355 | <|> tok KW_Volatile >> return Volatile 356 | <|> tok KW_Synchronized >> return Synchronized_ 357 | <|> Annotation <$> annotation 358 | 359 | annotation :: P Annotation 360 | annotation = flip ($) <$ tok Op_AtSign <*> name <*> ( 361 | try (flip NormalAnnotation <$> parens evlist) 362 | <|> try (flip SingleElementAnnotation <$> parens elementValue) 363 | <|> try (MarkerAnnotation <$ return ()) 364 | ) 365 | 366 | evlist :: P [(Ident, ElementValue)] 367 | evlist = seplist1 elementValuePair comma 368 | 369 | elementValuePair :: P (Ident, ElementValue) 370 | elementValuePair = (,) <$> ident <* tok Op_Equal <*> elementValue 371 | 372 | elementValue :: P ElementValue 373 | elementValue = 374 | EVVal <$> ( InitArray <$> arrayInit 375 | <|> InitExp <$> condExp ) 376 | <|> EVAnn <$> annotation 377 | 378 | 379 | ---------------------------------------------------------------------------- 380 | -- Variable declarations 381 | 382 | varDecls :: P [VarDecl] 383 | varDecls = seplist1 varDecl comma 384 | 385 | varDecl :: P VarDecl 386 | varDecl = do 387 | vid <- varDeclId 388 | mvi <- opt $ tok Op_Equal >> varInit 389 | return $ VarDecl vid mvi 390 | 391 | varDeclId :: P VarDeclId 392 | varDeclId = do 393 | id <- ident 394 | abs <- list arrBrackets 395 | return $ foldl (\f _ -> VarDeclArray . f) VarId abs id 396 | 397 | arrBrackets :: P () 398 | arrBrackets = brackets $ return () 399 | 400 | localVarDecl :: P ([Modifier], Type, [VarDecl]) 401 | localVarDecl = do 402 | ms <- list modifier 403 | typ <- ttype 404 | vds <- varDecls 405 | return (ms, typ, vds) 406 | 407 | varInit :: P VarInit 408 | varInit = 409 | InitArray <$> arrayInit <|> 410 | InitExp <$> exp 411 | 412 | arrayInit :: P ArrayInit 413 | arrayInit = braces $ do 414 | vis <- seplist varInit comma 415 | opt comma 416 | return $ ArrayInit vis 417 | 418 | ---------------------------------------------------------------------------- 419 | -- Statements 420 | 421 | block :: P Block 422 | block = braces $ Block <$> list blockStmt 423 | 424 | blockStmt :: P BlockStmt 425 | blockStmt = 426 | (try $ do 427 | ms <- list modifier 428 | cd <- classDecl 429 | return $ LocalClass (cd ms)) <|> 430 | (try $ do 431 | (m,t,vds) <- endSemi $ localVarDecl 432 | return $ LocalVars m t vds) <|> 433 | BlockStmt <$> stmt 434 | 435 | stmt :: P Stmt 436 | stmt = ifStmt <|> whileStmt <|> forStmt <|> labeledStmt <|> stmtNoTrail 437 | where 438 | ifStmt = do 439 | tok KW_If 440 | e <- parens exp 441 | (try $ 442 | do th <- stmtNSI 443 | tok KW_Else 444 | el <- stmt 445 | return $ IfThenElse e th el) <|> 446 | (do th <- stmt 447 | return $ IfThen e th) 448 | whileStmt = do 449 | tok KW_While 450 | e <- parens exp 451 | s <- stmt 452 | return $ While e s 453 | forStmt = do 454 | tok KW_For 455 | f <- parens $ 456 | (try $ do 457 | fi <- opt forInit 458 | semiColon 459 | e <- opt exp 460 | semiColon 461 | fu <- opt forUp 462 | return $ BasicFor fi e fu) <|> 463 | (do ms <- list modifier 464 | t <- ttype 465 | i <- ident 466 | colon 467 | e <- exp 468 | return $ EnhancedFor ms t i e) 469 | s <- stmt 470 | return $ f s 471 | labeledStmt = try $ do 472 | lbl <- ident 473 | colon 474 | s <- stmt 475 | return $ Labeled lbl s 476 | 477 | stmtNSI :: P Stmt 478 | stmtNSI = ifStmt <|> whileStmt <|> forStmt <|> labeledStmt <|> stmtNoTrail 479 | where 480 | ifStmt = do 481 | tok KW_If 482 | e <- parens exp 483 | th <- stmtNSI 484 | tok KW_Else 485 | el <- stmtNSI 486 | return $ IfThenElse e th el 487 | whileStmt = do 488 | tok KW_While 489 | e <- parens exp 490 | s <- stmtNSI 491 | return $ While e s 492 | forStmt = do 493 | tok KW_For 494 | f <- parens $ (try $ do 495 | fi <- opt forInit 496 | semiColon 497 | e <- opt exp 498 | semiColon 499 | fu <- opt forUp 500 | return $ BasicFor fi e fu) 501 | <|> (do 502 | ms <- list modifier 503 | t <- ttype 504 | i <- ident 505 | colon 506 | e <- exp 507 | return $ EnhancedFor ms t i e) 508 | s <- stmtNSI 509 | return $ f s 510 | labeledStmt = try $ do 511 | i <- ident 512 | colon 513 | s <- stmtNSI 514 | return $ Labeled i s 515 | 516 | stmtNoTrail :: P Stmt 517 | stmtNoTrail = 518 | -- empty statement 519 | const Empty <$> semiColon <|> 520 | -- inner block 521 | StmtBlock <$> block <|> 522 | -- assertions 523 | (endSemi $ do 524 | tok KW_Assert 525 | e <- exp 526 | me2 <- opt $ colon >> exp 527 | return $ Assert e me2) <|> 528 | -- switch stmts 529 | (do tok KW_Switch 530 | e <- parens exp 531 | sb <- switchBlock 532 | return $ Switch e sb) <|> 533 | -- do-while loops 534 | (endSemi $ do 535 | tok KW_Do 536 | s <- stmt 537 | tok KW_While 538 | e <- parens exp 539 | return $ Do s e) <|> 540 | -- break 541 | (endSemi $ do 542 | tok KW_Break 543 | mi <- opt ident 544 | return $ Break mi) <|> 545 | -- continue 546 | (endSemi $ do 547 | tok KW_Continue 548 | mi <- opt ident 549 | return $ Continue mi) <|> 550 | -- return 551 | (endSemi $ do 552 | tok KW_Return 553 | me <- opt exp 554 | return $ Return me) <|> 555 | -- synchronized 556 | (do tok KW_Synchronized 557 | e <- parens exp 558 | b <- block 559 | return $ Synchronized e b) <|> 560 | -- throw 561 | (endSemi $ do 562 | tok KW_Throw 563 | e <- exp 564 | return $ Throw e) <|> 565 | -- try-catch, both with and without a finally clause 566 | (do tok KW_Try 567 | b <- block 568 | c <- list catch 569 | mf <- opt $ tok KW_Finally >> block 570 | -- TODO: here we should check that there exists at 571 | -- least one catch or finally clause 572 | return $ Try b c mf) <|> 573 | -- expressions as stmts 574 | ExpStmt <$> endSemi stmtExp 575 | 576 | -- For loops 577 | 578 | forInit :: P ForInit 579 | forInit = (do 580 | try (do (m,t,vds) <- localVarDecl 581 | return $ ForLocalVars m t vds)) <|> 582 | (seplist1 stmtExp comma >>= return . ForInitExps) 583 | 584 | forUp :: P [Exp] 585 | forUp = seplist1 stmtExp comma 586 | 587 | -- Switches 588 | 589 | switchBlock :: P [SwitchBlock] 590 | switchBlock = braces $ list switchStmt 591 | 592 | switchStmt :: P SwitchBlock 593 | switchStmt = do 594 | lbl <- switchLabel 595 | bss <- list blockStmt 596 | return $ SwitchBlock lbl bss 597 | 598 | switchLabel :: P SwitchLabel 599 | switchLabel = (tok KW_Default >> colon >> return Default) <|> 600 | (do tok KW_Case 601 | e <- exp 602 | colon 603 | return $ SwitchCase e) 604 | 605 | -- Try-catch clauses 606 | 607 | catch :: P Catch 608 | catch = do 609 | tok KW_Catch 610 | fp <- parens formalParam 611 | b <- block 612 | return $ Catch fp b 613 | 614 | ---------------------------------------------------------------------------- 615 | -- Expressions 616 | 617 | stmtExp :: P Exp 618 | stmtExp = try preIncDec 619 | <|> try postIncDec 620 | <|> try assignment 621 | -- There are sharing gains to be made by unifying these two 622 | <|> try methodInvocationExp 623 | <|> try lambdaExp 624 | <|> try methodRef 625 | <|> instanceCreation 626 | 627 | preIncDec :: P Exp 628 | preIncDec = do 629 | op <- preIncDecOp 630 | e <- unaryExp 631 | return $ op e 632 | 633 | postIncDec :: P Exp 634 | postIncDec = do 635 | e <- postfixExpNES 636 | ops <- list1 postfixOp 637 | return $ foldl (\a s -> s a) e ops 638 | 639 | assignment :: P Exp 640 | assignment = do 641 | lh <- lhs 642 | op <- assignOp 643 | e <- assignExp 644 | return $ Assign lh op e 645 | 646 | lhs :: P Lhs 647 | lhs = try (FieldLhs <$> fieldAccess) 648 | <|> try (ArrayLhs <$> arrayAccess) 649 | <|> NameLhs <$> name 650 | 651 | 652 | 653 | exp :: P Exp 654 | exp = assignExp 655 | 656 | assignExp :: P Exp 657 | assignExp = try methodRef <|> try lambdaExp <|> try assignment <|> condExp 658 | 659 | condExp :: P Exp 660 | condExp = do 661 | ie <- infixExp 662 | ces <- list condExpSuffix 663 | return $ foldl (\a s -> s a) ie ces 664 | 665 | condExpSuffix :: P (Exp -> Exp) 666 | condExpSuffix = do 667 | tok Op_Query 668 | th <- exp 669 | colon 670 | el <- condExp 671 | return $ \ce -> Cond ce th el 672 | 673 | infixExp :: P Exp 674 | infixExp = do 675 | ue <- unaryExp 676 | ies <- list infixExpSuffix 677 | return $ foldl (\a s -> s a) ue ies 678 | 679 | infixExpSuffix :: P (Exp -> Exp) 680 | infixExpSuffix = 681 | (do 682 | op <- infixCombineOp 683 | ie2 <- infixExp 684 | return $ \ie1 -> BinOp ie1 op ie2) <|> 685 | (do op <- infixOp 686 | e2 <- unaryExp 687 | return $ \e1 -> BinOp e1 op e2) <|> 688 | (do tok KW_Instanceof 689 | t <- refType 690 | return $ \e1 -> InstanceOf e1 t) 691 | 692 | unaryExp :: P Exp 693 | unaryExp = try preIncDec <|> 694 | try (do 695 | op <- prefixOp 696 | ue <- unaryExp 697 | return $ op ue) <|> 698 | try (do 699 | t <- parens ttype 700 | e <- unaryExp 701 | return $ Cast t e) <|> 702 | postfixExp 703 | 704 | postfixExpNES :: P Exp 705 | postfixExpNES = -- try postIncDec <|> 706 | try primary <|> 707 | ExpName <$> name 708 | 709 | postfixExp :: P Exp 710 | postfixExp = do 711 | pe <- postfixExpNES 712 | ops <- list postfixOp 713 | return $ foldl (\a s -> s a) pe ops 714 | 715 | 716 | primary :: P Exp 717 | primary = primaryNPS |>> primarySuffix 718 | 719 | primaryNPS :: P Exp 720 | primaryNPS = try arrayCreation <|> primaryNoNewArrayNPS 721 | 722 | primaryNoNewArray = startSuff primaryNoNewArrayNPS primarySuffix 723 | 724 | primaryNoNewArrayNPS :: P Exp 725 | primaryNoNewArrayNPS = 726 | Lit <$> literal <|> 727 | const This <$> tok KW_This <|> 728 | parens exp <|> 729 | -- TODO: These two following should probably be merged more 730 | (try $ do 731 | rt <- resultType 732 | period >> tok KW_Class 733 | return $ ClassLit rt) <|> 734 | (try $ do 735 | n <- name 736 | period >> tok KW_This 737 | return $ ThisClass n) <|> 738 | try instanceCreationNPS <|> 739 | try (MethodInv <$> methodInvocationNPS) <|> 740 | try (FieldAccess <$> fieldAccessNPS) <|> 741 | ArrayAccess <$> arrayAccessNPS 742 | 743 | primarySuffix :: P (Exp -> Exp) 744 | primarySuffix = try instanceCreationSuffix <|> 745 | try ((ArrayAccess .) <$> arrayAccessSuffix) <|> 746 | try ((MethodInv .) <$> methodInvocationSuffix) <|> 747 | (FieldAccess .) <$> fieldAccessSuffix 748 | 749 | 750 | instanceCreationNPS :: P Exp 751 | instanceCreationNPS = 752 | do tok KW_New 753 | tas <- lopt typeArgs 754 | tds <- typeDeclSpecifier 755 | as <- args 756 | mcb <- opt classBody 757 | return $ InstanceCreation tas tds as mcb 758 | 759 | typeDeclSpecifier :: P TypeDeclSpecifier 760 | typeDeclSpecifier = 761 | (try $ do ct <- classType 762 | period 763 | i <- ident 764 | tok Op_LThan 765 | tok Op_GThan 766 | return $ TypeDeclSpecifierWithDiamond ct i Diamond 767 | ) <|> 768 | (try $ do i <- ident 769 | tok Op_LThan 770 | tok Op_GThan 771 | return $ TypeDeclSpecifierUnqualifiedWithDiamond i Diamond 772 | ) <|> 773 | (do ct <- classType 774 | return $ TypeDeclSpecifier ct 775 | ) 776 | 777 | instanceCreationSuffix :: P (Exp -> Exp) 778 | instanceCreationSuffix = 779 | do period >> tok KW_New 780 | tas <- lopt typeArgs 781 | i <- ident 782 | as <- args 783 | mcb <- opt classBody 784 | return $ \p -> QualInstanceCreation p tas i as mcb 785 | 786 | instanceCreation :: P Exp 787 | instanceCreation = try instanceCreationNPS <|> do 788 | p <- primaryNPS 789 | ss <- list primarySuffix 790 | let icp = foldl (\a s -> s a) p ss 791 | case icp of 792 | QualInstanceCreation {} -> return icp 793 | _ -> fail "" 794 | 795 | 796 | lambdaParams :: P LambdaParams 797 | lambdaParams = try (LambdaSingleParam <$> ident) 798 | <|> try (parens $ LambdaFormalParams <$> (seplist formalParam comma)) 799 | <|> (parens $ LambdaInferredParams <$> (seplist ident comma)) 800 | 801 | lambdaExp :: P Exp 802 | lambdaExp = Lambda 803 | <$> (lambdaParams <* (tok LambdaArrow)) 804 | <*> ((LambdaBlock <$> (try block)) 805 | <|> (LambdaExpression <$> exp)) 806 | 807 | methodRef :: P Exp 808 | methodRef = MethodRef 809 | <$> (name <* (tok MethodRefSep)) 810 | <*> ident 811 | 812 | {- 813 | instanceCreation = 814 | (do tok KW_New 815 | tas <- lopt typeArgs 816 | ct <- classType 817 | as <- args 818 | mcb <- opt classBody 819 | return $ InstanceCreation tas ct as mcb) <|> 820 | (do p <- primary 821 | period >> tok KW_New 822 | tas <- lopt typeArgs 823 | i <- ident 824 | as <- args 825 | mcb <- opt classBody 826 | return $ QualInstanceCreation p tas i as mcb) 827 | -} 828 | 829 | fieldAccessNPS :: P FieldAccess 830 | fieldAccessNPS = 831 | (do tok KW_Super >> period 832 | i <- ident 833 | return $ SuperFieldAccess i) <|> 834 | (do n <- name 835 | period >> tok KW_Super >> period 836 | i <- ident 837 | return $ ClassFieldAccess n i) 838 | 839 | fieldAccessSuffix :: P (Exp -> FieldAccess) 840 | fieldAccessSuffix = do 841 | period 842 | i <- ident 843 | return $ \p -> PrimaryFieldAccess p i 844 | 845 | fieldAccess :: P FieldAccess 846 | fieldAccess = try fieldAccessNPS <|> do 847 | p <- primaryNPS 848 | ss <- list primarySuffix 849 | let fap = foldl (\a s -> s a) p ss 850 | case fap of 851 | FieldAccess fa -> return fa 852 | _ -> fail "" 853 | 854 | {- 855 | fieldAccess :: P FieldAccess 856 | fieldAccess = try fieldAccessNPS <|> do 857 | p <- primary 858 | fs <- fieldAccessSuffix 859 | return (fs p) 860 | -} 861 | 862 | {- 863 | fieldAccess :: P FieldAccess 864 | fieldAccess = 865 | (do tok KW_Super >> period 866 | i <- ident 867 | return $ SuperFieldAccess i) <|> 868 | (try $ do 869 | n <- name 870 | period >> tok KW_Super >> period 871 | i <- ident 872 | return $ ClassFieldAccess n i) <|> 873 | (do p <- primary 874 | period 875 | i <- ident 876 | return $ PrimaryFieldAccess p i) 877 | -} 878 | 879 | methodInvocationNPS :: P MethodInvocation 880 | methodInvocationNPS = 881 | (do tok KW_Super >> period 882 | rts <- lopt refTypeArgs 883 | i <- ident 884 | as <- args 885 | return $ SuperMethodCall rts i as) <|> 886 | (do n <- name 887 | f <- (do as <- args 888 | return $ \n -> MethodCall n as) <|> 889 | (period >> do 890 | msp <- opt (tok KW_Super >> period) 891 | rts <- lopt refTypeArgs 892 | i <- ident 893 | as <- args 894 | let mc = maybe TypeMethodCall (const ClassMethodCall) msp 895 | return $ \n -> mc n rts i as) 896 | return $ f n) 897 | 898 | methodInvocationSuffix :: P (Exp -> MethodInvocation) 899 | methodInvocationSuffix = do 900 | period 901 | rts <- lopt refTypeArgs 902 | i <- ident 903 | as <- args 904 | return $ \p -> PrimaryMethodCall p [] i as 905 | 906 | methodInvocationExp :: P Exp 907 | methodInvocationExp = try (do 908 | p <- primaryNPS 909 | ss <- list primarySuffix 910 | let mip = foldl (\a s -> s a) p ss 911 | case mip of 912 | MethodInv _ -> return mip 913 | _ -> fail "") <|> 914 | (MethodInv <$> methodInvocationNPS) 915 | 916 | {- 917 | methodInvocation :: P MethodInvocation 918 | methodInvocation = 919 | (do tok KW_Super >> period 920 | rts <- lopt refTypeArgs 921 | i <- ident 922 | as <- args 923 | return $ SuperMethodCall rts i as) <|> 924 | (do p <- primary 925 | period 926 | rts <- lopt refTypeArgs 927 | i <- ident 928 | as <- args 929 | return $ PrimaryMethodCall p rts i as) <|> 930 | (do n <- name 931 | f <- (do as <- args 932 | return $ \n -> MethodCall n as) <|> 933 | (period >> do 934 | msp <- opt (tok KW_Super >> period) 935 | rts <- lopt refTypeArgs 936 | i <- ident 937 | as <- args 938 | let mc = maybe TypeMethodCall (const ClassMethodCall) msp 939 | return $ \n -> mc n rts i as) 940 | return $ f n) 941 | -} 942 | 943 | args :: P [Argument] 944 | args = parens $ seplist exp comma 945 | 946 | -- Arrays 947 | 948 | arrayAccessNPS :: P ArrayIndex 949 | arrayAccessNPS = do 950 | n <- name 951 | e <- list1 $ brackets exp 952 | return $ ArrayIndex (ExpName n) e 953 | 954 | arrayAccessSuffix :: P (Exp -> ArrayIndex) 955 | arrayAccessSuffix = do 956 | e <- list1 $ brackets exp 957 | return $ \ref -> ArrayIndex ref e 958 | 959 | arrayAccess = try arrayAccessNPS <|> do 960 | p <- primaryNoNewArrayNPS 961 | ss <- list primarySuffix 962 | let aap = foldl (\a s -> s a) p ss 963 | case aap of 964 | ArrayAccess ain -> return ain 965 | _ -> fail "" 966 | 967 | {- 968 | arrayAccess :: P (Exp, Exp) 969 | arrayAccess = do 970 | ref <- arrayRef 971 | e <- brackets exp 972 | return (ref, e) 973 | 974 | arrayRef :: P Exp 975 | arrayRef = ExpName <$> name <|> primaryNoNewArray 976 | -} 977 | 978 | arrayCreation :: P Exp 979 | arrayCreation = do 980 | tok KW_New 981 | t <- nonArrayType 982 | f <- (try $ do 983 | ds <- list1 $ brackets empty 984 | ai <- arrayInit 985 | return $ \t -> ArrayCreateInit t (length ds) ai) <|> 986 | (do des <- list1 $ try $ brackets exp 987 | ds <- list $ brackets empty 988 | return $ \t -> ArrayCreate t des (length ds)) 989 | return $ f t 990 | 991 | literal :: P Literal 992 | literal = 993 | javaToken $ \t -> case t of 994 | IntTok i -> Just (Int i) 995 | LongTok l -> Just (Word l) 996 | DoubleTok d -> Just (Double d) 997 | FloatTok f -> Just (Float f) 998 | CharTok c -> Just (Char c) 999 | StringTok s -> Just (String s) 1000 | BoolTok b -> Just (Boolean b) 1001 | NullTok -> Just Null 1002 | _ -> Nothing 1003 | 1004 | -- Operators 1005 | 1006 | preIncDecOp, prefixOp, postfixOp :: P (Exp -> Exp) 1007 | preIncDecOp = 1008 | (tok Op_PPlus >> return PreIncrement) <|> 1009 | (tok Op_MMinus >> return PreDecrement) 1010 | prefixOp = 1011 | (tok Op_Bang >> return PreNot ) <|> 1012 | (tok Op_Tilde >> return PreBitCompl ) <|> 1013 | (tok Op_Plus >> return PrePlus ) <|> 1014 | (tok Op_Minus >> return PreMinus ) 1015 | postfixOp = 1016 | (tok Op_PPlus >> return PostIncrement) <|> 1017 | (tok Op_MMinus >> return PostDecrement) 1018 | 1019 | assignOp :: P AssignOp 1020 | assignOp = 1021 | (tok Op_Equal >> return EqualA ) <|> 1022 | (tok Op_StarE >> return MultA ) <|> 1023 | (tok Op_SlashE >> return DivA ) <|> 1024 | (tok Op_PercentE >> return RemA ) <|> 1025 | (tok Op_PlusE >> return AddA ) <|> 1026 | (tok Op_MinusE >> return SubA ) <|> 1027 | (tok Op_LShiftE >> return LShiftA ) <|> 1028 | (tok Op_RShiftE >> return RShiftA ) <|> 1029 | (tok Op_RRShiftE >> return RRShiftA ) <|> 1030 | (tok Op_AndE >> return AndA ) <|> 1031 | (tok Op_CaretE >> return XorA ) <|> 1032 | (tok Op_OrE >> return OrA ) 1033 | 1034 | infixCombineOp :: P Op 1035 | infixCombineOp = 1036 | (tok Op_And >> return And ) <|> 1037 | (tok Op_Caret >> return Xor ) <|> 1038 | (tok Op_Or >> return Or ) <|> 1039 | (tok Op_AAnd >> return CAnd ) <|> 1040 | (tok Op_OOr >> return COr ) 1041 | 1042 | 1043 | infixOp :: P Op 1044 | infixOp = 1045 | (tok Op_Star >> return Mult ) <|> 1046 | (tok Op_Slash >> return Div ) <|> 1047 | (tok Op_Percent >> return Rem ) <|> 1048 | (tok Op_Plus >> return Add ) <|> 1049 | (tok Op_Minus >> return Sub ) <|> 1050 | (tok Op_LShift >> return LShift ) <|> 1051 | (tok Op_LThan >> return LThan ) <|> 1052 | (try $ do 1053 | tok Op_GThan 1054 | tok Op_GThan 1055 | tok Op_GThan 1056 | return RRShift ) <|> 1057 | 1058 | (try $ do 1059 | tok Op_GThan 1060 | tok Op_GThan 1061 | return RShift ) <|> 1062 | 1063 | (tok Op_GThan >> return GThan ) <|> 1064 | (tok Op_LThanE >> return LThanE ) <|> 1065 | (tok Op_GThanE >> return GThanE ) <|> 1066 | (tok Op_Equals >> return Equal ) <|> 1067 | (tok Op_BangE >> return NotEq ) 1068 | 1069 | 1070 | ---------------------------------------------------------------------------- 1071 | -- Types 1072 | 1073 | ttype :: P Type 1074 | ttype = try (RefType <$> refType) <|> PrimType <$> primType 1075 | 1076 | primType :: P PrimType 1077 | primType = 1078 | tok KW_Boolean >> return BooleanT <|> 1079 | tok KW_Byte >> return ByteT <|> 1080 | tok KW_Short >> return ShortT <|> 1081 | tok KW_Int >> return IntT <|> 1082 | tok KW_Long >> return LongT <|> 1083 | tok KW_Char >> return CharT <|> 1084 | tok KW_Float >> return FloatT <|> 1085 | tok KW_Double >> return DoubleT 1086 | 1087 | refType :: P RefType 1088 | refType = 1089 | (do pt <- primType 1090 | (_:bs) <- list1 arrBrackets 1091 | return $ foldl (\f _ -> ArrayType . RefType . f) 1092 | (ArrayType . PrimType) bs pt) <|> 1093 | (do ct <- classType 1094 | bs <- list arrBrackets 1095 | return $ foldl (\f _ -> ArrayType . RefType . f) 1096 | ClassRefType bs ct) "refType" 1097 | 1098 | nonArrayType :: P Type 1099 | nonArrayType = PrimType <$> primType <|> 1100 | RefType <$> ClassRefType <$> classType 1101 | 1102 | classType :: P ClassType 1103 | classType = ClassType <$> seplist1 classTypeSpec period 1104 | 1105 | classTypeSpec :: P (Ident, [TypeArgument]) 1106 | classTypeSpec = do 1107 | i <- ident 1108 | tas <- lopt typeArgs 1109 | return (i, tas) 1110 | 1111 | resultType :: P (Maybe Type) 1112 | resultType = tok KW_Void >> return Nothing <|> Just <$> ttype "resultType" 1113 | 1114 | refTypeList :: P [RefType] 1115 | refTypeList = seplist1 refType comma 1116 | 1117 | ---------------------------------------------------------------------------- 1118 | -- Type parameters and arguments 1119 | 1120 | typeParams :: P [TypeParam] 1121 | typeParams = angles $ seplist1 typeParam comma 1122 | 1123 | typeParam :: P TypeParam 1124 | typeParam = do 1125 | i <- ident 1126 | bs <- lopt bounds 1127 | return $ TypeParam i bs 1128 | 1129 | bounds :: P [RefType] 1130 | bounds = tok KW_Extends >> seplist1 refType (tok Op_And) 1131 | 1132 | typeArgs :: P [TypeArgument] 1133 | typeArgs = angles $ seplist1 typeArg comma 1134 | 1135 | typeArg :: P TypeArgument 1136 | typeArg = tok Op_Query >> Wildcard <$> opt wildcardBound 1137 | <|> ActualType <$> refType 1138 | 1139 | wildcardBound :: P WildcardBound 1140 | wildcardBound = tok KW_Extends >> ExtendsBound <$> refType 1141 | <|> tok KW_Super >> SuperBound <$> refType 1142 | 1143 | refTypeArgs :: P [RefType] 1144 | refTypeArgs = angles refTypeList 1145 | 1146 | ---------------------------------------------------------------------------- 1147 | -- Names 1148 | 1149 | name :: P Name 1150 | name = Name <$> seplist1 ident period 1151 | 1152 | ident :: P Ident 1153 | ident = javaToken $ \t -> case t of 1154 | IdentTok s -> Just $ Ident s 1155 | _ -> Nothing 1156 | 1157 | ------------------------------------------------------------ 1158 | 1159 | empty :: P () 1160 | empty = return () 1161 | 1162 | opt :: P a -> P (Maybe a) 1163 | opt = optionMaybe 1164 | 1165 | bopt :: P a -> P Bool 1166 | bopt p = opt p >>= \ma -> return $ isJust ma 1167 | 1168 | lopt :: P [a] -> P [a] 1169 | lopt p = do mas <- opt p 1170 | case mas of 1171 | Nothing -> return [] 1172 | Just as -> return as 1173 | 1174 | list :: P a -> P [a] 1175 | list = option [] . list1 1176 | 1177 | list1 :: P a -> P [a] 1178 | list1 = many1 1179 | 1180 | seplist :: P a -> P sep -> P [a] 1181 | --seplist = sepBy 1182 | seplist p sep = option [] $ seplist1 p sep 1183 | 1184 | seplist1 :: P a -> P sep -> P [a] 1185 | --seplist1 = sepBy1 1186 | seplist1 p sep = 1187 | p >>= \a -> 1188 | try (do sep 1189 | as <- seplist1 p sep 1190 | return (a:as)) 1191 | <|> return [a] 1192 | 1193 | startSuff, (|>>) :: P a -> P (a -> a) -> P a 1194 | startSuff start suffix = do 1195 | x <- start 1196 | ss <- list suffix 1197 | return $ foldl (\a s -> s a) x ss 1198 | 1199 | (|>>) = startSuff 1200 | 1201 | ------------------------------------------------------------ 1202 | 1203 | javaToken :: (Token -> Maybe a) -> P a 1204 | javaToken test = token showT posT testT 1205 | where showT (L _ t) = show t 1206 | posT (L p _) = pos2sourcePos p 1207 | testT (L _ t) = test t 1208 | 1209 | tok, matchToken :: Token -> P () 1210 | tok = matchToken 1211 | matchToken t = javaToken (\r -> if r == t then Just () else Nothing) 1212 | 1213 | pos2sourcePos :: (Int, Int) -> SourcePos 1214 | pos2sourcePos (l,c) = newPos "" l c 1215 | 1216 | type Mod a = [Modifier] -> a 1217 | 1218 | parens, braces, brackets, angles :: P a -> P a 1219 | parens = between (tok OpenParen) (tok CloseParen) 1220 | braces = between (tok OpenCurly) (tok CloseCurly) 1221 | brackets = between (tok OpenSquare) (tok CloseSquare) 1222 | angles = between (tok Op_LThan) (tok Op_GThan) 1223 | 1224 | endSemi :: P a -> P a 1225 | endSemi p = p >>= \a -> semiColon >> return a 1226 | 1227 | comma, colon, semiColon, period :: P () 1228 | comma = tok Comma 1229 | colon = tok Op_Colon 1230 | semiColon = tok SemiColon 1231 | period = tok Period 1232 | 1233 | ------------------------------------------------------------ 1234 | 1235 | test = "public class Foo { }" 1236 | testFile file = do 1237 | i <- readFile file 1238 | let r = parseCompilationUnit i 1239 | putStrLn$ either (("Parsing error:\n"++) . show) (show . pretty) r 1240 | -------------------------------------------------------------------------------- /Language/Java/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Language.Java.Pretty where 3 | 4 | import Text.PrettyPrint 5 | import Text.Printf (printf) 6 | import Data.Char (toLower) 7 | import Data.List (intersperse) 8 | 9 | import Language.Java.Syntax 10 | 11 | #if MIN_VERSION_base(4,11,0) 12 | import Prelude hiding ((<>)) 13 | #endif 14 | 15 | prettyPrint :: Pretty a => a -> String 16 | prettyPrint = show . pretty 17 | 18 | parenPrec :: Int -> Int -> Doc -> Doc 19 | parenPrec inheritedPrec currentPrec t 20 | | inheritedPrec <= 0 = t 21 | | inheritedPrec < currentPrec = parens t 22 | | otherwise = t 23 | 24 | class Pretty a where 25 | pretty :: a -> Doc 26 | pretty = prettyPrec 0 27 | 28 | prettyPrec :: Int -> a -> Doc 29 | prettyPrec _ = pretty 30 | 31 | ----------------------------------------------------------------------- 32 | -- Packages 33 | 34 | instance Pretty CompilationUnit where 35 | prettyPrec p (CompilationUnit mpd ids tds) = 36 | vcat $ ((maybePP p mpd): map (prettyPrec p) ids) ++ map (prettyPrec p) tds 37 | 38 | instance Pretty PackageDecl where 39 | prettyPrec p (PackageDecl name) = text "package" <+> prettyPrec p name <> semi 40 | 41 | instance Pretty ImportDecl where 42 | prettyPrec p (ImportDecl st name wc) = 43 | text "import" <+> opt st (text "static") 44 | <+> prettyPrec p name <> opt wc (text ".*") 45 | <> semi 46 | 47 | ----------------------------------------------------------------------- 48 | -- Declarations 49 | 50 | instance Pretty TypeDecl where 51 | prettyPrec p (ClassTypeDecl cd) = prettyPrec p cd 52 | prettyPrec p (InterfaceTypeDecl id) = prettyPrec p id 53 | 54 | instance Pretty ClassDecl where 55 | prettyPrec p (EnumDecl mods ident impls body) = 56 | hsep [hsep (map (prettyPrec p) mods) 57 | , text "enum" 58 | , prettyPrec p ident 59 | , ppImplements p impls 60 | ] $$ prettyPrec p body 61 | 62 | prettyPrec p (ClassDecl mods ident tParams mSuper impls body) = 63 | hsep [hsep (map (prettyPrec p) mods) 64 | , text "class" 65 | , prettyPrec p ident 66 | , ppTypeParams p tParams 67 | , ppExtends p (maybe [] return mSuper) 68 | , ppImplements p impls 69 | ] $$ prettyPrec p body 70 | 71 | instance Pretty ClassBody where 72 | prettyPrec p (ClassBody ds) = 73 | braceBlock (map (prettyPrec p) ds) 74 | 75 | instance Pretty EnumBody where 76 | prettyPrec p (EnumBody cs ds) = 77 | braceBlock $ 78 | punctuate comma (map (prettyPrec p) cs) ++ 79 | opt (not $ null ds) semi : map (prettyPrec p) ds 80 | 81 | instance Pretty EnumConstant where 82 | prettyPrec p (EnumConstant ident args mBody) = 83 | prettyPrec p ident 84 | -- needs special treatment since even the parens are optional 85 | <> opt (not $ null args) (ppArgs p args) 86 | $$ maybePP p mBody 87 | 88 | instance Pretty InterfaceDecl where 89 | prettyPrec p (InterfaceDecl kind mods ident tParams impls body) = 90 | hsep [hsep (map (prettyPrec p) mods) 91 | , text (if kind == InterfaceNormal then "interface" else "@interface") 92 | , prettyPrec p ident 93 | , ppTypeParams p tParams 94 | , ppExtends p impls 95 | ] $$ prettyPrec p body 96 | 97 | instance Pretty InterfaceBody where 98 | prettyPrec p (InterfaceBody mds) = 99 | braceBlock (map (prettyPrec p) mds) 100 | 101 | instance Pretty Decl where 102 | prettyPrec p (MemberDecl md) = prettyPrec p md 103 | prettyPrec p (InitDecl b bl) = 104 | opt b (text "static") <+> prettyPrec p bl 105 | 106 | instance Pretty MemberDecl where 107 | prettyPrec p (FieldDecl mods t vds) = 108 | hsep (map (prettyPrec p) mods ++ prettyPrec p t:punctuate (text ",") (map (prettyPrec p) vds)) <> semi 109 | 110 | prettyPrec p (MethodDecl mods tParams mt ident fParams throws def body) = 111 | hsep [hsep (map (prettyPrec p) mods) 112 | , ppTypeParams p tParams 113 | , ppResultType p mt 114 | , prettyPrec p ident 115 | , ppArgs p fParams 116 | , ppThrows p throws 117 | , ppDefault p def 118 | ] $$ prettyPrec p body 119 | 120 | prettyPrec p (ConstructorDecl mods tParams ident fParams throws body) = 121 | hsep [hsep (map (prettyPrec p) mods) 122 | , ppTypeParams p tParams 123 | , prettyPrec p ident 124 | , ppArgs p fParams 125 | , ppThrows p throws 126 | ] $$ prettyPrec p body 127 | 128 | prettyPrec p (MemberClassDecl cd) = prettyPrec p cd 129 | prettyPrec p (MemberInterfaceDecl id) = prettyPrec p id 130 | 131 | instance Pretty VarDecl where 132 | prettyPrec p (VarDecl vdId Nothing) = prettyPrec p vdId 133 | prettyPrec p (VarDecl vdId (Just ie)) = 134 | (prettyPrec p vdId <+> char '=') <+> prettyPrec p ie 135 | 136 | instance Pretty VarDeclId where 137 | prettyPrec p (VarId ident) = prettyPrec p ident 138 | prettyPrec p (VarDeclArray vId) = prettyPrec p vId <> text "[]" 139 | 140 | instance Pretty VarInit where 141 | prettyPrec p (InitExp e) = prettyPrec p e 142 | prettyPrec p (InitArray (ArrayInit ai)) = 143 | text "{" <+> hsep (punctuate comma (map (prettyPrec p) ai)) <+> text "}" 144 | 145 | instance Pretty FormalParam where 146 | prettyPrec p (FormalParam mods t b vId) = 147 | hsep [hsep (map (prettyPrec p) mods) 148 | , prettyPrec p t <> opt b (text "...") 149 | , prettyPrec p vId 150 | ] 151 | 152 | instance Pretty MethodBody where 153 | prettyPrec p (MethodBody mBlock) = maybe semi (prettyPrec p) mBlock 154 | 155 | instance Pretty ConstructorBody where 156 | prettyPrec p (ConstructorBody mECI stmts) = 157 | braceBlock $ maybePP p mECI : map (prettyPrec p) stmts 158 | 159 | instance Pretty ExplConstrInv where 160 | prettyPrec p (ThisInvoke rts args) = 161 | ppTypeParams p rts <+> text "this" <> ppArgs p args <> semi 162 | prettyPrec p (SuperInvoke rts args) = 163 | ppTypeParams p rts <+> text "super" <> ppArgs p args <> semi 164 | prettyPrec p (PrimarySuperInvoke e rts args) = 165 | prettyPrec p e <> char '.' <> 166 | ppTypeParams p rts <+> text "super" <> ppArgs p args <> semi 167 | 168 | instance Pretty Modifier where 169 | prettyPrec p (Annotation ann) = prettyPrec p ann $+$ nest (-1) ( text "") 170 | prettyPrec p mod = text . map toLower $ show mod 171 | 172 | instance Pretty Annotation where 173 | prettyPrec p x = text "@" <> prettyPrec p (annName x) <> case x of 174 | MarkerAnnotation {} -> text "" 175 | SingleElementAnnotation {} -> text "(" <> prettyPrec p (annValue x) <> text ")" 176 | NormalAnnotation {} -> text "(" <> ppEVList p (annKV x) <> text ")" 177 | 178 | ppEVList p = hsep . punctuate comma . map (\(k,v) -> prettyPrec p k <+> text "=" <+> prettyPrec p v) 179 | 180 | instance Pretty ElementValue where 181 | prettyPrec p (EVVal vi) = prettyPrec p vi 182 | prettyPrec p (EVAnn ann) = prettyPrec p ann 183 | 184 | ----------------------------------------------------------------------- 185 | -- Statements 186 | 187 | 188 | instance Pretty Block where 189 | prettyPrec p (Block stmts) = braceBlock $ map (prettyPrec p) stmts 190 | 191 | instance Pretty BlockStmt where 192 | prettyPrec p (BlockStmt stmt) = prettyPrec p stmt 193 | prettyPrec p (LocalClass cd) = prettyPrec p cd 194 | prettyPrec p (LocalVars mods t vds) = 195 | hsep (map (prettyPrec p) mods) <+> prettyPrec p t <+> 196 | hsep (punctuate comma $ map (prettyPrec p) vds) <> semi 197 | 198 | instance Pretty Stmt where 199 | prettyPrec p (StmtBlock block) = prettyPrec p block 200 | prettyPrec p (IfThen c th) = 201 | text "if" <+> parens (prettyPrec 0 c) $+$ prettyNestedStmt 0 th 202 | 203 | prettyPrec p (IfThenElse c th el) = 204 | text "if" <+> parens (prettyPrec p c) $+$ prettyNestedStmt 0 th $+$ text "else" $+$ prettyNestedStmt 0 el 205 | 206 | prettyPrec p (While c stmt) = 207 | text "while" <+> parens (prettyPrec p c) $+$ prettyNestedStmt 0 stmt 208 | 209 | prettyPrec p (BasicFor mInit mE mUp stmt) = 210 | text "for" <+> (parens $ hsep [maybePP p mInit, semi 211 | , maybePP p mE, semi 212 | , maybe empty (hsep . punctuate comma . map (prettyPrec p)) mUp 213 | ]) $+$ prettyNestedStmt p stmt 214 | 215 | prettyPrec p (EnhancedFor mods t ident e stmt) = 216 | hsep [text "for" 217 | , parens $ hsep [ 218 | hsep (map (prettyPrec p) mods) 219 | , prettyPrec p t 220 | , prettyPrec p ident 221 | , colon 222 | , prettyPrec p e 223 | ] 224 | , prettyPrec p stmt 225 | ] 226 | 227 | prettyPrec p Empty = semi 228 | 229 | prettyPrec p (ExpStmt e) = prettyPrec p e <> semi 230 | 231 | prettyPrec p (Assert ass mE) = 232 | text "assert" <+> prettyPrec p ass 233 | <+> maybe empty ((colon <>) . prettyPrec p) mE <> semi 234 | 235 | prettyPrec p (Switch e sBlocks) = 236 | text "switch" <+> parens (prettyPrec p e) 237 | $$ braceBlock (map (prettyPrec p) sBlocks) 238 | 239 | prettyPrec p (Do stmt e) = 240 | text "do" $+$ prettyPrec p stmt <+> text "while" <+> parens (prettyPrec p e) <> semi 241 | 242 | prettyPrec p (Break mIdent) = 243 | text "break" <+> maybePP p mIdent <> semi 244 | 245 | prettyPrec p (Continue mIdent) = 246 | text "continue" <+> maybePP p mIdent <> semi 247 | 248 | prettyPrec p (Return mE) = 249 | text "return" <+> maybePP p mE <> semi 250 | 251 | prettyPrec p (Synchronized e block) = 252 | text "synchronized" <+> parens (prettyPrec p e) $$ prettyPrec p block 253 | 254 | prettyPrec p (Throw e) = 255 | text "throw" <+> prettyPrec p e <> semi 256 | 257 | prettyPrec p (Try block catches mFinally) = 258 | text "try" $$ prettyPrec p block $$ 259 | vcat (map (prettyPrec p) catches ++ [ppFinally mFinally]) 260 | where ppFinally Nothing = empty 261 | ppFinally (Just bl) = text "finally" <+> prettyPrec p bl 262 | 263 | prettyPrec p (Labeled ident stmt) = 264 | prettyPrec p ident <> colon <+> prettyPrec p stmt 265 | 266 | instance Pretty Catch where 267 | prettyPrec p (Catch fParam block) = 268 | hsep [text "catch", parens (prettyPrec p fParam)] $$ prettyPrec p block 269 | 270 | instance Pretty SwitchBlock where 271 | prettyPrec p (SwitchBlock lbl stmts) = 272 | vcat (prettyPrec p lbl : map (nest 2 . prettyPrec p) stmts) 273 | 274 | instance Pretty SwitchLabel where 275 | prettyPrec p (SwitchCase e) = 276 | text "case" <+> prettyPrec p e <> colon 277 | prettyPrec p Default = text "default:" 278 | 279 | instance Pretty ForInit where 280 | prettyPrec p (ForLocalVars mods t vds) = 281 | hsep $ map (prettyPrec p) mods ++ 282 | prettyPrec p t: punctuate comma (map (prettyPrec p) vds) 283 | prettyPrec p (ForInitExps es) = 284 | hsep $ punctuate comma (map (prettyPrec p) es) 285 | 286 | 287 | ----------------------------------------------------------------------- 288 | -- Expressions 289 | 290 | instance Pretty Exp where 291 | prettyPrec p (Lit l) = prettyPrec p l 292 | 293 | prettyPrec p (ClassLit mT) = 294 | ppResultType p mT <> text ".class" 295 | 296 | prettyPrec _ This = text "this" 297 | 298 | prettyPrec p (ThisClass name) = 299 | prettyPrec p name <> text ".this" 300 | 301 | prettyPrec p (InstanceCreation tArgs tds args mBody) = 302 | hsep [text "new" 303 | , ppTypeParams p tArgs 304 | , prettyPrec p tds <> ppArgs p args 305 | ] $$ maybePP p mBody 306 | 307 | prettyPrec p (QualInstanceCreation e tArgs ident args mBody) = 308 | hsep [prettyPrec p e <> char '.' <> text "new" 309 | , ppTypeParams p tArgs 310 | , prettyPrec p ident <> ppArgs p args 311 | ] $$ maybePP p mBody 312 | 313 | prettyPrec p (ArrayCreate t es k) = 314 | text "new" <+> 315 | hcat (prettyPrec p t : map (brackets . prettyPrec p) es 316 | ++ replicate k (text "[]")) 317 | 318 | prettyPrec p (ArrayCreateInit t k init) = 319 | text "new" 320 | <+> hcat (prettyPrec p t : replicate k (text "[]")) 321 | <+> prettyPrec p init 322 | 323 | prettyPrec p (FieldAccess fa) = parenPrec p 1 $ prettyPrec 1 fa 324 | 325 | prettyPrec p (MethodInv mi) = parenPrec p 1 $ prettyPrec 1 mi 326 | 327 | prettyPrec p (ArrayAccess ain) = parenPrec p 1 $ prettyPrec 1 ain 328 | 329 | prettyPrec p (ExpName name) = prettyPrec p name 330 | 331 | prettyPrec p (PostIncrement e) = parenPrec p 1 $ prettyPrec 2 e <> text "++" 332 | 333 | prettyPrec p (PostDecrement e) = parenPrec p 1 $ prettyPrec 2 e <> text "--" 334 | 335 | prettyPrec p (PreIncrement e) = parenPrec p 1 $ text "++" <> prettyPrec 2 e 336 | 337 | prettyPrec p (PreDecrement e) = parenPrec p 1 $ text "--" <> prettyPrec 2 e 338 | 339 | prettyPrec p (PrePlus e) = parenPrec p 2 $ char '+' <> prettyPrec 2 e 340 | 341 | prettyPrec p (PreMinus e) = parenPrec p 2 $ char '-' <> prettyPrec 2 e 342 | 343 | prettyPrec p (PreBitCompl e) = parenPrec p 2 $ char '~' <> prettyPrec 2 e 344 | 345 | prettyPrec p (PreNot e) = parenPrec p 2 $ char '!' <> prettyPrec 2 e 346 | 347 | prettyPrec p (Cast t e) = parenPrec p 2 $ parens (prettyPrec p t) <+> prettyPrec 2 e 348 | 349 | prettyPrec p (BinOp e1 op e2) = 350 | let prec = opPrec op in 351 | parenPrec p prec (prettyPrec prec e1 <+> prettyPrec p op <+> prettyPrec prec e2) 352 | 353 | prettyPrec p (InstanceOf e rt) = 354 | let cp = opPrec LThan in 355 | parenPrec p cp $ prettyPrec cp e 356 | <+> text "instanceof" <+> prettyPrec cp rt 357 | 358 | prettyPrec p (Cond c th el) = 359 | parenPrec p 13 $ prettyPrec 13 c <+> char '?' 360 | <+> prettyPrec p th <+> colon <+> prettyPrec 13 el 361 | 362 | prettyPrec p (Assign lhs aop e) = 363 | hsep [prettyPrec p lhs, prettyPrec p aop, prettyPrec p e] 364 | 365 | prettyPrec p (Lambda params body) = 366 | prettyPrec p params <+> text "->" <+> prettyPrec p body 367 | 368 | prettyPrec p (MethodRef i1 i2) = 369 | prettyPrec p i1 <+> text "::" <+> prettyPrec p i2 370 | 371 | instance Pretty LambdaParams where 372 | prettyPrec p (LambdaSingleParam ident) = prettyPrec p ident 373 | prettyPrec p (LambdaFormalParams params) = ppArgs p params 374 | prettyPrec p (LambdaInferredParams idents) = ppArgs p idents 375 | 376 | instance Pretty LambdaExpression where 377 | prettyPrec p (LambdaExpression exp) = prettyPrec p exp 378 | prettyPrec p (LambdaBlock block) = prettyPrec p block 379 | 380 | instance Pretty Literal where 381 | prettyPrec p (Int i) = text (show i) 382 | prettyPrec p (Word i) = text (show i) <> char 'L' 383 | prettyPrec p (Float f) = text (show f) <> char 'F' 384 | prettyPrec p (Double d) = text (show d) 385 | prettyPrec p (Boolean b) = text . map toLower $ show b 386 | prettyPrec p (Char c) = quotes $ text (escapeChar c) 387 | prettyPrec p (String s) = doubleQuotes $ text (concatMap escapeString s) 388 | prettyPrec p (Null) = text "null" 389 | 390 | instance Pretty Op where 391 | prettyPrec p op = text $ case op of 392 | Mult -> "*" 393 | Div -> "/" 394 | Rem -> "%" 395 | Add -> "+" 396 | Sub -> "-" 397 | LShift -> "<<" 398 | RShift -> ">>" 399 | RRShift -> ">>>" 400 | LThan -> "<" 401 | GThan -> ">" 402 | LThanE -> "<=" 403 | GThanE -> ">=" 404 | Equal -> "==" 405 | NotEq -> "!=" 406 | And -> "&" 407 | Xor -> "^" 408 | Or -> "|" 409 | CAnd -> "&&" 410 | COr -> "||" 411 | 412 | instance Pretty AssignOp where 413 | prettyPrec p aop = text $ case aop of 414 | EqualA -> "=" 415 | MultA -> "*=" 416 | DivA -> "/=" 417 | RemA -> "%=" 418 | AddA -> "+=" 419 | SubA -> "-=" 420 | LShiftA -> "<<=" 421 | RShiftA -> ">>=" 422 | RRShiftA -> ">>>=" 423 | AndA -> "&=" 424 | XorA -> "^=" 425 | OrA -> "|=" 426 | 427 | instance Pretty Lhs where 428 | prettyPrec p (NameLhs name) = prettyPrec p name 429 | prettyPrec p (FieldLhs fa) = prettyPrec p fa 430 | prettyPrec p (ArrayLhs ain) = prettyPrec p ain 431 | 432 | instance Pretty ArrayIndex where 433 | prettyPrec p (ArrayIndex ref e) = prettyPrec p ref <> (hcat $ map (brackets . (prettyPrec p)) e) 434 | 435 | instance Pretty FieldAccess where 436 | prettyPrec p (PrimaryFieldAccess e ident) = 437 | prettyPrec p e <> char '.' <> prettyPrec p ident 438 | prettyPrec p (SuperFieldAccess ident) = 439 | text "super." <> prettyPrec p ident 440 | prettyPrec p (ClassFieldAccess name ident) = 441 | prettyPrec p name <> text "." <> prettyPrec p ident 442 | 443 | instance Pretty MethodInvocation where 444 | prettyPrec p (MethodCall name args) = 445 | prettyPrec p name <> ppArgs p args 446 | 447 | prettyPrec p (PrimaryMethodCall e tArgs ident args) = 448 | hcat [prettyPrec p e, char '.', ppTypeParams p tArgs, 449 | prettyPrec p ident, ppArgs p args] 450 | 451 | prettyPrec p (SuperMethodCall tArgs ident args) = 452 | hcat [text "super.", ppTypeParams p tArgs, 453 | prettyPrec p ident, ppArgs p args] 454 | 455 | prettyPrec p (ClassMethodCall name tArgs ident args) = 456 | hcat [prettyPrec p name, text ".super.", ppTypeParams p tArgs, 457 | prettyPrec p ident, ppArgs p args] 458 | 459 | prettyPrec p (TypeMethodCall name tArgs ident args) = 460 | hcat [prettyPrec p name, char '.', ppTypeParams p tArgs, 461 | prettyPrec p ident, ppArgs p args] 462 | 463 | instance Pretty ArrayInit where 464 | prettyPrec p (ArrayInit vInits) = 465 | braceBlock $ map (\v -> prettyPrec p v <> comma) vInits 466 | --braces $ hsep (punctuate comma (map (prettyPrec p) vInits)) 467 | 468 | 469 | ppArgs :: Pretty a => Int -> [a] -> Doc 470 | ppArgs p = parens . hsep . punctuate comma . map (prettyPrec p) 471 | 472 | ----------------------------------------------------------------------- 473 | -- Types 474 | 475 | instance Pretty Type where 476 | prettyPrec p (PrimType pt) = prettyPrec p pt 477 | prettyPrec p (RefType rt) = prettyPrec p rt 478 | 479 | instance Pretty RefType where 480 | prettyPrec p (ClassRefType ct) = prettyPrec p ct 481 | prettyPrec p (ArrayType t) = prettyPrec p t <> text "[]" 482 | 483 | instance Pretty ClassType where 484 | prettyPrec p (ClassType itas) = 485 | hcat . punctuate (char '.') $ 486 | map (\(i,tas) -> prettyPrec p i <> ppTypeParams p tas) itas 487 | 488 | instance Pretty TypeArgument where 489 | prettyPrec p (ActualType rt) = prettyPrec p rt 490 | prettyPrec p (Wildcard mBound) = char '?' <+> maybePP p mBound 491 | 492 | instance Pretty TypeDeclSpecifier where 493 | prettyPrec p (TypeDeclSpecifier ct) = prettyPrec p ct 494 | prettyPrec p (TypeDeclSpecifierWithDiamond ct i d) = prettyPrec p ct <> char '.' <> prettyPrec p i <> prettyPrec p d 495 | prettyPrec p (TypeDeclSpecifierUnqualifiedWithDiamond i d) = prettyPrec p i <> prettyPrec p d 496 | 497 | instance Pretty Diamond where 498 | prettyPrec p Diamond = text "<>" 499 | 500 | instance Pretty WildcardBound where 501 | prettyPrec p (ExtendsBound rt) = text "extends" <+> prettyPrec p rt 502 | prettyPrec p (SuperBound rt) = text "super" <+> prettyPrec p rt 503 | 504 | instance Pretty PrimType where 505 | prettyPrec p BooleanT = text "boolean" 506 | prettyPrec p ByteT = text "byte" 507 | prettyPrec p ShortT = text "short" 508 | prettyPrec p IntT = text "int" 509 | prettyPrec p LongT = text "long" 510 | prettyPrec p CharT = text "char" 511 | prettyPrec p FloatT = text "float" 512 | prettyPrec p DoubleT = text "double" 513 | 514 | instance Pretty TypeParam where 515 | prettyPrec p (TypeParam ident rts) = 516 | prettyPrec p ident 517 | <+> opt (not $ null rts) 518 | (hsep $ text "extends": 519 | punctuate (text " &") (map (prettyPrec p) rts)) 520 | 521 | ppTypeParams :: Pretty a => Int -> [a] -> Doc 522 | ppTypeParams _ [] = empty 523 | ppTypeParams p tps = char '<' 524 | <> hsep (punctuate comma (map (prettyPrec p) tps)) 525 | <> char '>' 526 | 527 | ppImplements :: Int -> [RefType] -> Doc 528 | ppImplements _ [] = empty 529 | ppImplements p rts = text "implements" 530 | <+> hsep (punctuate comma (map (prettyPrec p) rts)) 531 | 532 | ppExtends :: Int -> [RefType] -> Doc 533 | ppExtends _ [] = empty 534 | ppExtends p rts = text "extends" 535 | <+> hsep (punctuate comma (map (prettyPrec p) rts)) 536 | 537 | ppThrows :: Int -> [ExceptionType] -> Doc 538 | ppThrows _ [] = empty 539 | ppThrows p ets = text "throws" 540 | <+> hsep (punctuate comma (map (prettyPrec p) ets)) 541 | 542 | ppDefault :: Int -> Maybe Exp -> Doc 543 | ppDefault _ Nothing = empty 544 | ppDefault p (Just exp) = text "default" <+> prettyPrec p exp 545 | 546 | ppResultType :: Int -> Maybe Type -> Doc 547 | ppResultType _ Nothing = text "void" 548 | ppResultType p (Just a) = prettyPrec p a 549 | 550 | ----------------------------------------------------------------------- 551 | -- Names and identifiers 552 | 553 | instance Pretty Name where 554 | prettyPrec p (Name is) = 555 | hcat (punctuate (char '.') $ map (prettyPrec p) is) 556 | 557 | instance Pretty Ident where 558 | prettyPrec p (Ident s) = text s 559 | 560 | 561 | ----------------------------------------------------------------------- 562 | -- Help functionality 563 | prettyNestedStmt :: Int -> Stmt -> Doc 564 | prettyNestedStmt prio p@(StmtBlock b) = prettyPrec prio p 565 | prettyNestedStmt prio p = nest 2 (prettyPrec prio p) 566 | 567 | maybePP :: Pretty a => Int -> Maybe a -> Doc 568 | maybePP p = maybe empty (prettyPrec p) 569 | 570 | opt :: Bool -> Doc -> Doc 571 | opt x a = if x then a else empty 572 | 573 | braceBlock :: [Doc] -> Doc 574 | braceBlock xs = char '{' 575 | $+$ nest 2 (vcat xs) 576 | $+$ char '}' 577 | 578 | opPrec Mult = 3 579 | opPrec Div = 3 580 | opPrec Rem = 3 581 | opPrec Add = 4 582 | opPrec Sub = 4 583 | opPrec LShift = 5 584 | opPrec RShift = 5 585 | opPrec RRShift = 5 586 | opPrec LThan = 6 587 | opPrec GThan = 6 588 | opPrec LThanE = 6 589 | opPrec GThanE = 6 590 | opPrec Equal = 7 591 | opPrec NotEq = 7 592 | opPrec And = 8 593 | opPrec Xor = 9 594 | opPrec Or = 10 595 | opPrec CAnd = 11 596 | opPrec COr = 12 597 | 598 | escapeGeneral :: Char -> String 599 | escapeGeneral '\b' = "\\b" 600 | escapeGeneral '\t' = "\\t" 601 | escapeGeneral '\n' = "\\n" 602 | escapeGeneral '\f' = "\\f" 603 | escapeGeneral '\r' = "\\r" 604 | escapeGeneral '\\' = "\\\\" 605 | escapeGeneral c | c >= ' ' && c < '\DEL' = [c] 606 | | c <= '\xFFFF' = printf "\\u%04x" (fromEnum c) 607 | | otherwise = error $ "Language.Java.Pretty.escapeGeneral: Char " ++ show c ++ " too large for Java char" 608 | 609 | escapeChar :: Char -> String 610 | escapeChar '\'' = "\\'" 611 | escapeChar c = escapeGeneral c 612 | 613 | escapeString :: Char -> String 614 | escapeString '"' = "\\\"" 615 | escapeString c | c <= '\xFFFF' = escapeGeneral c 616 | | otherwise = escapeGeneral lead ++ escapeGeneral trail 617 | where c' = fromEnum c - 0x010000 618 | lead = toEnum $ 0xD800 + c' `div` 0x0400 619 | trail = toEnum $ 0xDC00 + c' `mod` 0x0400 620 | -------------------------------------------------------------------------------- /Language/Java/Syntax.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} 2 | module Language.Java.Syntax 3 | ( CompilationUnit(..) 4 | , PackageDecl(..) 5 | , ImportDecl(..) 6 | , TypeDecl(..) 7 | , ClassDecl(..) 8 | , ClassBody(..) 9 | , EnumBody(..) 10 | , EnumConstant(..) 11 | , InterfaceDecl(..) 12 | , InterfaceBody(..) 13 | , InterfaceKind(..) 14 | , Decl(..) 15 | , MemberDecl(..) 16 | , VarDecl(..) 17 | , VarDeclId(..) 18 | , VarInit(..) 19 | , FormalParam(..) 20 | , MethodBody(..) 21 | , ConstructorBody(..) 22 | , ExplConstrInv(..) 23 | , Modifier(..) 24 | , Annotation(..) 25 | , desugarAnnotation 26 | , desugarAnnotation' 27 | , ElementValue(..) 28 | , Block(..) 29 | , BlockStmt(..) 30 | , Stmt(..) 31 | , Catch(..) 32 | , SwitchBlock(..) 33 | , SwitchLabel(..) 34 | , ForInit(..) 35 | , ExceptionType 36 | , Argument 37 | , Exp(..) 38 | , Lhs(..) 39 | , ArrayIndex(..) 40 | , FieldAccess(..) 41 | , LambdaParams(..) 42 | , LambdaExpression(..) 43 | , ArrayInit(..) 44 | , MethodInvocation(..) 45 | , module Language.Java.Syntax.Exp 46 | , module Language.Java.Syntax.Types 47 | ) where 48 | 49 | import Data.Data 50 | import GHC.Generics (Generic) 51 | 52 | import Language.Java.Syntax.Types 53 | import Language.Java.Syntax.Exp 54 | 55 | ----------------------------------------------------------------------- 56 | -- Packages 57 | 58 | 59 | -- | A compilation unit is the top level syntactic goal symbol of a Java program. 60 | data CompilationUnit = CompilationUnit (Maybe PackageDecl) [ImportDecl] [TypeDecl] 61 | deriving (Eq,Show,Read,Typeable,Generic,Data) 62 | 63 | 64 | -- | A package declaration appears within a compilation unit to indicate the package to which the compilation unit belongs. 65 | newtype PackageDecl = PackageDecl Name 66 | deriving (Eq,Show,Read,Typeable,Generic,Data) 67 | 68 | -- | An import declaration allows a static member or a named type to be referred to by a single unqualified identifier. 69 | -- The first argument signals whether the declaration only imports static members. 70 | -- The last argument signals whether the declaration brings all names in the named type or package, or only brings 71 | -- a single name into scope. 72 | data ImportDecl 73 | = ImportDecl Bool {- static? -} Name Bool {- .*? -} 74 | deriving (Eq,Show,Read,Typeable,Generic,Data) 75 | 76 | 77 | ----------------------------------------------------------------------- 78 | -- Declarations 79 | 80 | -- | A type declaration declares a class type or an interface type. 81 | data TypeDecl 82 | = ClassTypeDecl ClassDecl 83 | | InterfaceTypeDecl InterfaceDecl 84 | deriving (Eq,Show,Read,Typeable,Generic,Data) 85 | 86 | -- | A class declaration specifies a new named reference type. 87 | data ClassDecl 88 | = ClassDecl [Modifier] Ident [TypeParam] (Maybe RefType) [RefType] ClassBody 89 | | EnumDecl [Modifier] Ident [RefType] EnumBody 90 | deriving (Eq,Show,Read,Typeable,Generic,Data) 91 | 92 | -- | A class body may contain declarations of members of the class, that is, 93 | -- fields, classes, interfaces and methods. 94 | -- A class body may also contain instance initializers, static 95 | -- initializers, and declarations of constructors for the class. 96 | newtype ClassBody = ClassBody [Decl] 97 | deriving (Eq,Show,Read,Typeable,Generic,Data) 98 | 99 | -- | The body of an enum type may contain enum constants. 100 | data EnumBody = EnumBody [EnumConstant] [Decl] 101 | deriving (Eq,Show,Read,Typeable,Generic,Data) 102 | 103 | -- | An enum constant defines an instance of the enum type. 104 | data EnumConstant = EnumConstant Ident [Argument] (Maybe ClassBody) 105 | deriving (Eq,Show,Read,Typeable,Generic,Data) 106 | 107 | -- | An interface declaration introduces a new reference type whose members 108 | -- are classes, interfaces, constants and abstract methods. This type has 109 | -- no implementation, but otherwise unrelated classes can implement it by 110 | -- providing implementations for its abstract methods. 111 | data InterfaceDecl 112 | = InterfaceDecl InterfaceKind [Modifier] Ident [TypeParam] [RefType] InterfaceBody 113 | deriving (Eq,Show,Read,Typeable,Generic,Data) 114 | 115 | -- | Interface can declare either a normal interface or an annotation 116 | data InterfaceKind = InterfaceNormal | InterfaceAnnotation 117 | deriving (Eq,Show,Read,Typeable,Generic,Data) 118 | 119 | -- | The body of an interface may declare members of the interface. 120 | newtype InterfaceBody 121 | = InterfaceBody [MemberDecl] 122 | deriving (Eq,Show,Read,Typeable,Generic,Data) 123 | 124 | -- | A declaration is either a member declaration, or a declaration of an 125 | -- initializer, which may be static. 126 | data Decl 127 | = MemberDecl MemberDecl 128 | | InitDecl Bool Block 129 | deriving (Eq,Show,Read,Typeable,Generic,Data) 130 | 131 | 132 | -- | A class or interface member can be an inner class or interface, a field or 133 | -- constant, or a method or constructor. An interface may only have as members 134 | -- constants (not fields), abstract methods, and no constructors. 135 | data MemberDecl 136 | -- | The variables of a class type are introduced by field declarations. 137 | = FieldDecl [Modifier] Type [VarDecl] 138 | -- | A method declares executable code that can be invoked, passing a fixed number of values as arguments. 139 | | MethodDecl [Modifier] [TypeParam] (Maybe Type) Ident [FormalParam] [ExceptionType] (Maybe Exp) MethodBody 140 | -- | A constructor is used in the creation of an object that is an instance of a class. 141 | | ConstructorDecl [Modifier] [TypeParam] Ident [FormalParam] [ExceptionType] ConstructorBody 142 | -- | A member class is a class whose declaration is directly enclosed in another class or interface declaration. 143 | | MemberClassDecl ClassDecl 144 | -- | A member interface is an interface whose declaration is directly enclosed in another class or interface declaration. 145 | | MemberInterfaceDecl InterfaceDecl 146 | deriving (Eq,Show,Read,Typeable,Generic,Data) 147 | 148 | 149 | -- | A declaration of a variable, which may be explicitly initialized. 150 | data VarDecl 151 | = VarDecl VarDeclId (Maybe VarInit) 152 | deriving (Eq,Show,Read,Typeable,Generic,Data) 153 | 154 | -- | The name of a variable in a declaration, which may be an array. 155 | data VarDeclId 156 | = VarId Ident 157 | | VarDeclArray VarDeclId 158 | -- ^ Multi-dimensional arrays are represented by nested applications of 'VarDeclArray'. 159 | deriving (Eq,Show,Read,Typeable,Generic,Data) 160 | 161 | -- | Explicit initializer for a variable declaration. 162 | data VarInit 163 | = InitExp Exp 164 | | InitArray ArrayInit 165 | deriving (Eq,Show,Read,Typeable,Generic,Data) 166 | 167 | -- | A formal parameter in method declaration. The last parameter 168 | -- for a given declaration may be marked as variable arity, 169 | -- indicated by the boolean argument. 170 | data FormalParam = FormalParam [Modifier] Type Bool VarDeclId 171 | deriving (Eq,Show,Read,Typeable,Generic,Data) 172 | 173 | -- | A method body is either a block of code that implements the method or simply a 174 | -- semicolon, indicating the lack of an implementation (modelled by 'Nothing'). 175 | newtype MethodBody = MethodBody (Maybe Block) 176 | deriving (Eq,Show,Read,Typeable,Generic,Data) 177 | 178 | -- | The first statement of a constructor body may be an explicit invocation of 179 | -- another constructor of the same class or of the direct superclass. 180 | data ConstructorBody = ConstructorBody (Maybe ExplConstrInv) [BlockStmt] 181 | deriving (Eq,Show,Read,Typeable,Generic,Data) 182 | 183 | -- | An explicit constructor invocation invokes another constructor of the 184 | -- same class, or a constructor of the direct superclass, which may 185 | -- be qualified to explicitly specify the newly created object's immediately 186 | -- enclosing instance. 187 | data ExplConstrInv 188 | = ThisInvoke [RefType] [Argument] 189 | | SuperInvoke [RefType] [Argument] 190 | | PrimarySuperInvoke Exp [RefType] [Argument] 191 | deriving (Eq,Show,Read,Typeable,Generic,Data) 192 | 193 | 194 | -- | A modifier specifying properties of a given declaration. In general only 195 | -- a few of these modifiers are allowed for each declaration type, for instance 196 | -- a member type declaration may only specify one of public, private or protected. 197 | data Modifier 198 | = Public 199 | | Private 200 | | Protected 201 | | Abstract 202 | | Final 203 | | Static 204 | | StrictFP 205 | | Transient 206 | | Volatile 207 | | Native 208 | | Annotation Annotation 209 | | Synchronized_ 210 | deriving (Eq,Read,Typeable,Generic,Data) 211 | 212 | instance Show Modifier where 213 | show Public = "public" 214 | show Private = "private" 215 | show Protected = "protected" 216 | show Abstract = "abstract" 217 | show Final = "final" 218 | show Static = "static" 219 | show StrictFP = "strictfp" 220 | show Transient = "transient" 221 | show Volatile = "volatile" 222 | show Native = "native" 223 | show (Annotation a) = show a 224 | show Synchronized_ = "synchronized" 225 | 226 | -- | Annotations have three different forms: no-parameter, single-parameter or key-value pairs 227 | data Annotation = NormalAnnotation { annName :: Name -- Not type because not type generics not allowed 228 | , annKV :: [(Ident, ElementValue)] } 229 | | SingleElementAnnotation { annName :: Name 230 | , annValue:: ElementValue } 231 | | MarkerAnnotation { annName :: Name } 232 | deriving (Eq,Show,Read,Typeable,Generic,Data) 233 | 234 | desugarAnnotation (MarkerAnnotation n) = (n, []) 235 | desugarAnnotation (SingleElementAnnotation n e) = (n, [(Ident "value", e)]) 236 | desugarAnnotation (NormalAnnotation n kv) = (n, kv) 237 | desugarAnnotation' = uncurry NormalAnnotation . desugarAnnotation 238 | 239 | -- | Annotations may contain annotations or (loosely) expressions 240 | data ElementValue = EVVal VarInit 241 | | EVAnn Annotation 242 | deriving (Eq,Show,Read,Typeable,Generic,Data) 243 | 244 | ----------------------------------------------------------------------- 245 | -- Statements 246 | 247 | -- | A block is a sequence of statements, local class declarations 248 | -- and local variable declaration statements within braces. 249 | data Block = Block [BlockStmt] 250 | deriving (Eq,Show,Read,Typeable,Generic,Data) 251 | 252 | 253 | 254 | -- | A block statement is either a normal statement, a local 255 | -- class declaration or a local variable declaration. 256 | data BlockStmt 257 | = BlockStmt Stmt 258 | | LocalClass ClassDecl 259 | | LocalVars [Modifier] Type [VarDecl] 260 | deriving (Eq,Show,Read,Typeable,Generic,Data) 261 | 262 | 263 | -- | A Java statement. 264 | data Stmt 265 | -- | A statement can be a nested block. 266 | = StmtBlock Block 267 | -- | The @if-then@ statement allows conditional execution of a statement. 268 | | IfThen Exp Stmt 269 | -- | The @if-then-else@ statement allows conditional choice of two statements, executing one or the other but not both. 270 | | IfThenElse Exp Stmt Stmt 271 | -- | The @while@ statement executes an expression and a statement repeatedly until the value of the expression is false. 272 | | While Exp Stmt 273 | -- | The basic @for@ statement executes some initialization code, then executes an expression, a statement, and some 274 | -- update code repeatedly until the value of the expression is false. 275 | | BasicFor (Maybe ForInit) (Maybe Exp) (Maybe [Exp]) Stmt 276 | -- | The enhanced @for@ statement iterates over an array or a value of a class that implements the @iterator@ interface. 277 | | EnhancedFor [Modifier] Type Ident Exp Stmt 278 | -- | An empty statement does nothing. 279 | | Empty 280 | -- | Certain kinds of expressions may be used as statements by following them with semicolons: 281 | -- assignments, pre- or post-inc- or decrementation, method invocation or class instance 282 | -- creation expressions. 283 | | ExpStmt Exp 284 | -- | An assertion is a statement containing a boolean expression, where an error is reported if the expression 285 | -- evaluates to false. 286 | | Assert Exp (Maybe Exp) 287 | -- | The switch statement transfers control to one of several statements depending on the value of an expression. 288 | | Switch Exp [SwitchBlock] 289 | -- | The @do@ statement executes a statement and an expression repeatedly until the value of the expression is false. 290 | | Do Stmt Exp 291 | -- | A @break@ statement transfers control out of an enclosing statement. 292 | | Break (Maybe Ident) 293 | -- | A @continue@ statement may occur only in a while, do, or for statement. Control passes to the loop-continuation 294 | -- point of that statement. 295 | | Continue (Maybe Ident) 296 | -- A @return@ statement returns control to the invoker of a method or constructor. 297 | | Return (Maybe Exp) 298 | -- | A @synchronized@ statement acquires a mutual-exclusion lock on behalf of the executing thread, executes a block, 299 | -- then releases the lock. While the executing thread owns the lock, no other thread may acquire the lock. 300 | | Synchronized Exp Block 301 | -- | A @throw@ statement causes an exception to be thrown. 302 | | Throw Exp 303 | -- | A try statement executes a block. If a value is thrown and the try statement has one or more catch clauses that 304 | -- can catch it, then control will be transferred to the first such catch clause. If the try statement has a finally 305 | -- clause, then another block of code is executed, no matter whether the try block completes normally or abruptly, 306 | -- and no matter whether a catch clause is first given control. 307 | | Try Block [Catch] (Maybe {- finally -} Block) 308 | -- | Statements may have label prefixes. 309 | | Labeled Ident Stmt 310 | deriving (Eq,Show,Read,Typeable,Generic,Data) 311 | 312 | -- | If a value is thrown and the try statement has one or more catch clauses that can catch it, then control will be 313 | -- transferred to the first such catch clause. 314 | data Catch = Catch FormalParam Block 315 | deriving (Eq,Show,Read,Typeable,Generic,Data) 316 | 317 | -- | A block of code labelled with a @case@ or @default@ within a @switch@ statement. 318 | data SwitchBlock 319 | = SwitchBlock SwitchLabel [BlockStmt] 320 | deriving (Eq,Show,Read,Typeable,Generic,Data) 321 | 322 | -- | A label within a @switch@ statement. 323 | data SwitchLabel 324 | -- | The expression contained in the @case@ must be a 'Lit' or an @enum@ constant. 325 | = SwitchCase Exp 326 | | Default 327 | deriving (Eq,Show,Read,Typeable,Generic,Data) 328 | 329 | -- | Initialization code for a basic @for@ statement. 330 | data ForInit 331 | = ForLocalVars [Modifier] Type [VarDecl] 332 | | ForInitExps [Exp] 333 | deriving (Eq,Show,Read,Typeable,Generic,Data) 334 | 335 | -- | An exception type has to be a class type or a type variable. 336 | type ExceptionType = RefType -- restricted to ClassType or TypeVariable 337 | 338 | -- | Arguments to methods and constructors are expressions. 339 | type Argument = Exp 340 | 341 | -- | A Java expression. 342 | data Exp 343 | -- | A literal denotes a fixed, unchanging value. 344 | = Lit Literal 345 | -- | A class literal, which is an expression consisting of the name of a class, interface, array, 346 | -- or primitive type, or the pseudo-type void (modelled by 'Nothing'), followed by a `.' and the token class. 347 | | ClassLit (Maybe Type) 348 | -- | The keyword @this@ denotes a value that is a reference to the object for which the instance method 349 | -- was invoked, or to the object being constructed. 350 | | This 351 | -- | Any lexically enclosing instance can be referred to by explicitly qualifying the keyword this. 352 | | ThisClass Name 353 | -- | A class instance creation expression is used to create new objects that are instances of classes. 354 | -- | The first argument is a list of non-wildcard type arguments to a generic constructor. 355 | -- What follows is the type to be instantiated, the list of arguments passed to the constructor, and 356 | -- optionally a class body that makes the constructor result in an object of an /anonymous/ class. 357 | | InstanceCreation [TypeArgument] TypeDeclSpecifier [Argument] (Maybe ClassBody) 358 | -- | A qualified class instance creation expression enables the creation of instances of inner member classes 359 | -- and their anonymous subclasses. 360 | | QualInstanceCreation Exp [TypeArgument] Ident [Argument] (Maybe ClassBody) 361 | -- | An array instance creation expression is used to create new arrays. The last argument denotes the number 362 | -- of dimensions that have no explicit length given. These dimensions must be given last. 363 | | ArrayCreate Type [Exp] Int 364 | -- | An array instance creation expression may come with an explicit initializer. Such expressions may not 365 | -- be given explicit lengths for any of its dimensions. 366 | | ArrayCreateInit Type Int ArrayInit 367 | -- | A field access expression. 368 | | FieldAccess FieldAccess 369 | -- | A method invocation expression. 370 | | MethodInv MethodInvocation 371 | -- | An array access expression refers to a variable that is a component of an array. 372 | | ArrayAccess ArrayIndex 373 | {- | ArrayAccess Exp Exp -- Should this be made into a datatype, for consistency and use with Lhs? -} 374 | -- | An expression name, e.g. a variable. 375 | | ExpName Name 376 | -- | Post-incrementation expression, i.e. an expression followed by @++@. 377 | | PostIncrement Exp 378 | -- | Post-decrementation expression, i.e. an expression followed by @--@. 379 | | PostDecrement Exp 380 | -- | Pre-incrementation expression, i.e. an expression preceded by @++@. 381 | | PreIncrement Exp 382 | -- | Pre-decrementation expression, i.e. an expression preceded by @--@. 383 | | PreDecrement Exp 384 | -- | Unary plus, the promotion of the value of the expression to a primitive numeric type. 385 | | PrePlus Exp 386 | -- | Unary minus, the promotion of the negation of the value of the expression to a primitive numeric type. 387 | | PreMinus Exp 388 | -- | Unary bitwise complementation: note that, in all cases, @~x@ equals @(-x)-1@. 389 | | PreBitCompl Exp 390 | -- | Logical complementation of boolean values. 391 | | PreNot Exp 392 | -- | A cast expression converts, at run time, a value of one numeric type to a similar value of another 393 | -- numeric type; or confirms, at compile time, that the type of an expression is boolean; or checks, 394 | -- at run time, that a reference value refers to an object whose class is compatible with a specified 395 | -- reference type. 396 | | Cast Type Exp 397 | -- | The application of a binary operator to two operand expressions. 398 | | BinOp Exp Op Exp 399 | -- | Testing whether the result of an expression is an instance of some reference type. 400 | | InstanceOf Exp RefType 401 | -- | The conditional operator @? :@ uses the boolean value of one expression to decide which of two other 402 | -- expressions should be evaluated. 403 | | Cond Exp Exp Exp 404 | -- | Assignment of the result of an expression to a variable. 405 | | Assign Lhs AssignOp Exp 406 | -- | Lambda expression 407 | | Lambda LambdaParams LambdaExpression 408 | -- | Method reference 409 | | MethodRef Name Ident 410 | deriving (Eq,Show,Read,Typeable,Generic,Data) 411 | 412 | -- | The left-hand side of an assignment expression. This operand may be a named variable, such as a local 413 | -- variable or a field of the current object or class, or it may be a computed variable, as can result from 414 | -- a field access or an array access. 415 | data Lhs 416 | = NameLhs Name -- ^ Assign to a variable 417 | | FieldLhs FieldAccess -- ^ Assign through a field access 418 | | ArrayLhs ArrayIndex -- ^ Assign to an array 419 | deriving (Eq,Show,Read,Typeable,Generic,Data) 420 | 421 | -- | Array access 422 | data ArrayIndex = ArrayIndex Exp [Exp] -- ^ Index into an array 423 | deriving (Eq,Show,Read,Typeable,Generic,Data) 424 | 425 | -- | A field access expression may access a field of an object or array, a reference to which is the value 426 | -- of either an expression or the special keyword super. 427 | data FieldAccess 428 | = PrimaryFieldAccess Exp Ident -- ^ Accessing a field of an object or array computed from an expression. 429 | | SuperFieldAccess Ident -- ^ Accessing a field of the superclass. 430 | | ClassFieldAccess Name Ident -- ^ Accessing a (static) field of a named class. 431 | deriving (Eq,Show,Read,Typeable,Generic,Data) 432 | 433 | 434 | -- ¦ A lambda parameter can be a single parameter, or mulitple formal or mulitple inferred parameters 435 | data LambdaParams 436 | = LambdaSingleParam Ident 437 | | LambdaFormalParams [FormalParam] 438 | | LambdaInferredParams [Ident] 439 | deriving (Eq,Show,Read,Typeable,Generic,Data) 440 | 441 | -- | Lambda expression, starting from java 8 442 | data LambdaExpression 443 | = LambdaExpression Exp 444 | | LambdaBlock Block 445 | deriving (Eq,Show,Read,Typeable,Generic,Data) 446 | 447 | 448 | -- | A method invocation expression is used to invoke a class or instance method. 449 | data MethodInvocation 450 | -- | Invoking a specific named method. 451 | = MethodCall Name [Argument] 452 | -- | Invoking a method of a class computed from a primary expression, giving arguments for any generic type parameters. 453 | | PrimaryMethodCall Exp [RefType] Ident [Argument] 454 | -- | Invoking a method of the super class, giving arguments for any generic type parameters. 455 | | SuperMethodCall [RefType] Ident [Argument] 456 | -- | Invoking a method of the superclass of a named class, giving arguments for any generic type parameters. 457 | | ClassMethodCall Name [RefType] Ident [Argument] 458 | -- | Invoking a method of a named type, giving arguments for any generic type parameters. 459 | | TypeMethodCall Name [RefType] Ident [Argument] 460 | deriving (Eq,Show,Read,Typeable,Generic,Data) 461 | 462 | -- | An array initializer may be specified in a declaration, or as part of an array creation expression, creating an 463 | -- array and providing some initial values 464 | data ArrayInit 465 | = ArrayInit [VarInit] 466 | deriving (Eq,Show,Read,Typeable,Generic,Data) 467 | -------------------------------------------------------------------------------- /Language/Java/Syntax/Exp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} 2 | module Language.Java.Syntax.Exp where 3 | 4 | import Data.Data 5 | import GHC.Generics (Generic) 6 | 7 | -- | A literal denotes a fixed, unchanging value. 8 | data Literal 9 | = Int Integer 10 | | Word Integer 11 | | Float Double 12 | | Double Double 13 | | Boolean Bool 14 | | Char Char 15 | | String String 16 | | Null 17 | deriving (Eq,Show,Read,Typeable,Generic,Data) 18 | 19 | -- | A binary infix operator. 20 | data Op = Mult | Div | Rem | Add | Sub | LShift | RShift | RRShift 21 | | LThan | GThan | LThanE | GThanE | Equal | NotEq 22 | | And | Or | Xor | CAnd | COr 23 | deriving (Eq,Show,Read,Typeable,Generic,Data) 24 | 25 | -- | An assignment operator. 26 | data AssignOp = EqualA | MultA | DivA | RemA | AddA | SubA 27 | | LShiftA | RShiftA | RRShiftA | AndA | XorA | OrA 28 | deriving (Eq,Show,Read,Typeable,Generic,Data) 29 | -------------------------------------------------------------------------------- /Language/Java/Syntax/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} 2 | module Language.Java.Syntax.Types where 3 | 4 | import Data.Data 5 | import GHC.Generics (Generic) 6 | 7 | -- | There are two kinds of types in the Java programming language: primitive types and reference types. 8 | data Type 9 | = PrimType PrimType 10 | | RefType RefType 11 | deriving (Eq,Show,Read,Typeable,Generic,Data) 12 | 13 | -- | There are three kinds of reference types: class types, interface types, and array types. 14 | -- Reference types may be parameterized with type arguments. 15 | -- Type variables cannot be syntactically distinguished from class type identifiers, 16 | -- and are thus represented uniformly as single ident class types. 17 | data RefType 18 | = ClassRefType ClassType 19 | {- | TypeVariable Ident -} 20 | | ArrayType Type 21 | deriving (Eq,Show,Read,Typeable,Generic,Data) 22 | 23 | -- | A class or interface type consists of a type declaration specifier, 24 | -- optionally followed by type arguments (in which case it is a parameterized type). 25 | data ClassType 26 | = ClassType [(Ident, [TypeArgument])] 27 | deriving (Eq,Show,Read,Typeable,Generic,Data) 28 | 29 | -- | Type arguments may be either reference types or wildcards. 30 | data TypeArgument 31 | = Wildcard (Maybe WildcardBound) 32 | | ActualType RefType 33 | deriving (Eq,Show,Read,Typeable,Generic,Data) 34 | 35 | data TypeDeclSpecifier 36 | = TypeDeclSpecifier ClassType 37 | | TypeDeclSpecifierWithDiamond ClassType Ident Diamond 38 | | TypeDeclSpecifierUnqualifiedWithDiamond Ident Diamond 39 | deriving (Eq,Show,Read,Typeable,Generic,Data) 40 | 41 | data Diamond = Diamond 42 | deriving (Eq,Show,Read,Typeable,Generic,Data) 43 | 44 | -- | Wildcards may be given explicit bounds, either upper (@extends@) or lower (@super@) bounds. 45 | data WildcardBound 46 | = ExtendsBound RefType 47 | | SuperBound RefType 48 | deriving (Eq,Show,Read,Typeable,Generic,Data) 49 | 50 | -- | A primitive type is predefined by the Java programming language and named by its reserved keyword. 51 | data PrimType 52 | = BooleanT 53 | | ByteT 54 | | ShortT 55 | | IntT 56 | | LongT 57 | | CharT 58 | | FloatT 59 | | DoubleT 60 | deriving (Eq,Show,Read,Typeable,Generic,Data) 61 | 62 | 63 | -- | A class is generic if it declares one or more type variables. These type variables are known 64 | -- as the type parameters of the class. 65 | data TypeParam = TypeParam Ident [RefType] 66 | deriving (Eq,Show,Read,Typeable,Generic,Data) 67 | 68 | ----------------------------------------------------------------------- 69 | -- Names and identifiers 70 | 71 | -- | A single identifier. 72 | data Ident = Ident String 73 | deriving (Eq,Ord,Show,Read,Typeable,Generic,Data) 74 | 75 | -- | A name, i.e. a period-separated list of identifiers. 76 | data Name = Name [Ident] 77 | deriving (Eq,Ord,Show,Read,Typeable,Generic,Data) 78 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | language-java 2 | ============= 3 | 4 | [![Build Status](https://travis-ci.org/vincenthz/language-java.png?branch=master)](https://travis-ci.org/vincenthz/language-java) 5 | [![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) 6 | [![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) 7 | 8 | Haskell parser and pretty printer for the java language. 9 | 10 | 11 | How to use 12 | ---------- 13 | 14 | Simple compilation unit parser: 15 | 16 | parser compilationUnit "import java.util.*; public class MyClass {}" 17 | 18 | or from a file: 19 | 20 | ast <- parser compilationUnit `fmap` readFile "myClass.java" 21 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /language-java.cabal: -------------------------------------------------------------------------------- 1 | Name: language-java 2 | Version: 0.2.9 3 | License: BSD3 4 | License-File: LICENSE 5 | Author: Niklas Broberg 6 | Maintainer: Vincent Hanquez 7 | Category: Language 8 | Synopsis: Java source manipulation 9 | Description: Manipulating Java source: abstract syntax, lexer, parser, and pretty-printer. 10 | Homepage: http://github.com/vincenthz/language-java 11 | Stability: Experimental 12 | Build-Type: Simple 13 | Cabal-Version: >= 1.8 14 | 15 | Extra-Source-Files: 16 | tests/java/good/*.java 17 | tests/java/bad/*.java 18 | Language/Java/Lexer.x 19 | 20 | source-repository head 21 | type: git 22 | location: git://github.com/vincenthz/language-java 23 | 24 | Library 25 | Build-Tools: alex >= 3.1.3 26 | Build-Depends: base >= 4 && < 5 27 | , array >= 0.1 28 | , pretty >= 1.0 29 | , parsec >= 3.0 30 | 31 | if impl(ghc < 7.6) 32 | Build-Depends: syb 33 | 34 | ghc-options: -Wall -fwarn-tabs -fno-warn-missing-signatures 35 | 36 | Exposed-modules: Language.Java.Lexer, 37 | Language.Java.Syntax, 38 | Language.Java.Parser, 39 | Language.Java.Pretty 40 | 41 | Other-modules: Language.Java.Syntax.Types 42 | Language.Java.Syntax.Exp 43 | 44 | Test-Suite test-java-parse 45 | type: exitcode-stdio-1.0 46 | hs-source-dirs: tests 47 | Main-is: Tests.hs 48 | Build-Depends: base >= 3 && < 5 49 | , mtl 50 | , tasty 51 | , tasty-quickcheck 52 | , tasty-hunit 53 | , language-java 54 | , filepath 55 | , directory 56 | ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures 57 | -------------------------------------------------------------------------------- /oldtest/LexerQCTest.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | 3 | A set of QuickCheck tests for the lexer. These tests are essentially 4 | 'unlex-lex' tests where we generate a list of tokens, and then 5 | generate a text that the lexer should convert back into the original 6 | list of tokens. 7 | 8 | Converting from a list of tokens to text can be done in several ways, 9 | varying the form of intervening white space and commnents, for 10 | example, or the way in which numeric literals are unlexed. -} 11 | 12 | module LexerQCTest where 13 | 14 | import Data.List (intercalate) 15 | import Test.QuickCheck 16 | 17 | import Language.Java.Lexer (Token, lexer, L(..)) 18 | 19 | import TokenGen 20 | 21 | run :: IO () 22 | run = do 23 | quickCheck $ prop_unlexLex withInterveningSpaces 24 | quickCheck $ prop_unlexLex withInterveningBlockComments 25 | quickCheck $ prop_unlexLex withInterveningMultilineComments 26 | 27 | prop_unlexLex :: ([Token] -> String) -> [Token] -> Bool 28 | prop_unlexLex toText tokens = 29 | tokens == (map justToken $ lexer $ toText tokens) 30 | where justToken (L _ t) = t 31 | 32 | withInterveningSpaces :: [Token] -> String 33 | withInterveningSpaces = intercalate " " . map unlex 34 | 35 | withInterveningBlockComments :: [Token] -> String 36 | withInterveningBlockComments = intercalate "\n/**/\n" . map unlex 37 | 38 | withInterveningMultilineComments :: [Token] -> String 39 | withInterveningMultilineComments = intercalate "\n/*\n *\n */\n" . map unlex 40 | -------------------------------------------------------------------------------- /oldtest/LexerTest.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Test.HUnit 4 | import Text.Printf (printf) 5 | import Language.Java.Lexer 6 | 7 | import qualified LexerQCTest as LQCT 8 | 9 | data LexerTest = LexerTest 10 | String -- given input 11 | [Token] -- expected result 12 | 13 | lexerTests :: [LexerTest] 14 | lexerTests = concat [ 15 | integerTests 0 16 | , integerTests 1 17 | , integerTests 23 18 | , integerTests 52 19 | , [ LexerTest "\"\\\\\" \"\"" 20 | [StringTok "\\", StringTok ""] ] 21 | , blockCommentTests 22 | ] 23 | 24 | -- | Generates integer lexing tests using decimal, octal, and 25 | -- hexadecimal representations of @int@ and @long@ literals. 26 | integerTests :: Integer -> [LexerTest] 27 | integerTests expectedValue = 28 | concat [ intAndLongs decimalRep, 29 | intAndLongs octalRep, 30 | intAndLongs hexRep ] 31 | where intAndLongs rep = [ LexerTest rep [intToken], 32 | LexerTest (rep ++ "l") [longToken], 33 | LexerTest (rep ++ "L") [longToken] ] 34 | decimalRep = printf "%d" expectedValue 35 | octalRep = printf "0%o" expectedValue 36 | hexRep = printf "0x%x" expectedValue 37 | intToken = IntTok expectedValue 38 | longToken = LongTok expectedValue 39 | 40 | blockCommentTests :: [LexerTest] 41 | blockCommentTests = 42 | map mkTest [ "", 43 | "*", 44 | "**", 45 | "***", 46 | "** / ***", 47 | "*\n/ ***\n /**"] 48 | where mkTest commentBody = 49 | LexerTest (comment ++ "class" ++ comment) [KW_Class] 50 | where comment = "/*" ++ commentBody ++ "*/" 51 | 52 | main :: IO () 53 | main = do 54 | _ <- runTestTT $ TestList $ map lexerTestToTest lexerTests 55 | LQCT.run 56 | return (); 57 | where 58 | lexerTestToTest (LexerTest input expected) = TestCase $ do 59 | let result = [ x | L _ x <- lexer input ] 60 | assertEqual input expected result 61 | -------------------------------------------------------------------------------- /oldtest/Test.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Language.Java.Parser as J 4 | 5 | import qualified Control.Exception as CX 6 | import qualified System.Directory as SD 7 | import qualified System.IO as SIO 8 | import qualified System.Exit as SX 9 | import qualified System.Environment as SE 10 | import qualified System.FilePath as SF 11 | import Text.Printf(printf) 12 | 13 | type Log = Maybe SIO.Handle 14 | 15 | -- "C:\\jdk6\\src\\java\\lang\\ref" 16 | main = do 17 | as <- SE.getArgs 18 | case as of 19 | [dir] -> processDir Nothing dir 20 | _ -> fatal "expected dir argument" 21 | SX.exitSuccess 22 | 23 | processDirLog = processDir (Just "log.txt") 24 | 25 | processDir :: Maybe FilePath -> FilePath -> IO () 26 | processDir mfp root = do 27 | mh <- case mfp of 28 | Just fp -> fmap Just $ SIO.openFile fp SIO.WriteMode 29 | Nothing -> return Nothing 30 | 31 | tree <- enumTree root 32 | res <- mapM (processFile mh) $ filter ((==".java") . 33 | SF.takeExtension) tree 34 | let num = length res 35 | let suc = length (filter id res) 36 | putStrLn $ printf "%d / %d" suc num 37 | 38 | case mh of 39 | Just h -> SIO.hClose h 40 | Nothing -> return () 41 | 42 | 43 | -- Sometimes the lexer blows up and the parser cannot successfully 44 | -- produce a proper error value. 45 | processFile :: Log -> FilePath -> IO Bool 46 | processFile lg javaf = CX.catch (processFileBody lg javaf) handler 47 | where handler :: CX.SomeException -> IO Bool 48 | handler se = do logLn lg $ fmtFileFail javaf (show se) 49 | return False 50 | 51 | processFileBody :: Log -> FilePath -> IO Bool 52 | processFileBody lg javaf = do 53 | SIO.withFile javaf SIO.ReadMode $ \h -> do 54 | str <- SIO.hGetContents h 55 | case J.parseCompilationUnit str of 56 | Left pe -> do logLn lg $ fmtFileFail javaf (show pe) 57 | return False 58 | Right r -> return True 59 | 60 | 61 | fmtFileFail :: FilePath -> String -> String 62 | fmtFileFail f s = "FILE: " ++ f ++ "\n" ++ s ++ "\n\n" 63 | 64 | logLn :: Log -> String -> IO () 65 | logLn (Just h) msg = SIO.hPutStrLn h msg -- >> SIO.hFlush h 66 | logLn Nothing msg = return () 67 | 68 | 69 | enumTree :: FilePath -> IO [FilePath] 70 | enumTree = fmap concat . enumTree' 71 | where enumTree' :: FilePath -> IO [[FilePath]] 72 | enumTree' dir = do 73 | let dotOrDotDot "." = True 74 | dotOrDotDot ".." = True 75 | dotOrDotDot _ = False 76 | 77 | pfxDir = ((dir++"/")++) 78 | 79 | allFs <- fmap (map pfxDir . filter (not . dotOrDotDot)) 80 | (SD.getDirectoryContents dir) 81 | 82 | (ds,fs) <- partitionM SD.doesDirectoryExist allFs 83 | subDs <- mapM enumTree' ds 84 | return (fs : concat subDs) 85 | 86 | partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a],[a]) 87 | partitionM _ [] = return ([],[]) 88 | partitionM p (a:as) = do 89 | (ts,fs) <- partitionM p as 90 | z <- p a 91 | return $ if z then (a:ts,fs) else (ts,a:fs) 92 | 93 | fatal m = do 94 | SIO.hPutStrLn SIO.stderr m 95 | SX.exitFailure -------------------------------------------------------------------------------- /oldtest/TokenGen.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | 3 | QuickCheck generators for streams of tokens and functions for 4 | converting them to text that should lex back to the same token stream. 5 | 6 | This supports a simple unlex-lex test in which we generate text for a 7 | stream of tokens, lex it, and insist that the result equals the 8 | original. -} 9 | 10 | module TokenGen where 11 | 12 | import Control.Monad (liftM2) 13 | import Data.Char (isControl, isAscii, isPrint) 14 | import qualified Data.Set as DS 15 | import Test.QuickCheck 16 | import Text.Printf (printf) 17 | 18 | import Language.Java.Lexer (Token(..)) 19 | 20 | instance Arbitrary Token where 21 | arbitrary = token 22 | 23 | token :: Gen Token 24 | token = frequency [ (length allKeywords, keyword), 25 | (length allSeparators, separator), 26 | (8, literal), 27 | (1, identifier), 28 | (length allOperators, operator) ] 29 | 30 | keyword :: Gen Token 31 | keyword = elements allKeywords 32 | 33 | separator :: Gen Token 34 | separator = elements allSeparators 35 | 36 | literal :: Gen Token 37 | literal = oneof [ 38 | -- Note that the numbers are always positive in tokens generated by 39 | -- the lexer, so we have to be careful not to generate negative 40 | -- contents. 41 | fmap IntTok nonNegative, 42 | fmap LongTok nonNegative, 43 | fmap DoubleTok nonNegative, 44 | fmap FloatTok nonNegative, 45 | fmap CharTok javaChar, 46 | fmap StringTok javaString, 47 | fmap BoolTok arbitrary, 48 | return NullTok 49 | ] 50 | 51 | nonNegative :: (Arbitrary a, Num a) => Gen a 52 | nonNegative = fmap abs arbitrary 53 | 54 | identifier :: Gen Token 55 | identifier = fmap IdentTok identText 56 | 57 | identText :: Gen String 58 | identText = liftM2 (:) first rest `suchThat` (not . isKeyword) 59 | where first = javaLetter 60 | rest = sized (\s -> resize (min s 12) $ listOf javaLetterOrDigit) 61 | javaLetter = elements allJavaLetters 62 | javaLetterOrDigit = frequency [(length allJavaLetters, javaLetter), (10, digit)] 63 | digit = elements ['0'..'9'] 64 | allJavaLetters = "$_" ++ ['A'..'Z'] ++ ['a'..'z'] 65 | isKeyword = flip DS.member allKeywordNames 66 | allKeywordNames = DS.fromList $ map unlex allKeywords 67 | 68 | operator :: Gen Token 69 | operator = elements allOperators 70 | 71 | -- An Alex lexer appears to support characters only in the range \x00 72 | -- to \xff, or at least that's what is implied by the definition of 73 | -- the character class '.' in the Alex documentation. We'll limit it 74 | -- to the ASCII range for now. 75 | javaChar :: Gen Char 76 | javaChar = elements $ takeWhile isAscii $ map toEnum [0..] 77 | 78 | javaString :: Gen String 79 | javaString = listOf javaChar 80 | 81 | -- | Gives the corresponding Java source text for a token. 82 | unlex :: Token -> String 83 | -- The duplication between here and the lexer is a little 84 | -- unsatisfying, but it's not really going to be a maintenance problem 85 | -- in practice. These are aspects of the language that aren't likely 86 | -- to change. 87 | unlex t = case t of 88 | KW_Abstract -> "abstract" 89 | KW_Assert -> "assert" 90 | KW_Boolean -> "boolean" 91 | KW_Break -> "break" 92 | KW_Byte -> "byte" 93 | KW_Case -> "case" 94 | KW_Catch -> "catch" 95 | KW_Char -> "char" 96 | KW_Class -> "class" 97 | KW_Const -> "const" 98 | KW_Continue -> "continue" 99 | KW_Default -> "default" 100 | KW_Do -> "do" 101 | KW_Double -> "double" 102 | KW_Else -> "else" 103 | KW_Enum -> "enum" 104 | KW_Extends -> "extends" 105 | KW_Final -> "final" 106 | KW_Finally -> "finally" 107 | KW_Float -> "float" 108 | KW_For -> "for" 109 | KW_Goto -> "goto" 110 | KW_If -> "if" 111 | KW_Implements -> "implements" 112 | KW_Import -> "import" 113 | KW_Instanceof -> "instanceof" 114 | KW_Int -> "int" 115 | KW_Interface -> "interface" 116 | KW_Long -> "long" 117 | KW_Native -> "native" 118 | KW_New -> "new" 119 | KW_Package -> "package" 120 | KW_Private -> "private" 121 | KW_Protected -> "protected" 122 | KW_Public -> "public" 123 | KW_Return -> "return" 124 | KW_Short -> "short" 125 | KW_Static -> "static" 126 | KW_Strictfp -> "strictfp" 127 | KW_Super -> "super" 128 | KW_Switch -> "switch" 129 | KW_Synchronized -> "synchronized" 130 | KW_This -> "this" 131 | KW_Throw -> "throw" 132 | KW_Throws -> "throws" 133 | KW_Transient -> "transient" 134 | KW_Try -> "try" 135 | KW_Void -> "void" 136 | KW_Volatile -> "volatile" 137 | KW_While -> "while" 138 | OpenParen -> "(" 139 | CloseParen -> ")" 140 | OpenSquare -> "[" 141 | CloseSquare -> "]" 142 | OpenCurly -> "{" 143 | CloseCurly -> "}" 144 | SemiColon -> ";" 145 | Comma -> "," 146 | Period -> "." 147 | IntTok i -> show i 148 | LongTok l -> show l ++ "L" 149 | DoubleTok d -> show d ++ "D" 150 | FloatTok f -> show f ++ "F" 151 | CharTok c -> "'" ++ unlexChar InChar c ++ "'" 152 | StringTok s -> "\"" ++ concatMap (unlexChar InString) s ++ "\"" 153 | BoolTok b -> if b then "true" else "false" 154 | NullTok -> "null" 155 | IdentTok id -> id 156 | Op_Equal -> "=" 157 | Op_GThan -> ">" 158 | Op_LThan -> "<" 159 | Op_Bang -> "!" 160 | Op_Tilde -> "~" 161 | Op_Query -> "?" 162 | Op_Colon -> ":" 163 | Op_Equals -> "==" 164 | Op_LThanE -> "<=" 165 | Op_GThanE -> ">=" 166 | Op_BangE -> "!=" 167 | Op_AAnd -> "&&" 168 | Op_OOr -> "||" 169 | Op_PPlus -> "++" 170 | Op_MMinus -> "--" 171 | Op_Plus -> "+" 172 | Op_Minus -> "-" 173 | Op_Star -> "*" 174 | Op_Slash -> "/" 175 | Op_And -> "&" 176 | Op_Or -> "|" 177 | Op_Caret -> "^" 178 | Op_Percent -> "%" 179 | Op_LShift -> "<<" 180 | Op_RShift -> ">>" 181 | Op_RRShift -> ">>>" 182 | Op_PlusE -> "+=" 183 | Op_MinusE -> "-=" 184 | Op_StarE -> "*=" 185 | Op_SlashE -> "/=" 186 | Op_AndE -> "&=" 187 | Op_OrE -> "|=" 188 | Op_CaretE -> "^=" 189 | Op_PercentE -> "%=" 190 | Op_LShiftE -> "<<=" 191 | Op_RShiftE -> ">>=" 192 | Op_RRShiftE -> ">>>=" 193 | Op_AtSign -> "@" 194 | 195 | data CharContext = InChar | InString 196 | 197 | unlexChar :: CharContext -> Char -> String 198 | unlexChar cc c = 199 | case c of 200 | '\b' -> "\\b" 201 | '\t' -> "\\t" 202 | '\n' -> "\\n" 203 | '\f' -> "\\f" 204 | '\r' -> "\\r" 205 | '"' -> case cc of 206 | InChar -> "\"" 207 | InString -> "\\\"" 208 | '\'' -> case cc of 209 | InChar -> "\\'" 210 | InString -> "'" 211 | '\\' -> "\\\\" 212 | _ -> 213 | if isControl c || not (isAscii c) || not (isPrint c) 214 | then asUnicodeEscape c 215 | else c:[] 216 | where asUnicodeEscape c = 217 | printf "\\u%04x" (fromEnum c) 218 | 219 | allKeywords :: [Token] 220 | allKeywords = [ 221 | KW_Abstract, 222 | KW_Assert, 223 | KW_Boolean, 224 | KW_Break, 225 | KW_Byte, 226 | KW_Case, 227 | KW_Catch, 228 | KW_Char, 229 | KW_Class, 230 | KW_Const, 231 | KW_Continue, 232 | KW_Default, 233 | KW_Do, 234 | KW_Double, 235 | KW_Else, 236 | KW_Enum, 237 | KW_Extends, 238 | KW_Final, 239 | KW_Finally, 240 | KW_Float, 241 | KW_For, 242 | KW_Goto, 243 | KW_If, 244 | KW_Implements, 245 | KW_Import, 246 | KW_Instanceof, 247 | KW_Int, 248 | KW_Interface, 249 | KW_Long, 250 | KW_Native, 251 | KW_New, 252 | KW_Package, 253 | KW_Private, 254 | KW_Protected, 255 | KW_Public, 256 | KW_Return, 257 | KW_Short, 258 | KW_Static, 259 | KW_Strictfp, 260 | KW_Super, 261 | KW_Switch, 262 | KW_Synchronized, 263 | KW_This, 264 | KW_Throw, 265 | KW_Throws, 266 | KW_Transient, 267 | KW_Try, 268 | KW_Void, 269 | KW_Volatile, 270 | KW_While 271 | ] 272 | 273 | allSeparators :: [Token] 274 | allSeparators = [ 275 | OpenParen, 276 | CloseParen, 277 | OpenSquare, 278 | CloseSquare, 279 | OpenCurly, 280 | CloseCurly, 281 | SemiColon, 282 | Comma, 283 | Period 284 | ] 285 | 286 | allOperators :: [Token] 287 | allOperators = [ 288 | Op_Equal, 289 | Op_GThan, 290 | Op_LThan, 291 | Op_Bang, 292 | Op_Tilde, 293 | Op_Query, 294 | Op_Colon, 295 | Op_Equals, 296 | Op_LThanE, 297 | Op_GThanE, 298 | Op_BangE, 299 | Op_AAnd, 300 | Op_OOr, 301 | Op_PPlus, 302 | Op_MMinus, 303 | Op_Plus, 304 | Op_Minus, 305 | Op_Star, 306 | Op_Slash, 307 | Op_And, 308 | Op_Or, 309 | Op_Caret, 310 | Op_Percent, 311 | Op_LShift, 312 | Op_RShift, 313 | Op_RRShift, 314 | Op_PlusE, 315 | Op_MinusE, 316 | Op_StarE, 317 | Op_SlashE, 318 | Op_AndE, 319 | Op_OrE, 320 | Op_CaretE, 321 | Op_PercentE, 322 | Op_LShiftE, 323 | Op_RShiftE, 324 | Op_RRShiftE, 325 | Op_AtSign 326 | ] 327 | -------------------------------------------------------------------------------- /oldtest/abstract.java: -------------------------------------------------------------------------------- 1 | abstract class Point { 2 | int x = 1, y = 1; 3 | void move(int dx, int dy) { 4 | x += dx; 5 | y += dy; 6 | alert(); 7 | } 8 | abstract void alert(); 9 | } 10 | abstract class ColoredPoint extends Point { 11 | int color; 12 | } 13 | 14 | class SimplePoint extends Point { 15 | void alert() { } 16 | } -------------------------------------------------------------------------------- /oldtest/miscMath.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | int divisor; 4 | MiscMath(int divisor) { 5 | this.divisor = divisor; 6 | } 7 | float ratio(long l) { 8 | try { 9 | l /= divisor; 10 | } catch (Exception e) { 11 | if (e instanceof ArithmeticException) 12 | l = Long.MAX_VALUE; 13 | else 14 | l = 0; 15 | } 16 | return (float)l; 17 | } 18 | double gausser() { 19 | Random r = new Random(); 20 | double[] val = new double[2]; 21 | val[0] = r.nextGaussian(); 22 | val[1] = r.nextGaussian(); 23 | return (val[0] + val[1]) / 2; 24 | } 25 | Collection fromArray(Number[] na) { 26 | Collection cn = new ArrayList(); 27 | for (Number n : na) { 28 | cn.add(n); 29 | } 30 | return cn; 31 | } 32 | void loop(S s){ this.loop(s);} 33 | } -------------------------------------------------------------------------------- /oldtest/miscMath2.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | Collection cn = new ArrayList(); 5 | for (Number n : na) { 6 | cn.add(n) 7 | } 8 | return cn; 9 | } 10 | } -------------------------------------------------------------------------------- /oldtest/miscMath3.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | void loop(S s){ this.loop(s);} 4 | } -------------------------------------------------------------------------------- /oldtest/miscMath3.txt: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | Collection cn = new ArrayList(); 5 | } 6 | } -------------------------------------------------------------------------------- /oldtest/miscMath4.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | for (Number n : na) { 5 | cn.add(n) 6 | } 7 | Collection cn = new ArrayList(); 8 | } 9 | } -------------------------------------------------------------------------------- /oldtest/miscMath5.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | for (Number n : na) { 5 | cn.add(n); 6 | } 7 | Collection cn = new ArrayList(); 8 | } 9 | } -------------------------------------------------------------------------------- /oldtest/rawTypes.java: -------------------------------------------------------------------------------- 1 | import java.util.*; 2 | 3 | class NonGeneric { 4 | 5 | Collection myNumbers(){return null;} 6 | } 7 | abstract class RawMembers extends NonGeneric implements Collection { 8 | static Collection cng = new ArrayList(); 9 | 10 | public static void main(String[] args) { 11 | RawMembers rw = null; 12 | Collection cn = rw.myNumbers(); // ok 13 | Iterator is = rw.iterator(); // unchecked warning 14 | Collection cnn = rw.cng; // ok - static member 15 | } 16 | } -------------------------------------------------------------------------------- /oldtest/test.java: -------------------------------------------------------------------------------- 1 | package testPackage; 2 | class Other { static String hello = "Hello"; } -------------------------------------------------------------------------------- /oldtest/typeVarMembers.java: -------------------------------------------------------------------------------- 1 | package TypeVarMembers; 2 | 3 | class C { 4 | void mCDefault() {} 5 | public void mCPublic() {} 6 | private void mCPrivate() {} 7 | protected void mCProtected() {} 8 | } 9 | class CT extends C implements I {} 10 | interface I { 11 | void mI(); 12 | void test(T t) ; 13 | } -------------------------------------------------------------------------------- /tests/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Test.Tasty 5 | import Test.Tasty.QuickCheck 6 | import Test.Tasty.HUnit 7 | 8 | import System.Directory 9 | import System.FilePath 10 | 11 | import Control.Applicative 12 | import Control.Monad 13 | import Data.List (isSuffixOf) 14 | 15 | import Language.Java.Parser 16 | import Language.Java.Syntax 17 | import Language.Java.Pretty 18 | import qualified Control.Exception as E 19 | 20 | instance Arbitrary CompilationUnit where 21 | arbitrary = CompilationUnit <$> arbitrary <*> arbitrary <*> ((:[]) <$> arbitrary) 22 | instance Arbitrary PackageDecl where 23 | arbitrary = PackageDecl <$> arbitrary 24 | instance Arbitrary ImportDecl where 25 | arbitrary = ImportDecl <$> arbitrary <*> arbitrary <*> arbitrary 26 | instance Arbitrary TypeDecl where 27 | arbitrary = ClassTypeDecl <$> arbitrary 28 | instance Arbitrary ClassDecl where 29 | arbitrary = ClassDecl <$> pure [] <*> arbitrary <*> pure [] <*> pure Nothing <*> pure [] <*> arbitrary 30 | instance Arbitrary ClassBody where 31 | arbitrary = ClassBody <$> pure [] 32 | instance Arbitrary Name where 33 | arbitrary = Name <$> (choose (1,3) >>= \len -> replicateM len arbitrary) 34 | instance Arbitrary Ident where 35 | arbitrary = Ident . unkeyword <$> (choose (1,15) >>= \len -> replicateM len (elements (['a'..'z'] ++ ['A'..'Z']))) 36 | where unkeyword k 37 | | k `elem` ["if","do","then","else"] = "x" ++ k 38 | | otherwise = k 39 | 40 | ---------------------------------------------------------- 41 | testJavaDirectory :: FilePath 42 | testJavaDirectory = "tests" "java" 43 | 44 | isJavaFile :: FilePath -> Bool 45 | isJavaFile f = ".java" `isSuffixOf` f 46 | 47 | toTestCase expected jFile = testCase (takeBaseName jFile) doTest 48 | where doTest = do r <- E.try parseOne 49 | case r of 50 | Left (e :: E.SomeException) -> assertBool ("failure exception: " ++ show e) (not expected) 51 | Right (Left perr) -> assertBool ("failure parse error: " ++ show perr) (not expected) 52 | Right (Right p) -> assertBool ("success: " ++ show p) expected 53 | parseOne = parser compilationUnit <$> readFile jFile 54 | 55 | getAllJavaPaths path = map (path ) . filter isJavaFile <$> getDirectoryContents path 56 | 57 | main = do 58 | exists <- doesDirectoryExist testJavaDirectory 59 | when (not exists) $ error "cannot find tests files java directory" 60 | 61 | allGoodJavas <- getAllJavaPaths (testJavaDirectory "good") 62 | allBadJavas <- getAllJavaPaths (testJavaDirectory "bad") 63 | 64 | defaultMain $ testGroup "java" 65 | [ testGroup "parsing unit good" (map (toTestCase True) allGoodJavas) 66 | , testGroup "parsing unit bad" (map (toTestCase False) allBadJavas) 67 | , testProperty "parsing.generating==id" (\g -> case parser compilationUnit (show $ pretty g) of 68 | Right g' -> g == g' 69 | Left perr -> error (show (pretty g) ++ show perr)) 70 | ] 71 | -------------------------------------------------------------------------------- /tests/java/bad/DiamondIncorrectPlacement.java: -------------------------------------------------------------------------------- 1 | class DiamondTestError { 2 | public void test() { 3 | final List list = new Error<>.ArrayList(); 4 | } 5 | } -------------------------------------------------------------------------------- /tests/java/bad/empty.java: -------------------------------------------------------------------------------- 1 | for )(; 2 | -------------------------------------------------------------------------------- /tests/java/bad/lambdaWrong.java: -------------------------------------------------------------------------------- 1 | public class LambdaWrong { 2 | // illegal: can't mix inferred and declared types 3 | Type x = (x, int y) -> x + y; 4 | // Illegal: no modifiers with inferred types 5 | Type x = (x, final y) -> x-y; 6 | } -------------------------------------------------------------------------------- /tests/java/bad/syntax.java: -------------------------------------------------------------------------------- 1 | module Abc where 2 | 3 | -------------------------------------------------------------------------------- /tests/java/good/DiamondTestExtended.java: -------------------------------------------------------------------------------- 1 | class DiamondTestExtended { 2 | public void testGood() { 3 | final List list = new ArrayList(); 4 | final List list = new ArrayList<>(); 5 | final List list = new ArrayList(); 6 | final List list = new Test.ArrayList(); 7 | final List list = new Test.ArrayList<>(); 8 | final List list = new Test.ArrayList(); 9 | final List list = new Test.ArrayList(); 10 | final List list = new Test.ArrayList<>(); 11 | final List list = new Test.ArrayList(); 12 | final List list = new Test2.Test.ArrayList(); 13 | final List list = new Test2.Test.ArrayList<>(); 14 | final List list = new Test2.Test.ArrayList(); 15 | final List list = new Test2.Test.ArrayList(); 16 | final List list = new Test2.Test.ArrayList<>(); 17 | final List list = new Test2.Test.ArrayList(); 18 | final List list = new Test2.Test.ArrayList(); 19 | final List list = new Test2.Test.ArrayList<>(); 20 | final List list = new Test2.Test.ArrayList(); 21 | final List list = new Test2.Test.ArrayList(); 22 | final List list = new Test2.Test.ArrayList<>(); 23 | final List list = new Test2.Test.ArrayList(); 24 | } 25 | } -------------------------------------------------------------------------------- /tests/java/good/Gauge.java: -------------------------------------------------------------------------------- 1 | // From the codahale metrics library: https://github.com/codahale/metrics 2 | package com.codahale.metrics; 3 | 4 | 5 | /** 6 | * A gauge metric is an instantaneous reading of a particular value. To instrument a queue's depth, 7 | * for example:
8 | * 

 9 |  * final Queue<String> queue = new ConcurrentLinkedQueue<String>();
10 |  * final Gauge<Integer> queueDepth = new Gauge<Integer>() {
11 |  *     public Integer getValue() {
12 |  *         return queue.size();
13 |  *     }
14 |  * };
15 |  *
16 | * 17 | * @param the type of the metric's value 18 | */ 19 | public interface Gauge extends Metric { 20 | /** 21 | * Returns the metric's current value. 22 | * 23 | * @return the metric's current value 24 | */ 25 | T getValue(); 26 | } 27 | -------------------------------------------------------------------------------- /tests/java/good/MultidimensionArrays.java: -------------------------------------------------------------------------------- 1 | 2 | 3 | public class Some { 4 | 5 | public void assignToArray() { 6 | array[1] = 0; 7 | 8 | array[1][2] = 0; 9 | } 10 | 11 | public void some() { 12 | Object[][] a = new Object[][] {null}; 13 | Object[][] b = new Object[][] {new Object[] {}}; 14 | } 15 | 16 | public void allIndexes() { 17 | Object[][] a = new Object[1][2]; 18 | } 19 | 20 | public void firstIndex() { 21 | onarg(new Object[1][]); 22 | 23 | Object[][] a = new Object[1][] ; 24 | } 25 | 26 | public void onarg(Object[][] ignored) {} 27 | } -------------------------------------------------------------------------------- /tests/java/good/NestedTypeArg.java: -------------------------------------------------------------------------------- 1 | 2 | class Some { 3 | 4 | public void a() { 5 | int some = 0; 6 | 7 | // check that this is not broken 8 | int e = some << 1; 9 | int e = some >> 1; 10 | 11 | some >>>= 1; 12 | some >>= 1; 13 | 14 | boolean a = some > 1; 15 | boolean f = some < 1; 16 | 17 | boolean a1 = some >= 1; 18 | boolean f1 = some <= 1; 19 | 20 | Map> mamap; 21 | 22 | Map> mamap = new HashMap>(); 23 | 24 | final Map> some = null; 25 | } 26 | 27 | 28 | } -------------------------------------------------------------------------------- /tests/java/good/TemplateMethods.java: -------------------------------------------------------------------------------- 1 | 2 | class Some { 3 | void some() {} 4 | public final void somePub() {} 5 | public static void someStatic() {} 6 | } 7 | 8 | class SomeOther extends Some { 9 | void some() { super.some(); } 10 | } -------------------------------------------------------------------------------- /tests/java/good/TestArray.java: -------------------------------------------------------------------------------- 1 | public class TestArray { 2 | public static void main(String[] args) { 3 | while (true) { int x = 1; } 4 | if (1 + 1 == 2) { 5 | } else { 6 | int y = 2, z = 4; 7 | while (y > 0) y--; 8 | System.out.println(y); 9 | int w[][] = {{1,2}, {3}}; 10 | } 11 | 12 | } 13 | } -------------------------------------------------------------------------------- /tests/java/good/TestForLoop.java: -------------------------------------------------------------------------------- 1 | public class Test { 2 | public void test() { 3 | for (i=1; ; ) { 4 | } 5 | } 6 | } -------------------------------------------------------------------------------- /tests/java/good/TestMethodCall.java: -------------------------------------------------------------------------------- 1 | public class Test { 2 | public void _release() { 3 | _get_delegate().release(this); 4 | } 5 | } -------------------------------------------------------------------------------- /tests/java/good/VariousMultipleSemicolons.java: -------------------------------------------------------------------------------- 1 | class SomeClass { 2 | enum Enum { 3 | 4 | };; 5 | 6 | ;; 7 | 8 | public void method() { 9 | ; 10 | ;; 11 | 12 | for(;;); 13 | }; 14 | 15 | ;;;; 16 | 17 | public void otherMethod() { 18 | 19 | };; 20 | } -------------------------------------------------------------------------------- /tests/java/good/abstract.java: -------------------------------------------------------------------------------- 1 | abstract class Point { 2 | int x = 1, y = 1; 3 | void move(int dx, int dy) { 4 | x += dx; 5 | y += dy; 6 | alert(); 7 | } 8 | abstract void alert(); 9 | } 10 | abstract class ColoredPoint extends Point { 11 | int color; 12 | } 13 | 14 | class SimplePoint extends Point { 15 | void alert() { } 16 | } -------------------------------------------------------------------------------- /tests/java/good/annotation.java: -------------------------------------------------------------------------------- 1 | package testPackage; 2 | 3 | @interface TestAnn1 {} 4 | @interface TestAnn2 { 5 | boolean value() default false; 6 | } 7 | @interface TestAnn3 { 8 | String first(); 9 | String last(); 10 | } 11 | 12 | class Other { 13 | @TestAnn1 14 | void Test1() {} 15 | 16 | @TestAnn2(true) 17 | void Test2() {} 18 | 19 | @TestAnn3(first = "foo", last = "bar") 20 | void Test3() {} 21 | } 22 | -------------------------------------------------------------------------------- /tests/java/good/colon-after-class.java: -------------------------------------------------------------------------------- 1 | 2 | 3 | class Some { 4 | 5 | class SomeInner { 6 | 7 | // semicolon after class declaration is correct case 8 | } ; 9 | 10 | class SomeInner { 11 | 12 | // semicolon after class declaration is correct case 13 | } ;; 14 | 15 | 16 | class SomeInner { 17 | 18 | 19 | } /* comment there */ ; 20 | 21 | class SomeInner { 22 | 23 | } // no colon case 24 | 25 | enum Enum { 26 | 27 | }; 28 | 29 | enum Enum { 30 | 31 | } ; 32 | 33 | enum Enum { 34 | 35 | } ;; 36 | 37 | enum Enum { 38 | 39 | } // no colon 40 | 41 | interface Interface { 42 | 43 | }; 44 | 45 | interface Interface { 46 | 47 | };; 48 | 49 | interface Interface { 50 | 51 | } ; 52 | 53 | interface Interface { 54 | 55 | } // no colon 56 | 57 | interface Interface { 58 | 59 | };; 60 | } -------------------------------------------------------------------------------- /tests/java/good/diamond-operator.java: -------------------------------------------------------------------------------- 1 | 2 | 3 | class WithDiamond { 4 | public void method() { 5 | final List list = new ArrayList<>(); 6 | } 7 | } -------------------------------------------------------------------------------- /tests/java/good/invoke-method-after-creating.java: -------------------------------------------------------------------------------- 1 | class Something { 2 | void a() { 3 | new Object().a(); 4 | } 5 | } -------------------------------------------------------------------------------- /tests/java/good/issue_comment.java: -------------------------------------------------------------------------------- 1 | public class MyTest 2 | { 3 | /** 4 | * Constructor for objects of class MyTest 5 | * @param name This is the number 6 | * @param city This is the city 7 | */ 8 | public MyTest(String name, String city) 9 | { 10 | 11 | } // end of MyTest 12 | 13 | /** 14 | 15 | /** 16 | * Raise the bar. 17 | */ 18 | public String up(String x) 19 | { 20 | String result; 21 | if (x.equals("")) { 22 | result = "a"; 23 | } 24 | else { 25 | result = "b"; 26 | } 27 | HashSet set = new Has(); 28 | char ch = result.charAt(0); 29 | int i = ch; 30 | for (Integer eachNum : set) 31 | { 32 | if (eachNum < 100) {} 33 | } 34 | return result; 35 | } 36 | 37 | } 38 | -------------------------------------------------------------------------------- /tests/java/good/lambdas.java: -------------------------------------------------------------------------------- 1 | import a; 2 | 3 | 4 | final class E { 5 | void method() { 6 | final Runnable e = () -> {}; 7 | call(() -> {}); 8 | 9 | final Runnable c = () -> e.run(); 10 | call(() -> e.run()); 11 | 12 | final Runnable c = e::run; 13 | call(e::run); 14 | 15 | final Runnable c = Runnable::run; 16 | call(Runnable::run); 17 | 18 | final Receiver r = (arg) -> {}; 19 | call((arg) -> {}); 20 | 21 | final Receiver r = arg -> {}; 22 | call(arg -> {}); 23 | 24 | final Function r = arg -> othervalue; 25 | call(arg -> othervalue); 26 | 27 | final Function r = arg -> { return othervalue; }; 28 | call(arg -> { return othervalue; }); 29 | 30 | final TwoArgs r = (arg, other) -> { return other; }; 31 | call((arg, other) -> { return other; }); 32 | 33 | } 34 | } 35 | 36 | // these are lambdas by the github user markWot 37 | final class LambdasByMarkWot { 38 | // no Parameters; result is void 39 | Type x = () -> {}; 40 | // No Parameters, expression body 41 | Type x = () -> 42; 42 | // No Parameters; expression body 43 | Type x = () -> null; 44 | // No Parameters; block body with return 45 | Type x = () -> {return 42;}; 46 | // No Parameters; void block body 47 | Type x = () -> {System.gc();}; 48 | // Complex block body with returns 49 | Type x = () -> 50 | { 51 | if (true) return 12; 52 | else { 53 | int result = 15; 54 | for (int i = 1; i < 10; i++) 55 | result *= i; 56 | return result; 57 | } 58 | }; 59 | // Single declared-type parameter 60 | Type x = (int x) -> x + 1; 61 | // Single declared-type parameter 62 | Type x = (int x) -> {return x+1;}; 63 | // Single inferred-type parameter 64 | Type x = (x) -> x+1; 65 | // Parentheses optional for single inferred type parameter 66 | Type x = x -> x + 1; 67 | // Single declared-type parameter 68 | Type x = (String s) -> s.length(); 69 | // Single declared-type parameter 70 | Type x = (Thread t) -> { t.start();}; 71 | // Single inferred-type parameter 72 | Type x = s -> s.length (); 73 | // Single inferred-type parameter 74 | Type x = t -> { t.start();}; 75 | // Multiple declared-type parameters 76 | Type x = (int x, int y) -> x+y; 77 | // Multiple inferred-type parameters 78 | Type x = (x,y) -> x+y; 79 | // No distinction is made between the following lambda parameter lists: 80 | Type x = (int... x) -> {}; 81 | Type x = (int[] x) -> {}; 82 | } 83 | 84 | 85 | class E { 86 | 87 | interface EE { 88 | void call(int e); 89 | } 90 | 91 | interface II { 92 | int call(int e); 93 | } 94 | 95 | interface OO { 96 | II call(int e); 97 | } 98 | 99 | 100 | EE ee = (int x) -> System.out.println("x: " + x); 101 | 102 | II ii = (int y) -> y + 1; 103 | 104 | // lambda returning lambda, why not 105 | OO oo = (int x) -> (int y) -> y + x; 106 | } -------------------------------------------------------------------------------- /tests/java/good/miscMath.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | int divisor; 4 | MiscMath(int divisor) { 5 | this.divisor = divisor; 6 | } 7 | float ratio(long l) { 8 | try { 9 | l /= divisor; 10 | } catch (Exception e) { 11 | if (e instanceof ArithmeticException) 12 | l = Long.MAX_VALUE; 13 | else 14 | l = 0; 15 | } 16 | return (float)l; 17 | } 18 | double gausser() { 19 | Random r = new Random(); 20 | double[] val = new double[2]; 21 | val[0] = r.nextGaussian(); 22 | val[1] = r.nextGaussian(); 23 | return (val[0] + val[1]) / 2; 24 | } 25 | Collection fromArray(Number[] na) { 26 | Collection cn = new ArrayList(); 27 | for (Number n : na) { 28 | cn.add(n); 29 | } 30 | return cn; 31 | } 32 | void loop(S s){ this.loop(s);} 33 | } -------------------------------------------------------------------------------- /tests/java/good/miscMath2.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | Collection cn = new ArrayList(); 5 | for (Number n : na) { 6 | cn.add(n); 7 | } 8 | return cn; 9 | } 10 | } -------------------------------------------------------------------------------- /tests/java/good/miscMath3.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | void loop(S s){ this.loop(s);} 4 | } -------------------------------------------------------------------------------- /tests/java/good/miscMath4.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | for (Number n : na) { 5 | cn.add(n); 6 | } 7 | Collection cn = new ArrayList(); 8 | } 9 | } -------------------------------------------------------------------------------- /tests/java/good/miscMath5.java: -------------------------------------------------------------------------------- 1 | import java.util.Random; 2 | class MiscMath{ 3 | Collection fromArray(Number[] na) { 4 | for (Number n : na) { 5 | cn.add(n); 6 | } 7 | Collection cn = new ArrayList(); 8 | } 9 | } -------------------------------------------------------------------------------- /tests/java/good/nestedComment.java: -------------------------------------------------------------------------------- 1 | /** this is a nested 2 | /** 3 | */ 4 | 5 | public class Comment 6 | { 7 | } 8 | -------------------------------------------------------------------------------- /tests/java/good/rawTypes.java: -------------------------------------------------------------------------------- 1 | import java.util.*; 2 | 3 | class NonGeneric { 4 | 5 | Collection myNumbers(){return null;} 6 | } 7 | abstract class RawMembers extends NonGeneric implements Collection { 8 | static Collection cng = new ArrayList(); 9 | 10 | public static void main(String[] args) { 11 | RawMembers rw = null; 12 | Collection cn = rw.myNumbers(); // ok 13 | Iterator is = rw.iterator(); // unchecked warning 14 | Collection cnn = rw.cng; // ok - static member 15 | } 16 | } -------------------------------------------------------------------------------- /tests/java/good/test.java: -------------------------------------------------------------------------------- 1 | package testPackage; 2 | class Other { static String hello = "Hello"; } -------------------------------------------------------------------------------- /tests/java/good/typeVarMembers.java: -------------------------------------------------------------------------------- 1 | package TypeVarMembers; 2 | 3 | class C { 4 | void mCDefault() {} 5 | public void mCPublic() {} 6 | private void mCPrivate() {} 7 | protected void mCProtected() {} 8 | } 9 | class CT extends C implements I {} 10 | interface I { 11 | void mI(); 12 | void test(T t) ; 13 | } --------------------------------------------------------------------------------