--- a/compiler/PPCNode.st Wed Nov 19 10:52:37 2014 +0000
+++ b/compiler/PPCNode.st Mon Nov 24 00:09:23 2014 +0000
@@ -1,7 +1,7 @@
"{ Package: 'stx:goodies/petitparser/compiler' }"
Object subclass:#PPCNode
- instanceVariableNames:'contextFree name firstSet firstCharSet'
+ instanceVariableNames:'contextFree name firstFollowCache firstCharSet properties'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Nodes'
@@ -32,6 +32,26 @@
^ ''
! !
+!PPCNode methodsFor:'accessing-properties'!
+
+hasProperty: aKey
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]
+!
+
+properties: aDictionary
+ properties := aDictionary
+!
+
+propertyAt: aKey ifAbsent: aBlock
+ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ ^ properties isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ properties at: aKey ifAbsent: aBlock ]
+! !
+
!PPCNode methodsFor:'analysis'!
acceptsEpsilon
@@ -125,13 +145,6 @@
!PPCNode methodsFor:'as yet unclassified'!
-firstSet
- firstSet ifNil: [
- firstSet := self firstSetSuchThat: [ :e | e isFirstSetTerminal ].
- ].
- ^ firstSet
-!
-
name
^ name
! !
@@ -144,6 +157,13 @@
(anotherNode name = name) ifFalse: [ ^ false ].
^ anotherNode children = self children.
+!
+
+hash
+ "TODO JK: IMO not a good hashing function bacause of children size,
+ but at least it is not recursive, which would be worse :)
+ "
+ ^ self class hash bitXor: (name hash bitXor: self children size hash)
! !
!PPCNode methodsFor:'compiling'!
@@ -154,15 +174,162 @@
!
compileWith: compiler effect: effect
- | id |
+ | id method |
id := (compiler idFor: self prefixed: (self prefix) suffixed: (self suffix) effect: effect).
- (compiler checkCache: id) ifNotNil: [ ^ compiler ].
+ (method := compiler checkCache: id) ifNotNil: [ ^ method ].
^ self compileWith: compiler effect: effect id: id.
!
compileWith: compiler effect: effect id: id
self subclassResponsibility
+!
+
+initialize
+ super initialize.
+ firstFollowCache := IdentityDictionary new.
+! !
+
+!PPCNode methodsFor:'first follow next'!
+
+firstSet
+ ^ firstFollowCache at: #firstSet ifAbsentPut: [
+ self firstSets at: self
+ ]
+!
+
+firstSet: set
+ firstFollowCache at: #firstSet put: set
+!
+
+firstSets
+ ^ self firstSetsSuchThat: [ :e | e isFirstSetTerminal ]
+!
+
+firstSets: aFirstDictionary into: aSet suchThat: aBlock
+ "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
+
+ (aBlock value: self) ifFalse: [
+ self children do: [ :node | aSet addAll: (aFirstDictionary at: node) ]
+ ]
+!
+
+firstSetsSuchThat: block
+
+ | firstSets |
+ firstSets := IdentityDictionary new.
+ self allParsersDo: [ :each |
+ firstSets at: each put: ((block value: each)
+ ifTrue: [ IdentitySet with: each ]
+ ifFalse: [ IdentitySet new ]).
+ each isNullable
+ ifTrue: [ (firstSets at: each) add: PPCSentinelNode instance ] ].
+
+
+ [ | changed tally |
+ changed := false.
+ firstSets keysAndValuesDo: [ :node :first |
+ tally := first size.
+ node firstSets: firstSets into: first suchThat: block.
+ changed := changed or: [ tally ~= first size ] ].
+ changed ] whileTrue.
+ ^ firstSets
+!
+
+followSet
+ ^ firstFollowCache at: #followSet ifAbsent: [ self error: 'no follow set cached' ]
+!
+
+followSet: aSet
+ ^ firstFollowCache at: #followSet put: aSet
+!
+
+followSetIn: rootNode
+ ^ rootNode followSets at: self
+!
+
+followSetWithTokens
+ ^ firstFollowCache at: #followSetWithTokens ifAbsent: [ self error: 'no follow with tokens cached' ]
+!
+
+followSetWithTokens: aSet
+ ^ firstFollowCache at: #followSetWithTokens put: aSet
+!
+
+followSets
+ ^ self followSetsSuchThat: [ :e | e isFirstSetTerminal ]
+!
+
+followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet suchThat: aBlock
+ "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: [ :node | (aFollowDictionary at: node) addAll: aSet ]
+!
+
+followSetsSuchThat: aBlock
+ "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 firstSetsSuchThat: aBlock.
+ followSets := IdentityDictionary new.
+ self allNodesDo: [ :each | followSets at: each put: IdentitySet new ].
+ (followSets at: self) add: PPCSentinelNode instance.
+ [ followSets keysAndValuesDo: [ :node :follow |
+ node
+ followSets: followSets
+ firstSets: firstSets
+ into: follow
+ suchThat: aBlock ].
+ current := followSets
+ inject: 0
+ into: [ :result :each | result + each size ].
+ continue := previous < current.
+ previous := current.
+ continue ] whileTrue.
+ ^ followSets
+!
+
+nextSetIn: rootNode
+ ^ rootNode nextSets at: self
+!
+
+nextSets
+ | nextSets |
+
+ nextSets := IdentityDictionary new.
+ self allNodesDo: [ :each | nextSets at: each put: IdentitySet new ].
+
+ (nextSets at: self) add: PPCSentinelNode instance.
+
+ [ | changed |
+ changed := false.
+
+ nextSets keysAndValuesDo: [:node :next |
+ changed := (node
+ nextSets: nextSets
+ into: next) or: [ changed ].
+ ].
+ changed ] whileTrue.
+
+ ^ nextSets
+!
+
+nextSets: aNextDictionary into: aSet
+ "return true/false, if something has changed or not...."
+ | childSet change tally |
+
+ change := false.
+
+ self children do: [:each |
+ childSet := aNextDictionary at: each.
+ tally := childSet size.
+ childSet addAll: aSet.
+ change := change or: [ tally ~= childSet size ].
+ ].
+
+ ^ change
+
! !
!PPCNode methodsFor:'gt'!
@@ -239,7 +406,13 @@
!
optimize: params status: changeStatus
- " nothing to do "
+ | retval |
+ retval := self.
+
+ retval := retval rewrite: params status: changeStatus.
+ retval := retval inline: params status: changeStatus.
+
+ ^ retval
!
optimizeTree