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

"{ NameSpace: Smalltalk }"

PPParser subclass:#PPCompiledParser

	instanceVariableNames:'startSymbol context failure error'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Parsers'

!

PPCompiledParser class instanceVariableNames:'parsers constants referringParser startSymbol'

"

 No other class instance variables are inherited by this class.

"

!

!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.

!

constants

    constants ifNil: [ constants := IdentityDictionary new ].

    ^ constants

!

parse: input

    ^ self new parse: input

!

referringParser

    ^ referringParser ifNil: [ ^ PPSentinel new ]

!

referringParser: aPPParser

    referringParser := aPPParser

!

startSymbol

    ^ startSymbol ifNil: [ ^ #start ]

!

startSymbol: symbol

    startSymbol := symbol

! !

!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 := self class startSymbol.

!

isCompiled

    ^ true

!

isError

    ^ error

!

parse: input rule: symbol

    startSymbol := symbol.

    ^ self parse: input.

!

start

    ^ self subclassResponsibility

!

startSymbol: aSymbol

    startSymbol := aSymbol

! !

!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

! !