hg/stx-goodies-petitparser: comparison analyzer/extensions.st

equal deleted inserted replaced

-:0bbbcf5da2d4
+:1825151d6455
 	aSeenDictionary at: self ifPresent: [ :value | ^ value ].
 	copy := aSeenDictionary at: self put: self copy.
 	copies := OrderedCollection new.
 	parsers do: [ :each |
 		| result |
 		result := each
 			copyInContext: aDictionary
 			seen: aSeenDictionary.
 		result isCollection
 			ifTrue: [ copies addAll: result ]
 			ifFalse: [ copies add: result ] ].
 ! !
 !PPNotParser methodsFor:'*petitanalyzer-private'!
 firstSets: aFirstDictionary into: aSet
 ! !
 !PPNotParser methodsFor:'*petitanalyzer-testing'!
 isFirstSetTerminal
 !PPParser methodsFor:'*petitanalyzer-named'!
 allNamedParsersDo: aBlock
 	"Iterate over all the named parse nodes of the receiver."
 	self allParsersDo: [ :each |
 		each name notNil
 			ifTrue: [ aBlock value: each ] ]
 ! !
 !PPParser methodsFor:'*petitanalyzer-matching'!
 !PPParser methodsFor:'*petitanalyzer-matching'!
 copyInContext: aDictionary seen: aSeenDictionary
 	| copy |
 	aSeenDictionary
 		at: self
 		ifPresent: [ :value | ^ value ].
 	copy := aSeenDictionary
 		at: self
 		put: self copy.
 	copy children do: [ :each |
 !PPParser methodsFor:'*petitanalyzer-querying'!
 cycleSet
 	"Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible."
 	| cycles |
 	cycles := IdentitySet new.
 	self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles.
 	^ cycles
 ! !
 cycleSet: aStack firstSets: aDictionary into: aSet
 	"PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don't process the children further and add the nodes to aSet."
 	| index |
 	self isTerminal
 		ifTrue: [ ^ self ].
 	(index := aStack indexOf: self) > 0
 		ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ].
 	aStack addLast: self.
 	(self cycleSet: aDictionary)
 		do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ].
 !PPParser methodsFor:'*petitanalyzer-querying'!
 firstSet
 	"Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once."
 	^ self firstSets at: self
 ! !
 !PPParser methodsFor:'*petitanalyzer-querying'!
 firstSets
 	"Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser."
 	| firstSets |
 	firstSets := IdentityDictionary new.
 	self allParsersDo: [ :each |
 		firstSets at: each put: (each isFirstSetTerminal
 			ifTrue: [ IdentitySet with: each ]
 !PPParser methodsFor:'*petitanalyzer-querying'!
 followSets
 	"Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser."
 	| current previous continue firstSets followSets |
 	current := previous := 0.
 	firstSets := self firstSets.
 	followSets := IdentityDictionary new.
 	self allParsersDo: [ :each | followSets at: each put: IdentitySet new ].
 	(followSets at: self) add: PPSentinel instance.
 	[	followSets keysAndValuesDo: [ :parser :follow |
 			parser
 				followSets: followSets
 				firstSets: firstSets
 				into: follow ].
 		current := followSets
 			inject: 0
 !PPParser methodsFor:'*petitanalyzer-private'!
 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
 	"PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
 	self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]
 ! !
 !PPParser methodsFor:'*petitanalyzer-named'!
 !PPParser methodsFor:'*petitanalyzer-named'!
 innerChildrenDo: aBlock seen: aSet
 	"Iterate over the inner children of the receiver."
 	self children do: [ :each |
 		(aSet includes: each)
 			ifTrue: [ ^ self ].
 		aSet add: each.
 		each name isNil ifTrue: [
 !PPParser methodsFor:'*petitanalyzer-testing'!
 isNullable
 	"Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
 	^ false
 ! !
 !PPParser methodsFor:'*petitanalyzer-testing'!
 	parser := matchList at: matchIndex.
 	parser class = PPListPattern ifTrue: [
 		currentIndex := parserIndex - 1.
 		[ currentDictionary := aDictionary copy.
 		currentSeen := aSet copy.
 		parserList size < currentIndex or: [
 			parsers := parserList copyFrom: parserIndex to: currentIndex.
 			(currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [
 				(self
 					matchList: matchList
 					index: matchIndex + 1
 					against: parserList
 					index: currentIndex + 1
 					inContext: currentDictionary
 					seen: currentSeen)
 					ifTrue: [
 						currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ].
 						^ true ].
 				false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ].
 		^ false ].
 	parserList size < parserIndex
 !PPParser methodsFor:'*petitanalyzer-named'!
 namedChildrenDo: aBlock seen: aSet
 	"Iterate over the named children of the receiver."
 	self children do: [ :each |
 		(aSet includes: each)
 			ifTrue: [ ^ self ].
 		aSet add: each.
 		each name isNil
 !PPRepeatingParser methodsFor:'*petitanalyzer-private'!
 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
 	| firstSet |
 	super followSets: aFollowDictionary firstSets:  aFirstDictionary into: aSet.
 	firstSet := aFirstDictionary at: self.
 	self children do: [:p | (aFollowDictionary at: p) addAll: (firstSet reject: [:each | each isNullable]) ]
 ! !
 !PPRepeatingParser methodsFor:'*petitanalyzer-testing'!
 		| followSet firstSet |
 		followSet := aFollowDictionary at: parser.
 		index = parsers size
 			ifTrue: [ followSet addAll: aSet ]
 			ifFalse: [
 				(self class withAll: (parsers
 					copyFrom: index + 1 to: parsers size))
 						firstSets: aFirstDictionary
 						into: (firstSet := IdentitySet new).
 				(firstSet anySatisfy: [ :each | each isNullable ])
 					ifTrue: [ followSet addAll: aSet ].
 				followSet addAll: (firstSet
 					reject: [ :each | each isNullable ]) ] ]
 ! !
 !PPTokenParser methodsFor:'*petitanalyzer-matching'!

changeset 382	1825151d6455
parent 381	0bbbcf5da2d4