compiler/PPCOptimizingVisitor.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 30 Apr 2015 23:43:14 +0200
changeset 438 20598d7ce9fa
permissions -rw-r--r--
Updated to PetitCompiler-JanKurs.100, PetitCompiler-Tests-JanKurs.44 and PetitCompiler-Benchmarks-JanKurs.4 Name: PetitCompiler-JanKurs.100 Author: JanKurs Time: 30-04-2015, 10:48:52.165 AM UUID: 80196870-5921-46d9-ac20-a43bf5c2f3c2 Name: PetitCompiler-Tests-JanKurs.44 Author: JanKurs Time: 30-04-2015, 10:49:22.489 AM UUID: 348c02e8-18ce-48f6-885d-fcff4516a298 Name: PetitCompiler-Benchmarks-JanKurs.4 Author: JanKurs Time: 30-04-2015, 10:58:44.890 AM UUID: 18cadb42-f9ef-45fb-82e9-8469ade56c8b

"{ Package: 'stx:goodies/petitparser/compiler' }"

"{ NameSpace: Smalltalk }"

PPCRewritingVisitor subclass:#PPCOptimizingVisitor
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Visitors'
!

!PPCOptimizingVisitor methodsFor:'visiting'!

visitActionNode: node
"	^ super visitActionNode: node."
	self visitChildren: node.

	((node hasProperty: #trimmingToken) not and: [ node block isSymbol ]) ifTrue: [ 
		self change.
		^ PPCSymbolActionNode new
			block: node block;
			name: node name;
			child: node child;
			yourself
	].

	^ node
!

visitForwardNode: node

	self visitChildren: node.

	node child name ifNil: [  
		self change.
		node child name: node name.
		^ node child
	].

	(node child name = node name) ifTrue: [ 
		self change.
		^ node child
	].

	^ node
!

visitNotNode: node
	self visitChildren: node.

	(node child isKindOf: PPCAbstractLiteralNode) ifTrue: [  
		self change.
		^ PPCNotLiteralNode new
			name: node name;
			literal: node child literal;
			yourself
	]. 

	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [  
		self change.
		^ PPCNotMessagePredicateNode new
			name: node name;
			message: node child message;
			yourself
	].

	(node child isKindOf: PPCCharSetPredicateNode) ifTrue: [  
		self change.
		^ PPCNotCharSetPredicateNode new
			name: node name;
			predicate: node child predicate;
			yourself
	].

	^ node

    "Modified: / 23-04-2015 / 12:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitPredicateNode: node
	| charSet |
	
	(node predicate class == PPCharSetPredicate) ifTrue: [ 
		charSet := node predicate.
	].
	charSet := PPCharSetPredicate on: node predicate.


	(charSet equals: (PPCharSetPredicate on: [ :char | char isLetter])) ifTrue: [ 
		change := true.
		^ PPCMessagePredicateNode new
			name: node name;
			message: #isLetter;
			predicate: node predicate;
			yourself
	].


	(charSet equals: (PPCharSetPredicate on: [ :char | char isDigit])) ifTrue: [ 
		change := true.
		^ PPCMessagePredicateNode new
			name: node name;
			message: #isDigit;
			predicate: node predicate;
			yourself
	].

	(charSet equals: (PPCharSetPredicate on: [ :char | char isAlphaNumeric])) ifTrue: [ 
		change := true.
		^ PPCMessagePredicateNode new
			name: node name;
			message: #isAlphaNumeric;
			predicate: node predicate;
			yourself
	].

	(charSet equals: (PPCharSetPredicate on: [ :char | char isSeparator])) ifTrue: [ 
		change := true.
		^ PPCMessagePredicateNode new
			name: node name;
			message: #isSeparator;
			predicate: node predicate;
			yourself
	].

	(charSet equals: (PPCharSetPredicate on: [ :char | true ])) ifTrue: [ 
		change := true.
		^ PPCAnyNode new
			name: node name;
			yourself
	].


	change := true.
	^ PPCCharSetPredicateNode new
		name: node name;
		predicate: charSet;
		yourself.
!

visitStarNode: node

	self visitChildren: node.

	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [ 
		self change.
		^ PPCStarMessagePredicateNode new
			name: node name;
			child: node child;
			message: node child message;
			yourself
	].

	(node child isKindOf: PPCAnyNode) ifTrue: [ 
		self change.
		^ PPCStarAnyNode new
			name: node name;
			child: node child;
			yourself
	]. 

	(node child isKindOf: PPCCharSetPredicateNode) ifTrue: [ 
		self change.
		^ PPCStarCharSetPredicateNode new
			name: node name;
			predicate: node child predicate;
			child: node child;
			yourself
	].

	^ node
!

visitTokenStarMessagePredicateNode: node

	self visitChildren: node.

	(node message = #isSeparator) ifTrue: [ 
		self change.
		^ PPCTokenStarSeparatorNode new
			name: node name;
			child: node child;
			message: node message;
			yourself.
	].

	^ node
! !