|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 Object subclass:#PPCGuard |
|
4 instanceVariableNames:'node classification id message' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitCompiler-Core' |
|
8 ! |
|
9 |
|
10 PPCGuard comment:'' |
|
11 ! |
|
12 |
|
13 !PPCGuard class methodsFor:'as yet unclassified'! |
|
14 |
|
15 on: aPPCNode |
|
16 ^ self new |
|
17 initializeFor: aPPCNode; |
|
18 yourself |
|
19 ! ! |
|
20 |
|
21 !PPCGuard methodsFor:'accessing'! |
|
22 |
|
23 id |
|
24 |
|
25 ^ id |
|
26 ! |
|
27 |
|
28 id: anObject |
|
29 |
|
30 id := anObject |
|
31 ! |
|
32 |
|
33 message |
|
34 (message == #unknown) ifTrue: [ |
|
35 (self testMessage: #isLetter) ifTrue: [ ^ message := #isLetter ]. |
|
36 (self testMessage: #isAlphaNumeric) ifTrue: [ ^ message := #isAlphaNumeric ]. |
|
37 (self testMessage: #isDigit) ifTrue: [ ^ message := #isDigit ]. |
|
38 |
|
39 ^ message := nil. |
|
40 ]. |
|
41 ^ message |
|
42 ! ! |
|
43 |
|
44 !PPCGuard methodsFor:'as yet unclassified'! |
|
45 |
|
46 classificationOn: aBlock |
|
47 classification := Array new: 255. |
|
48 1 to: classification size do: [ :index | |
|
49 classification at: index put: (aBlock |
|
50 value: (Character value: index)) ]. |
|
51 ! |
|
52 |
|
53 compileAny: compiler |
|
54 compiler add: '(context atEnd not)'. |
|
55 ! |
|
56 |
|
57 compileCharacter: compiler |
|
58 self assert: (classification select: [ :e | e ]) size = 1. |
|
59 |
|
60 classification keysAndValuesDo: [ :index :value | value ifTrue: [ |
|
61 (index > 32 and: [ index < 127 ]) ifTrue: [ |
|
62 compiler add: '(context peek = ', (Character value: index) printString, ')' |
|
63 ] ifFalse: [ |
|
64 id := compiler idFor: (Character value: index) prefixed: #character. |
|
65 compiler addConstant: (Character value: index) as: id. |
|
66 compiler add: '(context peek = ', id, ')'. |
|
67 ] |
|
68 ] ]. |
|
69 |
|
70 ! |
|
71 |
|
72 compileGuard: compiler id: symbol |
|
73 self id: symbol. |
|
74 ^ self compileGuard: compiler |
|
75 ! |
|
76 |
|
77 compileMessage: compiler |
|
78 compiler add: '(context peek ', message, ')' |
|
79 ! |
|
80 |
|
81 initializeFor: aPPCNode |
|
82 node := aPPCNode. |
|
83 message := #unknown. |
|
84 id := nil. |
|
85 |
|
86 "No Guards for trimming parser so far" |
|
87 ((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty not) ifTrue: [ |
|
88 ^ self initializeForNoGuard |
|
89 ]. |
|
90 (node acceptsEpsilon) ifTrue: [ |
|
91 ^ self initializeForEpsilon |
|
92 ]. |
|
93 |
|
94 self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharParser parse: char asString) isPetitFailure not ]] |
|
95 ! |
|
96 |
|
97 initializeForEpsilon |
|
98 classification := nil |
|
99 |
|
100 ! |
|
101 |
|
102 initializeForNoGuard |
|
103 classification := nil |
|
104 |
|
105 ! |
|
106 |
|
107 testAny |
|
108 ^ classification allSatisfy: [ :e | e ]. |
|
109 ! |
|
110 |
|
111 testMessage: selector |
|
112 classification keysAndValuesDo: [:index :element | |
|
113 (element = ((Character value: index) perform: selector)) ifFalse: [ |
|
114 ^ false |
|
115 ] |
|
116 ]. |
|
117 ^ true |
|
118 ! |
|
119 |
|
120 testSingleCharacter |
|
121 ^ (classification select: [ :e | e ]) size = 1 |
|
122 ! ! |
|
123 |
|
124 !PPCGuard methodsFor:'code generation'! |
|
125 |
|
126 compileArray: compiler |
|
127 | array | |
|
128 self assert: id isNotNil. |
|
129 |
|
130 array := ((classification asOrderedCollection) addLast: false; yourself) asArray. |
|
131 compiler addConstant: array as: id. |
|
132 compiler add: '(', id, ' at: context peek asInteger)'. |
|
133 ! |
|
134 |
|
135 compileGuard: compiler |
|
136 self assert: self makesSense description: 'No Guard could be compiled'. |
|
137 self assert: id notNil. |
|
138 |
|
139 |
|
140 self message ifNotNil: [ ^ self compileMessage: compiler ]. |
|
141 self testAny ifTrue: [ ^ self compileAny: compiler ]. |
|
142 self testSingleCharacter ifTrue: [ ^ self compileCharacter: compiler ]. |
|
143 |
|
144 ^ self compileArray: compiler |
|
145 ! |
|
146 |
|
147 makesSense |
|
148 ^ classification isNil not |
|
149 ! ! |
|
150 |