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

PPCListNode subclass:#PPCSequenceNode

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Nodes'

!

!PPCSequenceNode methodsFor:'accessing'!

prefix

	^ #seq

! !

!PPCSequenceNode methodsFor:'analysis'!

acceptsEpsilon

	^ self acceptsEpsilonOpenSet: IdentitySet new.

!

acceptsEpsilonOpenSet: set

	set add: self.

	^ self children allSatisfy: [:e | e acceptsEpsilonOpenSet: set ]

!

firstSetSuchThat: block into: aCollection openSet: aSet

	(aSet includes: self) ifTrue: [ ^ aCollection ].

	aSet add: self.

	(block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].

	self children do: [ :child | 

		child firstSetSuchThat: block into: aCollection openSet: aSet.

		child acceptsEpsilon ifFalse: [ ^ aCollection ]

	].

	^ aCollection

!

firstSets: aFirstDictionary into: aSet suchThat: aBlock

	| nullable |

	"TODO JK: aBlock is ignored by now"

	children do: [ :node |

		nullable := false.

		(aFirstDictionary at: node) do: [ :each |

			each isNullable

				ifTrue: [ nullable := true ]

				ifFalse: [ aSet add: each ] ].

		nullable

			ifFalse: [ ^ self ] ].

	aSet add: PPCSentinelNode instance

! !

!PPCSequenceNode methodsFor:'compiling'!

addGuard: compiler id: id

	|  guard firsts |

	(compiler guards not or: [(guard := PPCGuard on: self) makesSense not]) ifTrue: [ ^ self].

	firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).

	(firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [  

		"If we start with trimming, we should invoke the whitespace parser"

		firsts anyOne compileWhitespace: compiler.

		compiler add: 'context atEnd ifTrue: [ ^ self error ].'.

		guard id: id, '_guard'.

		guard compileGuard: compiler.

		compiler addOnLine: 'ifFalse: [ ^ self error ].'

	].

	(firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [  

		compiler add: 'context atEnd ifTrue: [ ^ self error ].'.

		guard id: id, '_guard'.

		guard compileGuard: compiler.

		compiler addOnLine: 'ifFalse: [ ^ self error ].'

	].

!

compileWith: compiler effect: effect id: id

	compiler startMethod: id.

	compiler addVariable: 'retval'.

	compiler addVariable: 'element'.

	compiler addVariable: 'memento'.			

	compiler add: (compiler smartRemember: self).

	compiler add: 'retval := Array new: ', children size asString, '.'.

	self addGuard: compiler id: id.

"	Halt if: [ self name = #qualifiedName ]."

	(1 to: children size) do: [ :idx  | |child|

		child := children at: idx.

		compiler add: 'element := '.

		compiler callOnLine: (child compileWith: compiler).

		compiler add: 'error ifTrue: [ ', (compiler smartRestore: self) ,' ^ failure ].'.

		compiler add: 'retval at: ', idx asString, ' put: element.'.

	].

	compiler add: '^ retval'.

 ^ compiler stopMethod.

! !

!PPCSequenceNode methodsFor:'first follow next'!

followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock

	children keysAndValuesDo: [ :index :node |

		| follow first |

		follow := aFollowDictionary at: node.

		index = children size

			ifTrue: [ follow addAll: aSet ]

			ifFalse: [

				(self class withAll: (children 

					copyFrom: index + 1 to: children size))

						firstSets: aFirstDictionary

						into: (first := IdentitySet new)

						suchThat: aBlock.

				(first anySatisfy: [ :each | each isNullable ])

					ifTrue: [ follow addAll: aSet ].

				follow addAll: (first 

					reject: [ :each | each isNullable ]) ] ]

! !

!PPCSequenceNode methodsFor:'optimizing'!

asFast

	^ PPCTokenSequenceNode new

		children: children;

		name: self name;

		properties: properties;

		yourself

! !