compiler/PPCNode.st
changeset 438 20598d7ce9fa
parent 422 116d2b2af905
child 452 9f4558b3be66
--- 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
+! !
+