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

"{ NameSpace: Smalltalk }"

PPParser subclass:#PPCompiledParser
	instanceVariableNames:'startSymbol context failure error currentTokenValue
		currentTokenType'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Core'
!

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

!PPCompiledParser methodsFor:'tokenizing'!

consume: tokenType
	(currentTokenType = tokenType) ifTrue: [ 
		| retval |
		retval := currentTokenValue.
		self nextToken.
		^ retval
	] ifFalse: [ 
		self error: 'expected: ', tokenType storeString, ' got ', currentTokenType storeString.
	]
!

currentTokenType
	currentTokenType isNil ifTrue: [ self nextToken ].
	^ currentTokenType
!

currentTokenValue
	currentTokenType isNil ifTrue: [ self nextToken ].
	^ currentTokenType
!

nextToken
	self shouldBeImplemented
! !