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

PPCListNode subclass:#PPCChoiceNode

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Nodes'

!

!PPCChoiceNode methodsFor:'as yet unclassified'!

acceptsEpsilon

	^ self acceptsEpsilonOpenSet: IdentitySet new.

!

acceptsEpsilonOpenSet: set

	set add: self.

	^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ].

!

compileWith: compiler effect: effect id: id

	| firsts guard  |

	compiler addVariable: 'element'.

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

	compiler startMethod: id.

	compiler addVariable: 'element'.

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

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

		firsts anyOne compileWhitespace: compiler.

	].

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

		child := children at: idx.

		(compiler guards and: [ (guard := PPCGuard on: child) makesSense ]) ifTrue: [ 	

			guard id: (compiler idFor: guard prefixed: #guard).

			guard compileGuard: compiler.

			compiler add: ' ifTrue: [ '.

			compiler indent.

				compiler add: 'self clearError.'.

				compiler add: 'element := '.

				compiler callOnLine: (child compileWith: compiler).

				compiler add: 'error ifFalse: [ ^ element ].'.

			compiler dedent.

			compiler add: ' ].'.

		] ifFalse: [

			compiler add: 'self clearError.'.

			compiler add: 'element := '.

			compiler callOnLine: (child compileWith: compiler).

			compiler add: 'error ifFalse: [ ^ element ].'.

		]

	].

	compiler add: '^ self error: ''no choice suitable'''.

 ^ compiler stopMethod.

!

prefix

	^ #ch

! !

!PPCChoiceNode methodsFor:'optimizing'!

optimize: params status: changeStatus

	| retval |

	retval := self.

	retval := retval rewrite: params status: changeStatus.

	retval := retval inline: params status: changeStatus.

	^ retval

! !