tools/JavaParserII.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Fri, 06 Sep 2013 00:16:38 +0100
branchdevelopment
changeset 2711 a00302fe5083
parent 2702 e6ebebcddbec
child 2731 13f5be2bf83b
permissions -rw-r--r--
Added version_CVS to all classes and build files regenerated & cleaned. This is necessary step before updating CVS.

"{ Package: 'stx:libjava/tools' }"

JavaParserI subclass:#JavaParserII
	instanceVariableNames:'compilationUnit annotations packageDeclaration importDeclaration
		typeDeclaration qualifiedName qualifiedNameForImport annotation
		classOrInterfaceDeclaration classDeclaration interfaceDeclaration
		normalClassDeclaration enumDeclaration classModifiers
		typeParameters type typeList classBody jsuper interfaces
		typeParameter typeBound enumBody enumConstants
		enumBodyDeclarations enumConstant arguments classBodyDeclaration
		normalInterfaceDeclaration annotationTypeDeclaration
		interfaceModifiers interfaceBody interfaceBodyDeclaration
		fieldDeclaration methodDeclaration methodModifiers
		formalParameters throws qualifiedNameList
		explicitConstructorInvocation blockStatement fieldModifiers
		variableDeclarators variableDeclarator variableInitializer
		interfaceFieldDeclaration interfaceMethodDeclaration
		classOrInterfaceType primitiveType typeArguments typeArgument
		formalParameterDecls ellipsisParameterDecl normalParameterDecl
		variableModifiers nonWildcardTypeArguments primary
		elementValuePairs elementValue elementValuePair
		conditionalExpression elementValueArrayInitializer
		annotationTypeBody annotationTypeElementDeclaration
		annotationMethodDeclaration localVariableDeclarationStatement
		statement localVariableDeclaration expression parExpression
		ifStatement assertStatement basicForStatement
		enhancedForStatement forInit expressionList forStatement
		whileStatement catches catchClause formalParameter doStatement
		tryStatement switchBlockStatementGroup switchLabel
		switchStatement synchronizedStatement returnStatement
		throwStatement breakStatement continueStatement
		expressionStatement labeledStatement emptyStatement
		assignmentOperator conditionalOrExpression
		conditionalAndExpression inclusiveOrExpression
		exclusiveOrExpression andExpression equalityExpression
		instanceofExpression relationalExpression shiftExpression
		relationalOperator additiveExpression shiftOperator
		multiplicativeExpression unaryExpression
		unaryExpressionNotPlusMinus castExpression selector innerCreator
		superSuffix identifierSuffix creator classCreatorRest
		arrayCreator createdName arrayInitializer constructorDeclaration
		constructorModifiers methodNotConstructorDeclaration wildcard
		emptySquaredParenthesis methodModifierNotAnnotation
		classModifierNotAnnotation classInitializer methodBody
		normalParameterDeclsAndEllipsisParameterDecl normalParameterDecls'
	classVariableNames:''
	poolDictionaries:''
	category:'Languages-Java-Parser'
!

!JavaParserII class methodsFor:'documentation'!

documentation
"
    PetitParser based parser for Java. Contains all grammar rules but no action.
    Usefull only for inheriting and extending.

    [author:]
        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!JavaParserII methodsFor:'accessing'!

start
        "Default start production."

        ^ compilationUnit end

    "Modified: / 10-03-2012 / 12:03:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaParserII methodsFor:'as yet unclassified'!

explicitConstructorInvocation

	^ (
		(	nonWildcardTypeArguments optional,
			((self  thisKW) / (self  superKW)))
		
		/	(primary ,
			(self tokenFor: '.') ,
			nonWildcardTypeArguments optional,
			(self  superKW))) ,
		
		arguments , 
		(self tokenFor: ';')
! !

!JavaParserII methodsFor:'grammar'!

arguments 

	^(self tokenFor: '('),
		expressionList optional,
	(self tokenFor: ')')
!

arrayCreator

	^ 	(	(self  newKW) , createdName ,
			emptySquaredParenthesis plus,
			arrayInitializer)
			
		/(	(self  newKW), createdName ,
			((self tokenFor: '['), expression , (self tokenFor: ']')) plus,
			emptySquaredParenthesis star)
!

arrayInitializer 

	^ (self tokenFor: '{'),
		(variableInitializer , ((self tokenFor: ','), variableInitializer ) star) optional,
		(self tokenFor: ',') optional,
	   (self tokenFor: '}')
!

block 
    "Do not parse block's content for now"
    ^super block

    "Following is somewhat broken"    
"/    ^ 
"/        (self tokenFor: '{') ,
"/        blockStatement star,
"/        (self tokenFor: '}')

    "Modified: / 11-03-2012 / 13:21:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classCreatorRest 

	^	arguments , classBody optional
!

compilationUnit 

        ^ 
        (annotations optional, packageDeclaration) optional , 
        importDeclaration star , 
        typeDeclaration star ,
        (self tokenParserFor:#EOF) end

    "Modified (format): / 16-03-2012 / 10:32:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

createdName 

	^ classOrInterfaceType 
	/	primitiveType 
!

creator
		
	^	(	(self  newKW), nonWildcardTypeArguments optional , classOrInterfaceType , classCreatorRest)
		/	arrayCreator
!

elementValue 

        ^(conditionalExpression
        / annotation 
        / elementValueArrayInitializer)

    "Modified: / 15-03-2012 / 09:01:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

elementValueArrayInitializer

	^ (self tokenFor: '{') ,
		(elementValue , 
			((self tokenFor: ',') , elementValue ) star
		) optional ,
		((self tokenFor: ',') optional ),
	  (self tokenFor: '}')
!

elementValuePair 

	^ identifier , (self tokenFor: '=') , elementValue 
!

elementValuePairs 

	^ elementValuePair , ((self tokenFor: ',') , elementValuePair ) star
!

importDeclaration
    "
^       ((self  importKW) , (self  staticKW) optional , identifier),
(       (       (self tokenFor: '.') , (self tokenFor: '*'))
        /(      ((self tokenFor: '.') , identifier) plus , ((self tokenFor: '.') , (self tokenFor: '*')) optional)
),
(self tokenFor: ';')"
    
    ^ ((self importKW) , (self staticKW) optional , qualifiedNameForImport 
        , (self tokenFor:';')).

    "Modified (comment): / 15-12-2012 / 17:36:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

innerCreator 

	^	(self tokenFor: '.'), (self  newKW),
		nonWildcardTypeArguments optional,
		identifier ,
		typeArguments optional,
		classCreatorRest 
!

interfaces

	^ (self  implementsKW) , typeList
!

jsuper

	^ (self  extendsKW) , type
!

nonWildcardTypeArguments 

	^(self tokenFor: '<'),
		typeList ,
	(self tokenFor: '>')
!

packageDeclaration 

        ^ (self  packageKW) , qualifiedName , (self tokenFor:';')

    "Modified: / 15-03-2012 / 09:02:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

primary 

	^		parExpression 
		/(	(self  thisKW),
			((self tokenFor: '.'), identifier ) star,
			identifierSuffix optional)
		/(	identifier,
			((self tokenFor: '.'), identifier ) star,
			 identifierSuffix optional)
		/(	(self  superKW), superSuffix )
		/	literal
		/	creator
		/(	primitiveType,
			emptySquaredParenthesis star,
			(self tokenFor: '.'), (self  classKW))
		/(	(self  voidKW), (self tokenFor: '.'), (self  classKW))
			
!

qualifiedName 

        ^ identifier , ((self tokenFor: '.'), identifier ) star 
            ==> [:nodes|
                String streamContents:[:s|
                    s nextPutAll: nodes first value.
                    nodes second do:[:each|
                        s nextPut:$.; nextPutAll:each second value
                    ]
                ]
            ]

    "Modified: / 16-12-2012 / 10:29:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

qualifiedNameForImport 

    ^(qualifiedName , ( (self tokenFor: '.') , (self tokenFor: '*') ) optional)
        ==> [:nodes|
            nodes second notNil ifTrue:[
                nodes first , '.*'
            ] ifFalse:[
                nodes first
            ]
        ]

    "Created: / 15-12-2012 / 17:32:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-12-2012 / 22:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

typeBound 

	^ type , ((self tokenFor: '&') , type) star
!

typeDeclaration

	^ (self tokenFor: ';') / classOrInterfaceDeclaration
!

typeList 

	^ type , ((self tokenFor: ','), type) star
!

typeParameter 

	^ identifier , ((self  extendsKW) , typeBound) optional
!

typeParameters 

	^ (self tokenFor: '<') , 
			typeParameter , 
			((self tokenFor: ',') , typeParameter) star , 
		(self tokenFor: '>')
!

variableInitializer 

	^	arrayInitializer 
	/	expression	
! !

!JavaParserII methodsFor:'grammar-annotations'!

annotation 

        ^(self tokenFor: '@') , qualifiedName ,
        ((self tokenFor: '(') , 
                (elementValuePairs / elementValue) optional , 
                (self tokenFor: ')') ) optional

    "Modified: / 12-03-2012 / 18:24:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

annotationMethodDeclaration
        "/self flag: 'check whether method modifiers are the right modifiers to use'.
        
        ^ methodModifiers ,
        type ,
        identifier ,
        (self tokenFor: '('), (self tokenFor: ')'),
        ((self  defaultKW), elementValue ) optional ,
        (self tokenFor: ';')

    "Modified: / 23-08-2011 / 00:24:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

annotationTypeBody

	^ (self tokenFor: '{') ,
	(annotationTypeElementDeclaration star),
	(self tokenFor: '}')
!

annotationTypeDeclaration 

        ^ interfaceModifiers , (self tokenFor: '@'),
        (self  interfaceKW) ,
        self typeNameIdentifier ,
        annotationTypeBody

    "Created: / 17-03-2012 / 19:42:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

annotationTypeElementDeclaration
	
	^ annotationMethodDeclaration
	/ interfaceFieldDeclaration 
	/ normalClassDeclaration
	/ enumDeclaration 
	/ annotationTypeDeclaration 
	/ (self tokenFor: ';')
!

annotations 
	
	^ annotation plus
! !

!JavaParserII methodsFor:'grammar-classes'!

classBody 

    ^ (self tokenFor:'{') , classBodyDeclaration star , (self tokenFor:'}').

    "Modified (format): / 15-03-2012 / 09:01:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classBodyDeclaration 

        ^ 
        (self tokenFor: ';')
        / classInitializer
        / fieldDeclaration
        / methodDeclaration
        / classDeclaration 
        / interfaceDeclaration

    "Modified: / 24-08-2013 / 01:44:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classDeclaration 

	^ normalClassDeclaration 
	/ enumDeclaration
!

classInitializer

    ^ ((self  staticKW) optional , block)

    "Created: / 24-08-2013 / 01:44:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classOrInterfaceDeclaration

	^ classDeclaration 
	/ interfaceDeclaration
!

classOrInterfaceType 

	^ identifier ,
	typeArguments optional,
	((self tokenFor: '.'), identifier , typeArguments optional ) star
!

ellipsisParameterDecl

        ^ variableModifiers ,
        type,
        (self tokenParserFor:#Ellipsis) ,
        identifier

    "Modified: / 15-03-2012 / 10:10:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fieldDeclaration
                
    ^ fieldModifiers , type , variableDeclarators, (self tokenFor: ';')

    "Modified: / 15-03-2012 / 09:01:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fieldModifiers

	^ ((self  volatileKW) /
		(self  finalKW) /
		(self  protectedKW) /
		(self  privateKW) /
		(self  publicKW) /
		(self  staticKW) /
		(self  transientKW) /
		annotation) star
!

formalParameter 

	^ variableModifiers ,
	type ,
	identifier ,
	emptySquaredParenthesis star
!

formalParameterDecls

    ^ ellipsisParameterDecl
        / normalParameterDeclsAndEllipsisParameterDecl
        / normalParameterDecls optional


"/    /   ((normalParameterDecl , 
"/                (self tokenFor: ',')) plus , 
"/                ellipsisParameterDecl)
"/                
"/    /   (normalParameterDecl , 
"/                ((self tokenFor: ',') , normalParameterDecl) star)

    "Modified: / 01-09-2013 / 03:17:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

formalParameters 

	^ (self tokenFor: '(') ,
	formalParameterDecls optional ,
	(self tokenFor: ')')
!

normalClassDeclaration 

        ^ classModifiers , (self  classKW) , self typeNameIdentifier ,
                typeParameters optional,
                jsuper optional,
                interfaces optional ,
                classBody

    "Created: / 17-03-2012 / 19:41:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

normalParameterDecl

        ^ variableModifiers ,
        type,
        identifier,
        emptySquaredParenthesis star

    "Modified: / 15-03-2012 / 09:01:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

normalParameterDecls
    ^ normalParameterDecl , ((self tokenFor: ',') , normalParameterDecl) star

    "Created: / 01-09-2013 / 03:18:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

normalParameterDeclsAndEllipsisParameterDecl
    ^ normalParameterDecls , (self tokenFor: ',') , ellipsisParameterDecl

    "Created: / 01-09-2013 / 03:16:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

primitiveType 

	^ (self  booleanKW)  
		"numeric types"
		/ (self  byteKW)
		/ (self  shortKW)
		/ (self  intKW)
		/ (self  longKW)
		/ (self  charKW)
		/ (self  floatKW)
		/ (self  doubleKW)
!

type 

	^ (	classOrInterfaceType 
		/ primitiveType
	), 
	emptySquaredParenthesis star
!

typeArgument 

	^ type
	/ wildcard
!

typeArguments 

    ^ 
"/        (self tokenFor: '<') , 
        '<' asParser trim ,
        (typeArgument , ((self tokenFor: ','), typeArgument) star ) , 
"/        (self tokenFor: '>')
        '>' asParser trim

    "Modified: / 15-03-2012 / 23:18:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

typeNameIdentifier

    ^identifier

    "Created: / 17-03-2012 / 19:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

variableDeclarator 

	^ identifier ,
	((self tokenFor: '[') , (self tokenFor: ']')) star ,
	((self tokenFor: '=') , variableInitializer) optional
!

variableDeclarators

	^ variableDeclarator , ((self tokenFor: ','), variableDeclarator) star
!

wildcard 

	^ (self tokenFor: '?') ,
		(	((self  extendsKW)/(self  superKW)), 
			type 
		) optional
! !

!JavaParserII methodsFor:'grammar-classes-enum'!

enumBody 

	^ (self tokenFor: '{') ,
		enumConstants optional ,
		(self tokenFor: ',') optional ,
		enumBodyDeclarations optional ,
		(self tokenFor: '}')
!

enumBodyDeclarations 

	^ (self tokenFor: ';') , classBodyDeclaration star
!

enumConstant

	^ annotations optional , identifier , arguments optional , classBody optional 
!

enumConstants 

	^ enumConstant , ((self tokenFor: ',') , enumConstant) star
!

enumDeclaration 

        ^ classModifiers ,
           (self  enumKW),
           self typeNameIdentifier ,
           interfaces optional,
           enumBody

    "Created: / 17-03-2012 / 19:42:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaParserII methodsFor:'grammar-classes-interface'!

interfaceBody

	^ (self tokenFor: '{') , interfaceBodyDeclaration star , (self tokenFor: '}')
!

interfaceBodyDeclaration 

	^ interfaceFieldDeclaration
	/ interfaceMethodDeclaration
	/ interfaceDeclaration 
	/ classDeclaration 
	/ (self tokenFor: ';')
!

interfaceDeclaration 

	^normalInterfaceDeclaration 
	/ annotationTypeDeclaration
!

interfaceFieldDeclaration 

	^ fieldModifiers , 
	type ,
	variableDeclarators ,
	(self tokenFor: ';')
!

interfaceMethodDeclaration 

	^ methodModifiers ,
	typeParameters optional,
	((self  voidKW) / type) ,
	identifier ,
	formalParameters ,
	emptySquaredParenthesis star ,
	throws optional ,
	(self tokenFor: ';')
!

interfaceModifiers

        ^ ((self abstractKW)
                /(self  protectedKW) 
                /(self  privateKW) 
                /(self  publicKW) 
                /(self  staticKW)
                /(self  strictfpKW) 
                /annotation) star

    "Modified: / 15-03-2012 / 09:01:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

normalInterfaceDeclaration

        ^ interfaceModifiers , 
        (self  interfaceKW) , 
        self typeNameIdentifier , 
        typeParameters optional , 
        ((self  extendsKW) , typeList ) optional ,
        interfaceBody

    "Created: / 17-03-2012 / 19:42:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaParserII methodsFor:'grammar-classes-method'!

constructorDeclaration

        ^ constructorModifiers optional , 
           typeParameters optional , 
           self constructorNameIdentifier,
           formalParameters ,
           throws optional , 
           block
"/           (self tokenFor: '{' ) , 
"/                        explicitConstructorInvocation optional ,
"/                        blockStatement star ,
"/           (self tokenFor: '}')

    "Modified: / 17-03-2012 / 19:08:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

constructorModifiers 

	^ ((self  protectedKW)
		/ (self  privateKW)
		/ (self  publicKW)
		/ annotation) plus
!

constructorNameIdentifier

    ^identifier

    "Created: / 17-03-2012 / 19:08:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

methodBody

    ^  (self tokenFor: $;) / block

    "Created: / 25-08-2013 / 00:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

methodDeclaration

	^ constructorDeclaration 
	/ methodNotConstructorDeclaration
!

methodModifierNotAnnotation

	^ (self abstractKW)
		/ (self  finalKW)
		/ (self  nativeKW)
		/ (self  protectedKW)
		/ (self  privateKW)
		/ (self  publicKW)
		/ (self  staticKW)
		/ (self  strictfpKW) 
		/ (self  synchronizedKW) 
!

methodModifiers 

	^ (	methodModifierNotAnnotation
		/ annotation) star
!

methodNameIdentifier

    ^identifier

    "Created: / 17-03-2012 / 19:08:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

methodNotConstructorDeclaration

        ^ methodModifiers,
           typeParameters optional,
           ((self  voidKW) / type),
           self methodNameIdentifier,
           formalParameters ,
           emptySquaredParenthesis star ,
           throws optional,
           methodBody

    "Modified: / 25-08-2013 / 00:49:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

qualifiedNameList 

	^ qualifiedName , ((self tokenFor: ',') , qualifiedName ) star
!

throws 

	^ (self  throwsKW) , qualifiedNameList
! !

!JavaParserII methodsFor:'grammar-expressions'!

additiveExpression

	^ multiplicativeExpression , 
	(( (self tokenFor: '+') / (self tokenFor: '-') ) , multiplicativeExpression ) star
!

andExpression

	^ equalityExpression , ((self tokenFor: '&') , equalityExpression) star
!

assignmentOperator 

	^ (self tokenFor: '=')
	/ (self tokenFor: '>>>=')
	/	(self tokenFor: '>>=')
	/	(self tokenFor: '<<=')
	/	(self tokenFor: '&=')
	/	(self tokenFor: '^=')
	/	(self tokenFor: '|=')
	/	(self tokenFor: '-=')
	/	(self tokenFor: '+=')
	/	(self tokenFor: '%=')
	/	(self tokenFor: '/=')
	/	(self tokenFor: '*=')
		
!

castExpression

	^ ((self tokenFor: '('), 
			primitiveType ,
		(self tokenFor: ')'), unaryExpression )
		
	/ ((self tokenFor: '('),
			type,
		(self tokenFor: ')'), unaryExpressionNotPlusMinus )
!

conditionalAndExpression 

	^inclusiveOrExpression ,
	((self tokenFor: '&&'), inclusiveOrExpression ) star
!

conditionalExpression 

	^conditionalOrExpression ,
	((self tokenFor: '?'), expression , (self tokenFor: ':'), conditionalExpression ) optional
!

conditionalOrExpression 

	^conditionalAndExpression ,
	((self tokenFor: '||'), conditionalAndExpression ) star
!

equalityExpression

	^ instanceofExpression , 
	(((self tokenFor: '!!=') / (self tokenFor: '==')) , instanceofExpression) star
!

exclusiveOrExpression

	^ andExpression , ((self tokenFor: '^') , andExpression) star
!

expression 

	^ conditionalExpression , 
	(assignmentOperator , expression) optional
!

identifierSuffix 

	^ (		emptySquaredParenthesis plus , (self tokenFor: '.'), (self  classKW))
		/	(((self tokenFor: '[') , expression , (self tokenFor: ']')) plus)
		/	arguments 
		/	((self tokenFor: '.'),
			(	(self  classKW)
			/	(self  thisKW)
			/	((self  superKW), arguments)
			/	(nonWildcardTypeArguments , identifier , arguments)))
		/	innerCreator
!

inclusiveOrExpression

	^ exclusiveOrExpression , 
	((self tokenFor: '|') , exclusiveOrExpression) star
!

instanceofExpression

	^  relationalExpression , 
	((self  instanceofKW) , type) optional
!

multiplicativeExpression

	^ unaryExpression , 
	(( (self tokenFor: '*') 
	   / (self tokenFor: '/') 
	   / (self tokenFor: '%') ) , unaryExpression ) star
!

parExpression

	^ (self tokenFor: '(') , expression , (self tokenFor: ')')
!

relationalExpression

	^  shiftExpression , 
	(relationalOperator , shiftExpression) star
!

relationalOperator

	^ (self tokenFor: '<=')
	/ (self tokenFor: '>=')
	/	(self tokenFor: '<')
	/	(self tokenFor: '>')
!

selector 

	^	(	(self tokenFor: '.') , identifier, arguments optional )
		/(	(self tokenFor: '.'), (self  thisKW))
		/(	(self tokenFor: '.'), (self  superKW), superSuffix)
		/	innerCreator 
		/(	(self tokenFor: '['), expression , (self tokenFor: ']'))
!

shiftExpression

	^ additiveExpression,
	(shiftOperator , additiveExpression) star
!

shiftOperator 
        "/self flag: 'maybe it should be detokenized, check the behavior with javac'.

        ^ (self tokenFor: '<<')
        / (self tokenFor: '>>>')
        /       (self tokenFor: '>>')

    "Modified: / 23-08-2011 / 00:25:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

superSuffix 

	^ arguments 
	/ (	(self tokenFor: '.'), typeArguments optional ,
		identifier ,
		arguments optional)
!

unaryExpression 

	^ (((self tokenFor: '++')
		/(self tokenFor: '+')
		/(self tokenFor: '--')
		/(self tokenFor: '-')),
			unaryExpression)
	/unaryExpressionNotPlusMinus
!

unaryExpressionNotPlusMinus 
	
	^ ( ( 	(self tokenFor: '~') 
			/(self tokenFor: '!!') ) , unaryExpression )
	/castExpression
	/ (	primary,
		selector star,
		(	(self tokenFor: '++')
			/(self tokenFor: '--')) optional)
! !

!JavaParserII methodsFor:'grammar-modifiers'!

classModifierNotAnnotation

        ^       (self abstractKW) 
        /       (self finalKW) 
        /       (self protectedKW) 
        /       (self privateKW) 
        /       (self publicKW) 
        /       (self staticKW)
        /       (self strictfpKW)

    "Modified (format): / 10-03-2012 / 23:39:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classModifiers

    ^ (classModifierNotAnnotation / annotation) star

    "Modified (format): / 10-03-2012 / 23:55:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

variableModifiers 

	^((self  finalKW) 
	  / annotation) star
! !

!JavaParserII methodsFor:'grammar-statements'!

assertStatement 

	^ (self assertKW) , expression , 
	((self tokenFor: ':'), expression ) optional ,
	(self tokenFor: ';')
!

basicForStatement

	^ (self  forKW) ,
	(self tokenFor: '('),
		forInit optional, (self tokenFor: ';'),
		expression , (self tokenFor: ';'),
		expressionList optional,
	(self tokenFor: ')'),
	statement
		
!

blockStatement  

	^ localVariableDeclarationStatement
	/ classOrInterfaceDeclaration 
	/ statement
!

breakStatement 

	^ (self  breakKW) , identifier optional , (self tokenFor: ';')
!

catchClause

	^ (self  catchKW) ,
	(self tokenFor: '(') ,
		formalParameter ,
	(self tokenFor: ')'), 
	block
	
!

catches 

	^ catchClause , catchClause star
!

continueStatement 

	^ (self tokenFor: 'continue') , identifier optional , (self tokenFor: ';')
!

doStatement

	^(self  doKW) , statement ,
	(self  whileKW) , parExpression ,
	(self tokenFor: ';')
!

emptyStatement 

	^ (self tokenFor: ';')
!

enhancedForStatement

	^ (self  forKW) , 
	(self tokenFor: '(') , 
		variableModifiers , 
		type , 
		identifier , 
		(self tokenFor: ':'),
		expression,
	(self tokenFor: ')'),
	statement
!

expressionList 

	^ expression , ((self tokenFor: ','), expression ) star
!

expressionStatement 

	^ expression , (self tokenFor: ';')
!

forInit

	^ localVariableDeclaration 
	/ expressionList 
!

forStatement

	^ enhancedForStatement 
	/ basicForStatement
!

ifStatement

	^(self  ifKW) , parExpression , statement , 
	((self  elseKW), statement ) optional
!

labeledStatement 

	^ identifier , (self tokenFor: ':') , statement 
!

localVariableDeclaration

	^ variableModifiers , type , variableDeclarators 
!

localVariableDeclarationStatement

	^ localVariableDeclaration , (self tokenFor: ';')
!

returnStatement 

	^ (self  returnKW) , expression optional , (self tokenFor: ';')
!

statement 

	^ block
	/ assertStatement
	/ ifStatement
	/ forStatement
	/ whileStatement
	/ doStatement
	/ tryStatement
	/ switchStatement
	/ synchronizedStatement
	/ returnStatement
	/ throwStatement
	/ breakStatement
	/ continueStatement
	/ expressionStatement
	/ labeledStatement
	/ emptyStatement
!

switchBlockStatementGroup
	
	^ switchLabel , blockStatement star
!

switchLabel 

	^ ((self  caseKW) , expression , (self tokenFor: ':'))
	/ ((self  defaultKW), (self tokenFor: ':'))
!

switchStatement

	^(self  switchKW) , parExpression , 
	(self tokenFor: '{'),
		switchBlockStatementGroup star ,
	(self tokenFor: '}')
!

synchronizedStatement 

	^ (self  synchronizedKW) , parExpression , block
!

throwStatement 

	^ (self  throwKW) , expression , (self tokenFor: ';')
!

tryStatement 

	^ (self  tryKW) , block ,
	(	(catches , (self  finallyKW) , block)
		/ catches
		/ ((self  finallyKW), block)
	)
!

whileStatement

	^(self  whileKW) , parExpression , statement
! !

!JavaParserII class methodsFor:'documentation'!

version_CVS
    ^ '$Header$'
!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '§Id§'
! !