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

PPParser subclass:#PPCompiledParser

	instanceVariableNames:'startSymbol context failure error'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Core'

!

PPCompiledParser class instanceVariableNames:'parsers constants referringParser'

"

 No other class instance variables are inherited by this class.

"

!

PPCompiledParser comment:''

!

!PPCompiledParser class methodsFor:'as yet unclassified'!

addConstant: value as: id

	self constants at: id ifPresent: [ 

		((self constants at: id) = value) ifFalse: [self error: 'ooups']].	

	self constants at: id put: value.

!

addParser: aPPParser as: id

	"(self parsers includesKey: id) ifTrue: [self error: 'Ooups' ]."

	self parsers at: id put: aPPParser.

!

constants

	constants ifNil: [ constants := IdentityDictionary new ].

	^ constants

!

parse: input

	^ self new parse: input

!

parsers

	parsers ifNil: [ parsers := IdentityDictionary new ].

	^ parsers

!

referringParser

	^ referringParser 

!

referringParser: aPPParser

	referringParser := aPPParser

! !

!PPCompiledParser methodsFor:'as yet unclassified'!

callParser: id

	| retval |

	retval := (self class parsers at: id) parseOn: context.

	retval isPetitFailure 	ifTrue: [ self error: retval message at: retval position ]

									ifFalse: [ self clearError ].

	^ retval

!

clearError

	error := false.

!

error

	^ self error: '' at: context position

!

error: message

	^ self error: message at: context position

!

error: aMessage at: position

	failure position < position ifTrue: [

		failure message: aMessage.

		failure position: position

	].

	error := true.

	^ failure

!

initialize

	super initialize.

	self class constants keysAndValuesDo: [ :key :value |

		self instVarNamed: key put: value.

	].

	startSymbol := #start.

!

isCompiled

	^ true

!

isError

	^ error

!

parse: input rule: symbol

	startSymbol := symbol.

	^ self parse: input.

!

start

	^ self subclassResponsibility

!

startSymbol: aSymbol

	startSymbol := aSymbol

!

updateContext: aPPContext

	self class referringParser allParsersDo: [ :p | p updateContext: aPPContext ].

! !

!PPCompiledParser methodsFor:'parsing'!

parseOn: aPPContext

	| retval |

"	context := aPPContext asCompiledParserContext."

	context := aPPContext.

	context compiledParser: self.

	failure := PPFailure new message: nil; context: context; position: -1.

	context noteFailure: failure.

	error := false.

	retval := self perform: startSymbol.

	(retval isPetitFailure) ifTrue: [ aPPContext noteFailure: failure ].

	error ifTrue: [ aPPContext noteFailure: failure. retval := failure ].

"	aPPContext position: context position."

	^ retval

! !