class: PPParser expecco_18_1_0 expecco_18_1_0wa1 expecco_2_10_0 expecco_2_10_0_41 expecco_2_11_0 expecco_2_11_1 expecco_2_9_0 expecco_2_9_0_win75_lx36 expecco_2_9_1 expecco_ALM_1_10_0 expecco_ALM_1_10_0_8 expecco_ALM_1_11_0 expecco_ALM_1_11_0_2 expecco_ALM_1_11_2 expecco_head_5844
authorClaus Gittinger <cg@exept.de>
Wed, 05 Mar 2014 00:58:41 +0100
changeset 366 225737f7f83f
parent 365 5fb1869bd3c7
child 367 cfa73b1eb058
class: PPParser comment/format in: #>=>
PPParser.st
--- a/PPParser.st	Wed Mar 05 00:58:31 2014 +0100
+++ b/PPParser.st	Wed Mar 05 00:58:41 2014 +0100
@@ -18,323 +18,17 @@
 	^ self basicNew initialize
 ! !
 
-!PPParser methodsFor:'*petitanalyzer-enumerating'!
-
-allParsers
-	"Answer all the parse nodes of the receiver."
-
-	| result |
-	result := OrderedCollection new.
-	self allParsersDo: [ :parser | result addLast: parser ].
-	^ result
-!
-
-allParsersDo: aBlock
-	"Iterate over all the parse nodes of the receiver."
-
-	self allParsersDo: aBlock seen: IdentitySet new
-!
-
-allParsersDo: aBlock seen: aSet
-	"Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
-
-	(aSet includes: self)
-		ifTrue: [ ^ self ].
-	aSet add: self.
-	aBlock value: self.
-	self children
-		do: [ :each | each allParsersDo: aBlock seen: aSet ]
-! !
-
-!PPParser methodsFor:'*petitanalyzer-matching'!
 
-copyInContext: aDictionary
-	^ self copyInContext: aDictionary seen: IdentityDictionary new
-!
 
-copyInContext: aDictionary seen: aSeenDictionary
-	| copy |
-	aSeenDictionary 
-		at: self 
-		ifPresent: [ :value | ^ value ].
-	copy := aSeenDictionary
-		at: self
-		put: self copy.
-	copy children do: [ :each |
-		copy
-			replace: each
-			with: (each copyInContext: aDictionary seen: aSeenDictionary) ].
-	^ copy
-!
-
-match: aParser inContext: aDictionary
-	^ self match: aParser inContext: aDictionary seen: IdentitySet new
-!
-
-match: aParser inContext: aDictionary seen: anIdentitySet
-	"This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state."
-
-	(self == aParser or: [ anIdentitySet includes: self ])
-		ifTrue: [ ^ true ].
-	anIdentitySet add: self.
-	^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]
-!
-
-matchList: matchList against: parserList inContext: aDictionary seen: aSet
-	^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet
-!
 
-matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet
-	| parser currentIndex currentDictionary currentSeen parsers |
-	matchList size < matchIndex
-		ifTrue: [ ^ parserList size < parserIndex ].
-	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
-		ifTrue: [ ^ false ].
-	(parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet)
-		ifFalse: [ ^ false ].
-	^ self
-		matchList: matchList
-		index: matchIndex + 1
-		against: parserList
-		index: parserIndex + 1
-		inContext: aDictionary
-		seen: aSet
-! !
-
-!PPParser methodsFor:'*petitanalyzer-named'!
-
-allNamedParsers
-	"Answer all the named parse nodes of the receiver."
 
-	| result |
-	result := OrderedCollection new.
-	self allNamedParsersDo: [ :parser | result addLast: parser ].
-	^ result
-!
 
-allNamedParsersDo: aBlock
-	"Iterate over all the named parse nodes of the receiver."
-
-	self allParsersDo: [ :each | 
-		each name notNil
-			ifTrue: [ aBlock value: each ] ]
-!
-
-innerChildren
-	"Answer the inner children of the receiver."
-
-	| result |
-	result := OrderedCollection new.
-	self innerChildrenDo: [ :parser | result addLast: parser ].
-	^ result
-!
-
-innerChildrenDo: aBlock
-	"Iterate over the inner children of the receiver."
-
-	self innerChildrenDo: aBlock seen: IdentitySet new
-!
-
-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: [
-			aBlock value: each.
-			each innerChildrenDo: aBlock seen: aSet ] ]
-!
-
-namedChildren
-	"Answer the named children of the receiver."
-
-	| result |
-	result := OrderedCollection new.
-	self namedChildrenDo: [ :parser | result addLast: parser ].
-	^ result
-!
 
-namedChildrenDo: aBlock
-	"Iterate over the named children of the receiver."
-
-	self namedChildrenDo: aBlock seen: IdentitySet new
-!
-
-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
-			ifTrue: [ each namedChildrenDo: aBlock seen: aSet ]
-			ifFalse: [ aBlock value: each ] ]
-! !
-
-!PPParser methodsFor:'*petitanalyzer-private'!
-
-cycleSet: aDictionary
-	"PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets."
-
-	^ self children
-!
-
-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 ].
-	aStack removeLast
-!
 
-firstSets: aFirstDictionary into: aSet
-	"PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
-
-	self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]
-!
-
-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-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
-!
-
-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
-!
 
-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 isTerminal
-			ifTrue: [ IdentitySet with: each ]
-			ifFalse: [ IdentitySet new ]).
-		each isNullable
-			ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ].
-	[	| changed tally |
-		changed := false.
-		firstSets keysAndValuesDo: [ :parser :first |
-			tally := first size.
-			parser firstSets: firstSets into: first.
-			changed := changed or: [ tally ~= first size ] ].
-		changed ] whileTrue.
-	^ firstSets
-!
-
-followSet
-	"Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once."
-
-	^ self followSets at: self
-!
 
-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
-			into: [ :result :each | result + each size ].
-		continue := previous < current.
-		previous := current.
-		continue ] whileTrue.
-	^ followSets
-! !
 
-!PPParser methodsFor:'*petitanalyzer-testing'!
-
-isNullable
-	"Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
-	
-	^ false
-!
-
-isTerminal
-	"Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
-
-	^ self children isEmpty
-! !
-
-!PPParser methodsFor:'*petitanalyzer-transforming'!
-
-replace: aParser with: anotherParser
-	"Replace the references of the receiver pointing to aParser with anotherParser."
-!
-
-transform: aBlock
-	"Answer a copy of all parsers reachable from the receiver transformed using aBlock."
-
-	| mapping root |
-	mapping := IdentityDictionary new.
-	self allParsersDo: [ :each |
-		mapping
-			at: each
-			put: (aBlock value: each copy) ].
-	root := mapping at: self.
-	[	| changed |
-		changed := false.
-		root allParsersDo: [ :each |
-			each children do: [ :old |
-				mapping at: old ifPresent: [ :new |
-					each replace: old with: new.
-					changed := true ] ] ].
-		changed ] whileTrue.
-	^ root
-! !
 
 !PPParser methodsFor:'accessing'!
 
@@ -531,9 +225,10 @@
 !
 
 >=> aBlock
-	"Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser."
+        "Answer a new parser that wraps the receiving parser with a two argument block. 
+         The first argument is the parsed stream, the second argument a continuation block on the delegate parser."
 
-	^ PPWrappingParser on: self block: aBlock
+        ^ PPWrappingParser on: self block: aBlock
 !
 
 answer: anObject
@@ -859,17 +554,18 @@
 	^ false
 ! !
 
+
 !PPParser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParser.st,v 1.6 2014-03-04 14:33:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParser.st,v 1.7 2014-03-04 23:58:41 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParser.st,v 1.6 2014-03-04 14:33:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParser.st,v 1.7 2014-03-04 23:58:41 cg Exp $'
 !
 
 version_SVN
-    ^ '$Id: PPParser.st,v 1.6 2014-03-04 14:33:11 cg Exp $'
+    ^ '$Id: PPParser.st,v 1.7 2014-03-04 23:58:41 cg Exp $'
 ! !