"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"

"{ NameSpace: Smalltalk }"

PPSmalltalkGrammar subclass:#PPCSmalltalkNoopParser

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Benchmarks-Parsers'

!

!PPCSmalltalkNoopParser methodsFor:'accessing'!

startExpression

	"Make the sequence node has a method node as its parent and that the source is set."

	^ ([ :stream | stream collection ] asParser and , super startExpression) map: [ :source :node | 

		(RBMethodNode selector: #doIt body: node)

			source: source.

		(node statements size = 1 and: [ node temporaries isEmpty ])

			ifTrue: [ node statements first ]

			ifFalse: [ node ] ]

!

startMethod

	"Make sure the method node has the source code properly set."

	^ ([ :stream | stream collection ] asParser and , super startMethod)

		map: [ :source :node | node source: source ]

! !

!PPCSmalltalkNoopParser methodsFor:'grammar'!

array

        ^ super array map: [ :openNode :statementNodes :closeNode | ]

    "Modified: / 15-05-2015 / 08:54:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

expression

        ^ super expression map: [ :variableNodes :expressionNodes |  ]

    "Modified: / 15-05-2015 / 08:55:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method

        ^ super method map: [ :methodNode :bodyNode | ]

    "Modified (format): / 15-05-2015 / 08:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

methodDeclaration

        ^ super methodDeclaration ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:55:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

methodSequence

        ^ super methodSequence map: [ :periodNodes1 :pragmaNodes1 :periodNodes2 :tempNodes :periodNodes3 :pragmaNodes2 :periodNodes4 :statementNodes | ]

    "Modified: / 15-05-2015 / 08:55:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parens

        ^ super parens map: [ :openToken :expressionNode :closeToken |  ]

    "Modified: / 15-05-2015 / 08:55:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

pragma

        ^ super pragma ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:55:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

return

        ^ super return map: [ :token :expressionNode |  ]

    "Modified: / 15-05-2015 / 08:55:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

sequence

        ^ super sequence map: [ :tempNodes :periodNodes :statementNodes |  ]

    "Modified: / 15-05-2015 / 08:56:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

variable

        ^ super variable ==> [ :token |  ]

    "Modified: / 15-05-2015 / 08:56:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCSmalltalkNoopParser methodsFor:'grammar-blocks'!

block

        ^ super block map: [ :leftToken :blockNode :rightToken | ]

    "Modified: / 15-05-2015 / 08:56:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

blockArgument

	^ super blockArgument ==> #second

!

blockBody

        ^ super blockBody

                ==> [ :nodes |  ]

    "Modified: / 15-05-2015 / 08:56:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCSmalltalkNoopParser methodsFor:'grammar-literals'!

arrayLiteral

        ^ super arrayLiteral ==> [ :nodes | nodes ]

    "Modified (format): / 15-05-2015 / 08:56:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

arrayLiteralArray

        ^ super arrayLiteralArray ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:56:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

byteLiteral

        ^ super byteLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:56:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

byteLiteralArray

        ^ super byteLiteralArray ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:56:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

charLiteral

        ^ super charLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

falseLiteral

        ^ super falseLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nilLiteral

        ^ super nilLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

numberLiteral

    ^ super numberLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

stringLiteral

        ^ super stringLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

symbolLiteral

        ^ super symbolLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

symbolLiteralArray

        ^ super symbolLiteralArray ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

trueLiteral

        ^ super trueLiteral ==> [ :nodes | nodes ]

    "Modified: / 15-05-2015 / 08:57:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCSmalltalkNoopParser methodsFor:'grammar-messages'!

binaryExpression

        ^ super binaryExpression map: [ :receiverNode :messageNodes |  ]

    "Modified: / 15-05-2015 / 08:57:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

cascadeExpression

        ^ super cascadeExpression map: [ :receiverNode :messageNodes | ]

    "Modified: / 15-05-2015 / 08:57:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

keywordExpression

        ^ super keywordExpression map: [ :receiveNode :messageNode | ]

    "Modified: / 15-05-2015 / 08:58:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

unaryExpression

        ^ super unaryExpression map: [ :receiverNode :messageNodes | ]

    "Modified: / 15-05-2015 / 08:58:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCSmalltalkNoopParser methodsFor:'private'!

addStatements: aCollection into: aNode

	aCollection isNil 

		ifTrue: [ ^ aNode ].

	aCollection do: [ :each |

		each class == PPSmalltalkToken

			ifFalse: [ aNode addNode:  each ]

			ifTrue: [

				aNode statements isEmpty

					ifTrue: [ aNode addComments: each comments ]

					ifFalse: [ aNode statements last addComments: each comments ].

				aNode periods: (aNode periods asOrderedCollection

					addLast: each start;

					yourself) ] ].

	^ aNode

!

build: aNode assignment: anArray

	^ anArray isEmpty

		ifTrue: [ aNode ]

		ifFalse: [

			anArray reverse 

				inject: aNode

				into: [ :result :each |

					RBAssignmentNode 

						variable: each first

						value: result

						position: each second start ] ]

!

build: aNode cascade: anArray 

	| messages semicolons |

	^ (anArray isNil or: [ anArray isEmpty ]) 

		ifTrue: [ aNode ]

		ifFalse: [

			messages := OrderedCollection new: anArray size + 1.

			messages addLast: aNode.

			semicolons := OrderedCollection new.

			anArray do: [ :each | 

				messages addLast: (self 

					build: aNode receiver

					messages: (Array with: each second)).

				semicolons addLast: each first start ].

			RBCascadeNode messages: messages semicolons: semicolons ]

!

build: aNode messages: anArray 

	^ (anArray isNil or: [ anArray isEmpty ]) 

		ifTrue: [ aNode ]

		ifFalse: [

			anArray 

				inject: aNode

				into: [ :rec :msg | 

					msg isNil 

						ifTrue: [ rec ]

						ifFalse: [

							RBMessageNode 

								receiver: rec

								selectorParts: msg first

								arguments: msg second ] ] ]

!

build: aTempCollection sequence: aStatementCollection

	| result |

	result := self

		addStatements: aStatementCollection

		into: RBSequenceNode new.

	aTempCollection isEmpty ifFalse: [

		result

			leftBar: aTempCollection first start

			temporaries: aTempCollection second

			rightBar: aTempCollection last start ].

	^ result

!

buildArray: aStatementCollection

	^ self addStatements: aStatementCollection into: RBArrayNode new

!

buildMethod: aMethodNode

	aMethodNode selectorParts 

		do: [ :each | aMethodNode addComments: each comments ].

	aMethodNode arguments

		do: [ :each | aMethodNode addComments: each token comments ].

	aMethodNode pragmas do: [ :pragma |

		aMethodNode addComments: pragma comments.

		pragma selectorParts 

			do: [ :each | aMethodNode addComments: each comments ].

		pragma arguments do: [ :each | 

			each isLiteralArray

				ifFalse: [ aMethodNode addComments: each token comments ] ].

		pragma comments: nil ].

	^ aMethodNode

!

buildString: aString 

	(aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ])

		ifTrue: [ ^ aString ].

	^ (aString 

		copyFrom: 2

		to: aString size - 1) 

		copyReplaceAll: ''''''

		with: ''''

! !

!PPCSmalltalkNoopParser methodsFor:'token'!

binaryToken

        ^ super binaryToken ==> [ :token | token ]

    "Modified: / 15-05-2015 / 08:54:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

identifierToken

        ^ super identifierToken ==> [ :token | token ]

    "Modified: / 15-05-2015 / 08:54:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

keywordToken

        ^ super keywordToken ==> [ :token | token ]

    "Modified: / 15-05-2015 / 08:54:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

unaryToken

        ^ super unaryToken ==> [ :token | token ]

    "Modified: / 15-05-2015 / 08:54:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !