compiler/PPCOptimizingVisitor.st
changeset 438 20598d7ce9fa
equal deleted inserted replaced
437:54b3bc9e3987 438:20598d7ce9fa
       
     1 "{ Package: 'stx:goodies/petitparser/compiler' }"
       
     2 
       
     3 "{ NameSpace: Smalltalk }"
       
     4 
       
     5 PPCRewritingVisitor subclass:#PPCOptimizingVisitor
       
     6 	instanceVariableNames:''
       
     7 	classVariableNames:''
       
     8 	poolDictionaries:''
       
     9 	category:'PetitCompiler-Visitors'
       
    10 !
       
    11 
       
    12 !PPCOptimizingVisitor methodsFor:'visiting'!
       
    13 
       
    14 visitActionNode: node
       
    15 "	^ super visitActionNode: node."
       
    16 	self visitChildren: node.
       
    17 
       
    18 	((node hasProperty: #trimmingToken) not and: [ node block isSymbol ]) ifTrue: [ 
       
    19 		self change.
       
    20 		^ PPCSymbolActionNode new
       
    21 			block: node block;
       
    22 			name: node name;
       
    23 			child: node child;
       
    24 			yourself
       
    25 	].
       
    26 
       
    27 	^ node
       
    28 !
       
    29 
       
    30 visitForwardNode: node
       
    31 
       
    32 	self visitChildren: node.
       
    33 
       
    34 	node child name ifNil: [  
       
    35 		self change.
       
    36 		node child name: node name.
       
    37 		^ node child
       
    38 	].
       
    39 
       
    40 	(node child name = node name) ifTrue: [ 
       
    41 		self change.
       
    42 		^ node child
       
    43 	].
       
    44 
       
    45 	^ node
       
    46 !
       
    47 
       
    48 visitNotNode: node
       
    49 	self visitChildren: node.
       
    50 
       
    51 	(node child isKindOf: PPCAbstractLiteralNode) ifTrue: [  
       
    52 		self change.
       
    53 		^ PPCNotLiteralNode new
       
    54 			name: node name;
       
    55 			literal: node child literal;
       
    56 			yourself
       
    57 	]. 
       
    58 
       
    59 	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [  
       
    60 		self change.
       
    61 		^ PPCNotMessagePredicateNode new
       
    62 			name: node name;
       
    63 			message: node child message;
       
    64 			yourself
       
    65 	].
       
    66 
       
    67 	(node child isKindOf: PPCCharSetPredicateNode) ifTrue: [  
       
    68 		self change.
       
    69 		^ PPCNotCharSetPredicateNode new
       
    70 			name: node name;
       
    71 			predicate: node child predicate;
       
    72 			yourself
       
    73 	].
       
    74 
       
    75 	^ node
       
    76 
       
    77     "Modified: / 23-04-2015 / 12:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
    78 !
       
    79 
       
    80 visitPredicateNode: node
       
    81 	| charSet |
       
    82 	
       
    83 	(node predicate class == PPCharSetPredicate) ifTrue: [ 
       
    84 		charSet := node predicate.
       
    85 	].
       
    86 	charSet := PPCharSetPredicate on: node predicate.
       
    87 
       
    88 
       
    89 	(charSet equals: (PPCharSetPredicate on: [ :char | char isLetter])) ifTrue: [ 
       
    90 		change := true.
       
    91 		^ PPCMessagePredicateNode new
       
    92 			name: node name;
       
    93 			message: #isLetter;
       
    94 			predicate: node predicate;
       
    95 			yourself
       
    96 	].
       
    97 
       
    98 
       
    99 	(charSet equals: (PPCharSetPredicate on: [ :char | char isDigit])) ifTrue: [ 
       
   100 		change := true.
       
   101 		^ PPCMessagePredicateNode new
       
   102 			name: node name;
       
   103 			message: #isDigit;
       
   104 			predicate: node predicate;
       
   105 			yourself
       
   106 	].
       
   107 
       
   108 	(charSet equals: (PPCharSetPredicate on: [ :char | char isAlphaNumeric])) ifTrue: [ 
       
   109 		change := true.
       
   110 		^ PPCMessagePredicateNode new
       
   111 			name: node name;
       
   112 			message: #isAlphaNumeric;
       
   113 			predicate: node predicate;
       
   114 			yourself
       
   115 	].
       
   116 
       
   117 	(charSet equals: (PPCharSetPredicate on: [ :char | char isSeparator])) ifTrue: [ 
       
   118 		change := true.
       
   119 		^ PPCMessagePredicateNode new
       
   120 			name: node name;
       
   121 			message: #isSeparator;
       
   122 			predicate: node predicate;
       
   123 			yourself
       
   124 	].
       
   125 
       
   126 	(charSet equals: (PPCharSetPredicate on: [ :char | true ])) ifTrue: [ 
       
   127 		change := true.
       
   128 		^ PPCAnyNode new
       
   129 			name: node name;
       
   130 			yourself
       
   131 	].
       
   132 
       
   133 
       
   134 	change := true.
       
   135 	^ PPCCharSetPredicateNode new
       
   136 		name: node name;
       
   137 		predicate: charSet;
       
   138 		yourself.
       
   139 !
       
   140 
       
   141 visitStarNode: node
       
   142 
       
   143 	self visitChildren: node.
       
   144 
       
   145 	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [ 
       
   146 		self change.
       
   147 		^ PPCStarMessagePredicateNode new
       
   148 			name: node name;
       
   149 			child: node child;
       
   150 			message: node child message;
       
   151 			yourself
       
   152 	].
       
   153 
       
   154 	(node child isKindOf: PPCAnyNode) ifTrue: [ 
       
   155 		self change.
       
   156 		^ PPCStarAnyNode new
       
   157 			name: node name;
       
   158 			child: node child;
       
   159 			yourself
       
   160 	]. 
       
   161 
       
   162 	(node child isKindOf: PPCCharSetPredicateNode) ifTrue: [ 
       
   163 		self change.
       
   164 		^ PPCStarCharSetPredicateNode new
       
   165 			name: node name;
       
   166 			predicate: node child predicate;
       
   167 			child: node child;
       
   168 			yourself
       
   169 	].
       
   170 
       
   171 	^ node
       
   172 !
       
   173 
       
   174 visitTokenStarMessagePredicateNode: node
       
   175 
       
   176 	self visitChildren: node.
       
   177 
       
   178 	(node message = #isSeparator) ifTrue: [ 
       
   179 		self change.
       
   180 		^ PPCTokenStarSeparatorNode new
       
   181 			name: node name;
       
   182 			child: node child;
       
   183 			message: node message;
       
   184 			yourself.
       
   185 	].
       
   186 
       
   187 	^ node
       
   188 ! !
       
   189