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

PPDelegateParser subclass:#PPCompositeParser
	instanceVariableNames:'dependencies'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitParser-Tools'
!


!PPCompositeParser class methodsFor:'instance creation'!

new
	"Answer a new parser starting at the default start symbol."

	^ self newStartingAt: self startSymbol
!

newStartingAt: aSymbol
	"Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."

	| parsers remaining |
	parsers := IdentityDictionary new.
	remaining := OrderedCollection with: self.
	[ remaining isEmpty ] whileFalse: [
		| dependency |
		dependency := remaining removeLast.
		(parsers includesKey: dependency) ifFalse: [
			parsers at: dependency put: dependency basicNew.
			remaining addAll: dependency dependencies ] ].
	parsers keysAndValuesDo: [ :class :parser |
		| dependencies |
		dependencies := IdentityDictionary new.
		class dependencies 
			do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].
		parser 
			initializeStartingAt: (class == self
				ifTrue: [ aSymbol ]
				ifFalse: [ class startSymbol ]) 
			dependencies: dependencies ].
	parsers keysAndValuesDo: [ :class :parser |
		parser setParser: (parser perform: parser children first name).
		parser productionNames keysAndValuesDo: [ :key :value |
			(parser instVarAt: key) setParser: (parser perform: value) ] ].
	^ parsers at: self
! !

!PPCompositeParser class methodsFor:'accessing'!

dependencies
	"Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."

	^ #()
!

ignoredNames
	"Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."

	^ PPCompositeParser allInstVarNames
!

startSymbol
	"Answer the method that represents the default start symbol."

	^ #start
! !

!PPCompositeParser class methodsFor:'parsing'!

parse: anObject
	^ self parse: anObject startingAt: self startSymbol
!

parse: anObject onError: aBlock
	^ self parse: anObject startingAt: self startSymbol onError: aBlock
!

parse: anObject startingAt: aSymbol
	^ (self newStartingAt: aSymbol) parse: anObject
!

parse: anObject startingAt: aSymbol onError: aBlock
	^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock
! !

!PPCompositeParser methodsFor:'accessing'!

start
	"Answer the production to start this parser with."
	
	self subclassResponsibility
! !

!PPCompositeParser methodsFor:'initialization'!

initializeStartingAt: aSymbol
	| allVariableNames ignoredVariableNames productionIndexesAndNames |
	self initialize.	

	"find all the productions that need to be initialized"
	allVariableNames := self class allInstVarNames
		collect: [ :each | each asSymbol ].
	ignoredVariableNames := self class ignoredNames
		collect: [ :each | each asSymbol ].
	productionIndexesAndNames := ((1 to: self class instSize)
		collect: [ :index | index -> (allVariableNames at: index) ])
		reject: [ :assoc | ignoredVariableNames includes: assoc value ].
	
	"initialize productions with an undefined parser to be replaced later"
	parser := PPUnresolvedParser named: aSymbol.
	productionIndexesAndNames do: [ :assoc |
		self instVarAt: assoc key put: (PPUnresolvedParser named: assoc value) ].
	parser def: (self perform: aSymbol).
	
	"resolve unresolved parsers with their actual implementation"
	productionIndexesAndNames do: [ :assoc |
		(self respondsTo: assoc value)
			ifFalse: [ self error: 'Unable to initialize ' , assoc value printString ]
			ifTrue: [ (self instVarAt: assoc key) def: (self perform: assoc value) ] ]
!

initializeStartingAt: aSymbol dependencies: aDictionary
	self initialize.
	parser := PPDelegateParser named: aSymbol.
	self productionNames keysAndValuesDo: [ :key :value |
		self instVarAt: key put: (PPDelegateParser named: value) ].
	dependencies := aDictionary
! !

!PPCompositeParser methodsFor:'querying'!

dependencyAt: aClass
	"Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."
	
	^ dependencies at: aClass ifAbsent: [ self error: 'Undeclared dependency in ' , self class name , ' to ' , aClass name ]
!

productionAt: aSymbol
	"Answer the production named aSymbol."
	
	^ self productionAt: aSymbol ifAbsent: [ nil ]
!

productionAt: aSymbol ifAbsent: aBlock
	"Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock."
	
	(self class ignoredNames includes: aSymbol asString)
		ifTrue: [ ^ aBlock value ].
	(self class startSymbol = aSymbol)
		ifTrue: [ ^ parser ].
	^ self instVarAt: (self class allInstVarNames
		indexOf: aSymbol asString
		ifAbsent: [ ^ aBlock value ])
!

productionNames
	"Answer a dictionary of slot indexes and production names."
	
	| productionNames ignoredNames |
	productionNames := Dictionary new.
	ignoredNames := self class ignoredNames
		collect: [ :each | each asSymbol ].
	self class allInstVarNames keysAndValuesDo: [ :key :value |
		(ignoredNames includes: value asSymbol)
			ifFalse: [ productionNames at: key put: value asSymbol ] ].
	^ productionNames
! !

!PPCompositeParser class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPCompositeParser.st,v 1.4 2014-03-04 14:33:36 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPCompositeParser.st,v 1.4 2014-03-04 14:33:36 cg Exp $'
!

version_SVN
    ^ '$Id: PPCompositeParser.st,v 1.4 2014-03-04 14:33:36 cg Exp $'
! !