--- a/compiler/PPCNode.st Tue Apr 21 17:20:11 2015 +0100
+++ b/compiler/PPCNode.st Thu Apr 30 23:43:14 2015 +0200
@@ -21,17 +21,36 @@
^ #()
!
+markForInline
+ "Marks receiver for inlining, i.e., it's parsing code
+ should be inlined into parent's code"
+ self propertyAt: #inlined put: true
+
+ "Created: / 23-04-2015 / 15:39:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+ ^ name
+!
+
name: anObject
name := anObject
!
prefix
- self subclassResponsibility
+ ^ 'anode'
!
suffix
^ ''
+!
+
+unmarkForInline
+ "Forbids inlining of receiver's parsing code"
+ self propertyAt: #inlined put: false
+
+ "Created: / 23-04-2015 / 15:39:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCNode methodsFor:'accessing-properties'!
@@ -42,16 +61,31 @@
^ properties notNil and: [ properties includesKey: aKey ]
!
+properties
+ ^ properties
+!
+
properties: aDictionary
properties := aDictionary
!
+propertyAt: aKey
+ ^ self propertyAt: [ aKey ] ifAbsent: [ nil ]
+!
+
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 ]
+!
+
+propertyAt: aKey put: anObject
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject
! !
!PPCNode methodsFor:'analysis'!
@@ -145,13 +179,7 @@
^ self children isEmpty
! !
-!PPCNode methodsFor:'as yet unclassified'!
-
-name
- ^ name
-! !
-
-!PPCNode methodsFor:'comparison'!
+!PPCNode methodsFor:'comparing'!
= anotherNode
(self == anotherNode) ifTrue: [ ^ true ].
@@ -168,30 +196,6 @@
^ self class hash bitXor: (name hash bitXor: self children size hash)
! !
-!PPCNode methodsFor:'compiling'!
-
-compileWith: compiler
- | |
- ^ self compileWith: compiler effect: #none
-!
-
-compileWith: compiler effect: effect
- | id method |
- id := (compiler idFor: self prefixed: (self prefix) suffixed: (self suffix) effect: effect).
- (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
@@ -342,114 +346,57 @@
composite tree
title: 'Tree';
children: [:n | n children ];
- format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
+ format: [:n| String streamContents: [:s | n printOn: s. n printHashOn: s] ];
shouldExpandToLevel: 6
! !
+!PPCNode methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ firstFollowCache := IdentityDictionary new.
+! !
+
!PPCNode methodsFor:'optimizing'!
-asFast
- ^ self
-!
-
-asInlined
- ^ self
-!
-
checkTree
| message |
self allNodes do: [ :node | (message := node check) ifNotNil: [ self error: message ] ].
!
-defaultOptimizationParameters
- | parameters |
- parameters := IdentityDictionary new.
- parameters at: #inline put: true.
- parameters at: #rewrite put: true.
-
- ^ parameters
-!
-
-doOptimizationLoop: params status: changeStatus
- | mapping optimized root |
- mapping := IdentityDictionary new.
- self allNodes do: [ :node |
- optimized := (node optimize: params status: changeStatus).
- (optimized ~= node) ifTrue: [
- mapping at: node put: optimized.
- ].
- ].
-
- root := mapping at: self ifAbsent: [ self ].
- [ | changed |
- changed := false.
- root allNodes do: [ :node |
- node children do: [ :child |
- mapping at: child ifPresent: [:newChild |
- node replace: child with: newChild.
- changed := true ]
- ]].
- changed
- ] whileTrue.
- ^ root
-!
-
-inline: changeStatus
- "nothing to do"
-!
-
-inline: params status: changeStatus
- (params at: #inline) ifTrue: [
- ^ self inline: changeStatus
- ]
-!
-
-optimize: params status: changeStatus
- | retval |
- retval := self.
-
- retval := retval rewrite: params status: changeStatus.
- retval := retval inline: params status: changeStatus.
-
- ^ retval
-!
-
optimizeTree
- ^ self optimizeTree: #()
+ ^ self optimizeTree: #(#token #inline #rewrite #merge)
!
optimizeTree: params
- | node newNode parameters status |
-
- parameters := self defaultOptimizationParameters.
-
- params do: [ :p | parameters at: p key put: p value ].
+ | retval |
+
+ "Default optimization sequence"
+ retval := self.
- node := self.
- [
- status := PPCOptimizationResult new.
- newNode := node doOptimizationLoop: parameters status: status.
- status isChange.
- ] whileTrue: [ node := newNode ].
- ^ node
-!
-
-rewrite: changeStatus
- "nothing to do"
-!
-
-rewrite: params status: changeStatus
- (params at: #rewrite) ifTrue: [
- ^ self rewrite: changeStatus.
- ].
+ (params includes: #rewrite) ifTrue: [ retval := PPCOptimizingVisitor new visit: retval ].
+ (params includes: #token) ifTrue: [ retval := PPCTokenDetector new visit: retval ].
+ (params includes: #rewrite) ifTrue: [ retval := PPCOptimizingVisitor new visit: retval ].
+ (params includes: #inline) ifTrue: [ retval := PPCInliningVisitor new visit: retval ].
+ (params includes: #merge) ifTrue: [ retval := PPCMergingVisitor new visit: retval ].
+ ^ retval
! !
!PPCNode methodsFor:'printing'!
+printHashOn: aStream
+ aStream print: 'Hash:', self hash asString
+!
+
+printIdOn: aStream
+ aStream print: 'ID:', self identityHash asString
+!
+
printNameOn: aStream
self name isNil
- ifTrue: [ aStream print: self hash ]
- ifFalse: [ aStream nextPutAll: self name. aStream nextPut: $-. aStream print: self hash. ]
+ ifFalse: [ aStream nextPutAll: self name. aStream nextPut: $-. ].
+
+ aStream print: self identityHash
!
printOn: aStream
@@ -459,6 +406,14 @@
aStream nextPut: $)
! !
+!PPCNode methodsFor:'testing'!
+
+isMarkedForInline
+ ^ self propertyAt: #inlined ifAbsent: [ false ].
+
+ "Created: / 23-04-2015 / 15:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!PPCNode methodsFor:'todel'!
allParsersDo: aBlock
@@ -489,8 +444,8 @@
transform: aBlock
"Answer a copy of all parsers reachable from the receiver transformed using aBlock."
-
| mapping root |
+ self halt: 'doprecate?'.
mapping := IdentityDictionary new.
self allParsersDo: [ :each |
mapping
@@ -508,3 +463,9 @@
^ root
! !
+!PPCNode methodsFor:'visiting'!
+
+accept: visitor
+ visitor visitNode: self
+! !
+