analyzer/extensions.st
changeset 262 185ab6ab79b3
parent 261 bb28e80dbcc8
child 276 61e163430728
equal deleted inserted replaced
261:bb28e80dbcc8 262:185ab6ab79b3
       
     1 "{ Package: 'stx:goodies/petitparser/analyzer' }"!
       
     2 
       
     3 !PPActionParser methodsFor:'*petitanalyzer-matching'!
       
     4 
       
     5 match: aParser inContext: aDictionary seen: anIdentitySet
       
     6 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]
       
     7 ! !
       
     8 
       
     9 !PPDelegateParser methodsFor:'*petitanalyzer-transforming'!
       
    10 
       
    11 replace: aParser with: anotherParser
       
    12 	super replace: aParser with: anotherParser.
       
    13 	parser == aParser ifTrue: [ parser := anotherParser ]
       
    14 ! !
       
    15 
       
    16 !PPEpsilonParser methodsFor:'*petitanalyzer-testing'!
       
    17 
       
    18 isNullable
       
    19 	^ true
       
    20 ! !
       
    21 
       
    22 !PPFailingParser methodsFor:'*petitanalyzer-matching'!
       
    23 
       
    24 match: aParser inContext: aDictionary seen: anIdentitySet
       
    25 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]
       
    26 ! !
       
    27 
       
    28 !PPLimitedRepeatingParser methodsFor:'*petitanalyzer-transforming'!
       
    29 
       
    30 replace:aParser with:anotherParser
       
    31     super replace:aParser with:anotherParser.
       
    32     limit == aParser ifTrue:[limit := anotherParser].
       
    33 ! !
       
    34 
       
    35 !PPListParser methodsFor:'*petitanalyzer-matching'!
       
    36 
       
    37 copyInContext: aDictionary seen: aSeenDictionary
       
    38 	| copy copies |
       
    39 	aSeenDictionary at: self ifPresent: [ :value | ^ value ].
       
    40 	copy := aSeenDictionary at: self put: self copy.
       
    41 	copies := OrderedCollection new.
       
    42 	parsers do: [ :each |
       
    43 		| result |
       
    44 		result := each 
       
    45 			copyInContext: aDictionary
       
    46 			seen: aSeenDictionary.
       
    47 		result isCollection
       
    48 			ifTrue: [ copies addAll: result ]
       
    49 			ifFalse: [ copies add: result ] ].
       
    50 	^ copy
       
    51 		setParsers: copies;
       
    52 		yourself
       
    53 ! !
       
    54 
       
    55 !PPListParser methodsFor:'*petitanalyzer-transforming'!
       
    56 
       
    57 replace: aParser with: anotherParser
       
    58 	super replace: aParser with: anotherParser.
       
    59 	parsers keysAndValuesDo: [ :index :parser |
       
    60 		parser == aParser
       
    61 			ifTrue: [ parsers at: index put: anotherParser ] ]
       
    62 ! !
       
    63 
       
    64 !PPLiteralParser methodsFor:'*petitanalyzer-matching'!
       
    65 
       
    66 match: aParser inContext: aDictionary seen: anIdentitySet
       
    67 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]
       
    68 ! !
       
    69 
       
    70 !PPOptionalParser methodsFor:'*petitanalyzer-testing'!
       
    71 
       
    72 isNullable
       
    73 	^ true
       
    74 ! !
       
    75 
       
    76 !PPParser methodsFor:'*petitanalyzer-named'!
       
    77 
       
    78 allNamedParsers
       
    79 	"Answer all the named parse nodes of the receiver."
       
    80 
       
    81 	| result |
       
    82 	result := OrderedCollection new.
       
    83 	self allNamedParsersDo: [ :parser | result addLast: parser ].
       
    84 	^ result
       
    85 ! !
       
    86 
       
    87 !PPParser methodsFor:'*petitanalyzer-named'!
       
    88 
       
    89 allNamedParsersDo: aBlock
       
    90 	"Iterate over all the named parse nodes of the receiver."
       
    91 
       
    92 	self allParsersDo: [ :each | 
       
    93 		each name notNil
       
    94 			ifTrue: [ aBlock value: each ] ]
       
    95 ! !
       
    96 
       
    97 !PPParser methodsFor:'*petitanalyzer-enumerating'!
       
    98 
       
    99 allParsers
       
   100 	"Answer all the parse nodes of the receiver."
       
   101 
       
   102 	| result |
       
   103 	result := OrderedCollection new.
       
   104 	self allParsersDo: [ :parser | result addLast: parser ].
       
   105 	^ result
       
   106 ! !
       
   107 
       
   108 !PPParser methodsFor:'*petitanalyzer-enumerating'!
       
   109 
       
   110 allParsersDo: aBlock
       
   111 	"Iterate over all the parse nodes of the receiver."
       
   112 
       
   113 	self allParsersDo: aBlock seen: IdentitySet new
       
   114 ! !
       
   115 
       
   116 !PPParser methodsFor:'*petitanalyzer-enumerating'!
       
   117 
       
   118 allParsersDo: aBlock seen: aSet
       
   119 	"Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
       
   120 
       
   121 	(aSet includes: self)
       
   122 		ifTrue: [ ^ self ].
       
   123 	aSet add: self.
       
   124 	aBlock value: self.
       
   125 	self children
       
   126 		do: [ :each | each allParsersDo: aBlock seen: aSet ]
       
   127 ! !
       
   128 
       
   129 !PPParser methodsFor:'*petitanalyzer-matching'!
       
   130 
       
   131 copyInContext: aDictionary
       
   132 	^ self copyInContext: aDictionary seen: IdentityDictionary new
       
   133 ! !
       
   134 
       
   135 !PPParser methodsFor:'*petitanalyzer-matching'!
       
   136 
       
   137 copyInContext: aDictionary seen: aSeenDictionary
       
   138 	| copy |
       
   139 	aSeenDictionary 
       
   140 		at: self 
       
   141 		ifPresent: [ :value | ^ value ].
       
   142 	copy := aSeenDictionary
       
   143 		at: self
       
   144 		put: self copy.
       
   145 	copy children do: [ :each |
       
   146 		copy
       
   147 			replace: each
       
   148 			with: (each copyInContext: aDictionary seen: aSeenDictionary) ].
       
   149 	^ copy
       
   150 ! !
       
   151 
       
   152 !PPParser methodsFor:'*petitanalyzer-querying'!
       
   153 
       
   154 cycleSet
       
   155 	"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."
       
   156 	
       
   157 	| cycles |
       
   158 	cycles := IdentitySet new.
       
   159 	self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles.
       
   160 	^ cycles
       
   161 ! !
       
   162 
       
   163 !PPParser methodsFor:'*petitanalyzer-private'!
       
   164 
       
   165 cycleSet: aDictionary
       
   166 	"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."
       
   167 
       
   168 	^ self children
       
   169 ! !
       
   170 
       
   171 !PPParser methodsFor:'*petitanalyzer-private'!
       
   172 
       
   173 cycleSet: aStack firstSets: aDictionary into: aSet
       
   174 	"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."
       
   175 
       
   176 	| index |
       
   177 	self isTerminal
       
   178 		ifTrue: [ ^ self ].	
       
   179 	(index := aStack indexOf: self) > 0
       
   180 		ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ].
       
   181 	aStack addLast: self.
       
   182 	(self cycleSet: aDictionary)
       
   183 		do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ].
       
   184 	aStack removeLast
       
   185 ! !
       
   186 
       
   187 !PPParser methodsFor:'*petitanalyzer-querying'!
       
   188 
       
   189 firstSet
       
   190 	"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."
       
   191 	
       
   192 	^ self firstSets at: self
       
   193 ! !
       
   194 
       
   195 !PPParser methodsFor:'*petitanalyzer-querying'!
       
   196 
       
   197 firstSets
       
   198 	"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."
       
   199 	
       
   200 	| firstSets |
       
   201 	firstSets := IdentityDictionary new.
       
   202 	self allParsersDo: [ :each |
       
   203 		firstSets at: each put: (each isTerminal
       
   204 			ifTrue: [ IdentitySet with: each ]
       
   205 			ifFalse: [ IdentitySet new ]).
       
   206 		each isNullable
       
   207 			ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ].
       
   208 	[	| changed tally |
       
   209 		changed := false.
       
   210 		firstSets keysAndValuesDo: [ :parser :first |
       
   211 			tally := first size.
       
   212 			parser firstSets: firstSets into: first.
       
   213 			changed := changed or: [ tally ~= first size ] ].
       
   214 		changed ] whileTrue.
       
   215 	^ firstSets
       
   216 ! !
       
   217 
       
   218 !PPParser methodsFor:'*petitanalyzer-private'!
       
   219 
       
   220 firstSets: aFirstDictionary into: aSet
       
   221 	"PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
       
   222 
       
   223 	self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]
       
   224 ! !
       
   225 
       
   226 !PPParser methodsFor:'*petitanalyzer-querying'!
       
   227 
       
   228 followSet
       
   229 	"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."
       
   230 
       
   231 	^ self followSets at: self
       
   232 ! !
       
   233 
       
   234 !PPParser methodsFor:'*petitanalyzer-querying'!
       
   235 
       
   236 followSets
       
   237 	"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."
       
   238 	
       
   239 	| current previous continue firstSets followSets |
       
   240 	current := previous := 0.
       
   241 	firstSets := self firstSets.
       
   242 	followSets := IdentityDictionary new.
       
   243 	self allParsersDo: [ :each | followSets at: each put: IdentitySet new ].
       
   244 	(followSets at: self) add: PPSentinel instance.
       
   245 	[	followSets keysAndValuesDo: [ :parser :follow |
       
   246 			parser 
       
   247 				followSets: followSets
       
   248 				firstSets: firstSets
       
   249 				into: follow ].
       
   250 		current := followSets
       
   251 			inject: 0
       
   252 			into: [ :result :each | result + each size ].
       
   253 		continue := previous < current.
       
   254 		previous := current.
       
   255 		continue ] whileTrue.
       
   256 	^ followSets
       
   257 ! !
       
   258 
       
   259 !PPParser methodsFor:'*petitanalyzer-private'!
       
   260 
       
   261 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
       
   262 	"PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
       
   263 	
       
   264 	self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]
       
   265 ! !
       
   266 
       
   267 !PPParser methodsFor:'*petitanalyzer-named'!
       
   268 
       
   269 innerChildren
       
   270 	"Answer the inner children of the receiver."
       
   271 
       
   272 	| result |
       
   273 	result := OrderedCollection new.
       
   274 	self innerChildrenDo: [ :parser | result addLast: parser ].
       
   275 	^ result
       
   276 ! !
       
   277 
       
   278 !PPParser methodsFor:'*petitanalyzer-named'!
       
   279 
       
   280 innerChildrenDo: aBlock
       
   281 	"Iterate over the inner children of the receiver."
       
   282 
       
   283 	self innerChildrenDo: aBlock seen: IdentitySet new
       
   284 ! !
       
   285 
       
   286 !PPParser methodsFor:'*petitanalyzer-named'!
       
   287 
       
   288 innerChildrenDo: aBlock seen: aSet
       
   289 	"Iterate over the inner children of the receiver."
       
   290 	
       
   291 	self children do: [ :each |
       
   292 		(aSet includes: each)
       
   293 			ifTrue: [ ^ self ].
       
   294 		aSet add: each.
       
   295 		each name isNil ifTrue: [
       
   296 			aBlock value: each.
       
   297 			each innerChildrenDo: aBlock seen: aSet ] ]
       
   298 ! !
       
   299 
       
   300 !PPParser methodsFor:'*petitanalyzer-testing'!
       
   301 
       
   302 isNullable
       
   303 	"Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
       
   304 	
       
   305 	^ false
       
   306 ! !
       
   307 
       
   308 !PPParser methodsFor:'*petitanalyzer-testing'!
       
   309 
       
   310 isTerminal
       
   311 	"Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
       
   312 
       
   313 	^ self children isEmpty
       
   314 ! !
       
   315 
       
   316 !PPParser methodsFor:'*petitanalyzer-matching'!
       
   317 
       
   318 match: aParser inContext: aDictionary
       
   319 	^ self match: aParser inContext: aDictionary seen: IdentitySet new
       
   320 ! !
       
   321 
       
   322 !PPParser methodsFor:'*petitanalyzer-matching'!
       
   323 
       
   324 match: aParser inContext: aDictionary seen: anIdentitySet
       
   325 	"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."
       
   326 
       
   327 	(self == aParser or: [ anIdentitySet includes: self ])
       
   328 		ifTrue: [ ^ true ].
       
   329 	anIdentitySet add: self.
       
   330 	^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]
       
   331 ! !
       
   332 
       
   333 !PPParser methodsFor:'*petitanalyzer-matching'!
       
   334 
       
   335 matchList: matchList against: parserList inContext: aDictionary seen: aSet
       
   336 	^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet
       
   337 ! !
       
   338 
       
   339 !PPParser methodsFor:'*petitanalyzer-matching'!
       
   340 
       
   341 matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet
       
   342 	| parser currentIndex currentDictionary currentSeen parsers |
       
   343 	matchList size < matchIndex
       
   344 		ifTrue: [ ^ parserList size < parserIndex ].
       
   345 	parser := matchList at: matchIndex.
       
   346 	parser class = PPListPattern ifTrue: [
       
   347 		currentIndex := parserIndex - 1.
       
   348 		[ currentDictionary := aDictionary copy.
       
   349 		currentSeen := aSet copy.
       
   350 		parserList size < currentIndex or: [ 
       
   351 			parsers := parserList copyFrom: parserIndex to: currentIndex.
       
   352 			(currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [ 
       
   353 				(self
       
   354 					matchList: matchList
       
   355 					index: matchIndex + 1
       
   356 					against: parserList
       
   357 					index: currentIndex + 1
       
   358 					inContext: currentDictionary
       
   359 					seen: currentSeen)
       
   360 					ifTrue: [ 
       
   361 						currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ].
       
   362 						^ true ].
       
   363 				false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ].
       
   364 		^ false ].
       
   365 	parserList size < parserIndex
       
   366 		ifTrue: [ ^ false ].
       
   367 	(parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet)
       
   368 		ifFalse: [ ^ false ].
       
   369 	^ self
       
   370 		matchList: matchList
       
   371 		index: matchIndex + 1
       
   372 		against: parserList
       
   373 		index: parserIndex + 1
       
   374 		inContext: aDictionary
       
   375 		seen: aSet
       
   376 ! !
       
   377 
       
   378 !PPParser methodsFor:'*petitanalyzer-named'!
       
   379 
       
   380 namedChildren
       
   381 	"Answer the named children of the receiver."
       
   382 
       
   383 	| result |
       
   384 	result := OrderedCollection new.
       
   385 	self namedChildrenDo: [ :parser | result addLast: parser ].
       
   386 	^ result
       
   387 ! !
       
   388 
       
   389 !PPParser methodsFor:'*petitanalyzer-named'!
       
   390 
       
   391 namedChildrenDo: aBlock
       
   392 	"Iterate over the named children of the receiver."
       
   393 
       
   394 	self namedChildrenDo: aBlock seen: IdentitySet new
       
   395 ! !
       
   396 
       
   397 !PPParser methodsFor:'*petitanalyzer-named'!
       
   398 
       
   399 namedChildrenDo: aBlock seen: aSet
       
   400 	"Iterate over the named children of the receiver."
       
   401 	
       
   402 	self children do: [ :each |
       
   403 		(aSet includes: each)
       
   404 			ifTrue: [ ^ self ].
       
   405 		aSet add: each.
       
   406 		each name isNil
       
   407 			ifTrue: [ each namedChildrenDo: aBlock seen: aSet ]
       
   408 			ifFalse: [ aBlock value: each ] ]
       
   409 ! !
       
   410 
       
   411 !PPParser methodsFor:'*petitanalyzer-transforming'!
       
   412 
       
   413 replace: aParser with: anotherParser
       
   414 	"Replace the references of the receiver pointing to aParser with anotherParser."
       
   415 ! !
       
   416 
       
   417 !PPParser methodsFor:'*petitanalyzer-transforming'!
       
   418 
       
   419 transform: aBlock
       
   420 	"Answer a copy of all parsers reachable from the receiver transformed using aBlock."
       
   421 
       
   422 	| mapping root |
       
   423 	mapping := IdentityDictionary new.
       
   424 	self allParsersDo: [ :each |
       
   425 		mapping
       
   426 			at: each
       
   427 			put: (aBlock value: each copy) ].
       
   428 	root := mapping at: self.
       
   429 	[	| changed |
       
   430 		changed := false.
       
   431 		root allParsersDo: [ :each |
       
   432 			each children do: [ :old |
       
   433 				mapping at: old ifPresent: [ :new |
       
   434 					each replace: old with: new.
       
   435 					changed := true ] ] ].
       
   436 		changed ] whileTrue.
       
   437 	^ root
       
   438 ! !
       
   439 
       
   440 !PPPluggableParser methodsFor:'*petitanalyzer-matching'!
       
   441 
       
   442 match: aParser inContext: aDictionary seen: anIdentitySet
       
   443 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]
       
   444 ! !
       
   445 
       
   446 !PPPredicateParser methodsFor:'*petitanalyzer-matching'!
       
   447 
       
   448 match: aParser inContext: aDictionary seen: anIdentitySet
       
   449 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]
       
   450 ! !
       
   451 
       
   452 !PPPredicateSequenceParser methodsFor:'*petitanalyzer-matching'!
       
   453 
       
   454 match: aParser inContext: aDictionary seen: anIdentitySet
       
   455 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]
       
   456 ! !
       
   457 
       
   458 !PPRepeatingParser methodsFor:'*petitanalyzer-testing'!
       
   459 
       
   460 isNullable
       
   461 	^ min = 0
       
   462 ! !
       
   463 
       
   464 !PPRepeatingParser methodsFor:'*petitanalyzer-matching'!
       
   465 
       
   466 match: aParser inContext: aDictionary seen: anIdentitySet
       
   467 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]
       
   468 ! !
       
   469 
       
   470 !PPSequenceParser methodsFor:'*petitanalyzer-private'!
       
   471 
       
   472 cycleSet: aDictionary
       
   473 	| firstSet |
       
   474 	1 to: parsers size do: [ :index |
       
   475 		firstSet := aDictionary at: (parsers at: index).
       
   476 		(firstSet anySatisfy: [ :each | each isNullable ])
       
   477 			ifFalse: [ ^ parsers copyFrom: 1 to: index ] ].
       
   478 	^ parsers
       
   479 ! !
       
   480 
       
   481 !PPSequenceParser methodsFor:'*petitanalyzer-private'!
       
   482 
       
   483 firstSets: aFirstDictionary into: aSet
       
   484 	| nullable |
       
   485 	parsers do: [ :parser |
       
   486 		nullable := false.
       
   487 		(aFirstDictionary at: parser) do: [ :each |
       
   488 			each isNullable
       
   489 				ifTrue: [ nullable := true ]
       
   490 				ifFalse: [ aSet add: each ] ].
       
   491 		nullable
       
   492 			ifFalse: [ ^ self ] ].
       
   493 	aSet add: PPSentinel instance
       
   494 ! !
       
   495 
       
   496 !PPSequenceParser methodsFor:'*petitanalyzer-private'!
       
   497 
       
   498 followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
       
   499 	parsers keysAndValuesDo: [ :index :parser |
       
   500 		| followSet firstSet |
       
   501 		followSet := aFollowDictionary at: parser.
       
   502 		index = parsers size
       
   503 			ifTrue: [ followSet addAll: aSet ]
       
   504 			ifFalse: [
       
   505 				(self class withAll: (parsers 
       
   506 					copyFrom: index + 1 to: parsers size))
       
   507 						firstSets: aFirstDictionary
       
   508 						into: (firstSet := IdentitySet new).
       
   509 				(firstSet anySatisfy: [ :each | each isNullable ])
       
   510 					ifTrue: [ followSet addAll: aSet ].
       
   511 				followSet addAll: (firstSet 
       
   512 					reject: [ :each | each isNullable ]) ] ]
       
   513 ! !
       
   514 
       
   515 !PPTokenParser methodsFor:'*petitanalyzer-matching'!
       
   516 
       
   517 match: aParser inContext: aDictionary seen: anIdentitySet
       
   518 	^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]
       
   519 ! !
       
   520 
       
   521 !stx_goodies_petitparser_analyzer class methodsFor:'documentation'!
       
   522 
       
   523 extensionsVersion_CVS
       
   524     ^ '$Header: /cvs/stx/stx/goodies/petitparser/analyzer/extensions.st,v 1.2 2014-03-04 20:25:41 cg Exp $'
       
   525 ! !