1 "{ Package: 'stx:goodies/petitparser' }" |
1 "{ Package: 'stx:goodies/petitparser' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
2 |
4 |
3 PPPredicateParser subclass:#PPPredicateObjectParser |
5 PPPredicateParser subclass:#PPPredicateObjectParser |
4 instanceVariableNames:'' |
6 instanceVariableNames:'' |
5 classVariableNames:'' |
7 classVariableNames:'' |
6 poolDictionaries:'' |
8 poolDictionaries:'' |
7 category:'PetitParser-Parsers' |
9 category:'PetitParser-Parsers' |
8 ! |
10 ! |
9 |
11 |
|
12 PPPredicateObjectParser class instanceVariableNames:'cache' |
|
13 |
|
14 " |
|
15 No other class instance variables are inherited by this class. |
|
16 " |
|
17 ! |
|
18 |
10 |
19 |
11 !PPPredicateObjectParser class methodsFor:'instance creation'! |
20 !PPPredicateObjectParser class methodsFor:'instance creation'! |
12 |
21 |
13 on: aBlock message: aString |
22 on: aBlock message: aString |
14 ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString |
23 ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString |
21 startOfLine |
30 startOfLine |
22 |
31 |
23 ^ PPStartOfLineParser new. |
32 ^ PPStartOfLineParser new. |
24 ! ! |
33 ! ! |
25 |
34 |
|
35 !PPPredicateObjectParser class methodsFor:'cache'! |
|
36 |
|
37 cacheAt: aSymbol ifAbsentPut: aBlock |
|
38 |
|
39 cache ifNil: [ ^aBlock value ]. |
|
40 ^(cache |
|
41 at: aSymbol |
|
42 ifAbsentPut: aBlock) copy |
|
43 ! |
|
44 |
|
45 useCache: aBoolean |
|
46 " |
|
47 PPPredicateObjectParser useCache: true. |
|
48 PPPredicateObjectParser useCache: false. |
|
49 " |
|
50 cache := aBoolean |
|
51 ifTrue: [ Dictionary new ] |
|
52 ifFalse: [ nil ] |
|
53 ! ! |
|
54 |
26 !PPPredicateObjectParser class methodsFor:'factory-chars'! |
55 !PPPredicateObjectParser class methodsFor:'factory-chars'! |
27 |
56 |
28 blank |
57 blank |
29 ^ self chars: (String with: Character space with: Character tab) message: 'blank expected' |
58 ^self |
|
59 cacheAt: #'blank' |
|
60 ifAbsentPut: [ self |
|
61 chars: (String with: Character space with: Character tab) message: 'blank expected' ] |
30 ! |
62 ! |
31 |
63 |
32 char: aCharacter |
64 char: aCharacter |
33 ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected' |
65 ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected' |
34 ! |
66 ! |
40 chars: aCollection message: aString |
72 chars: aCollection message: aString |
41 ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString |
73 ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString |
42 ! |
74 ! |
43 |
75 |
44 cr |
76 cr |
45 ^ self char: (Character codePoint: 13) message: 'carriage return expected' |
77 ^self |
|
78 cacheAt: #'cr' |
|
79 ifAbsentPut: [ self char: (Character codePoint: 13) message: 'carriage return expected' ] |
46 ! |
80 ! |
47 |
81 |
48 digit |
82 digit |
49 ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected' |
83 ^self |
|
84 cacheAt: #'digit' |
|
85 ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected' ] |
50 ! |
86 ! |
51 |
87 |
52 hex |
88 hex |
53 ^ self |
89 ^self |
|
90 cacheAt: #'hex' |
|
91 ifAbsentPut: [ self |
54 on: (PPCharSetPredicate on: [ :char | |
92 on: (PPCharSetPredicate on: [ :char | |
55 (char between: $0 and: $9) |
93 (char between: $0 and: $9) |
56 or: [ (char between: $a and: $f) |
94 or: [ (char between: $a and: $f) |
57 or: [ (char between: $A and: $F) ] ] ]) |
95 or: [ (char between: $A and: $F) ] ] ]) |
58 message: 'hex digit expected' |
96 message: 'hex digit expected' ] |
59 ! |
97 ! |
60 |
98 |
61 letter |
99 letter |
62 ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected' |
100 ^self |
|
101 cacheAt: #'letter' |
|
102 ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected' ] |
63 ! |
103 ! |
64 |
104 |
65 lf |
105 lf |
66 ^ self char: (Character codePoint: 10) |
106 ^self |
|
107 cacheAt: #'lf' |
|
108 ifAbsentPut: [ self char: (Character codePoint: 10) ] |
67 ! |
109 ! |
68 |
110 |
69 lowercase |
111 lowercase |
70 ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected' |
112 ^self |
|
113 cacheAt: #'lowercase' |
|
114 ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected' ] |
71 ! |
115 ! |
72 |
116 |
73 newline |
117 newline |
74 ^ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected' |
118 ^self |
|
119 cacheAt: #'newline' |
|
120 ifAbsentPut: [ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected' ] |
75 ! |
121 ! |
76 |
122 |
77 punctuation |
123 punctuation |
78 ^ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected' |
124 ^self |
|
125 cacheAt: #'punctuation' |
|
126 ifAbsentPut: [ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected' ] |
79 ! |
127 ! |
80 |
128 |
81 space |
129 space |
82 ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected' |
130 ^self |
|
131 cacheAt: #'space' |
|
132 ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected' ] |
83 ! |
133 ! |
84 |
134 |
85 tab |
135 tab |
86 ^ self char: Character tab message: 'tab expected' |
136 ^self |
|
137 cacheAt: #'tab' |
|
138 ifAbsentPut: [ self char: Character tab message: 'tab expected' ] |
87 ! |
139 ! |
88 |
140 |
89 uppercase |
141 uppercase |
90 ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected' |
142 ^self |
|
143 cacheAt: #'uppercase' |
|
144 ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected' ] |
91 ! |
145 ! |
92 |
146 |
93 word |
147 word |
94 ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected' |
148 ^self |
|
149 cacheAt: #'word' |
|
150 ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected' ] |
95 ! ! |
151 ! ! |
96 |
152 |
97 !PPPredicateObjectParser class methodsFor:'factory-objects'! |
153 !PPPredicateObjectParser class methodsFor:'factory-objects'! |
98 |
154 |
99 any |
155 any |
100 ^ self |
156 ^self |
101 on: [ :each | true ] message: 'input expected' |
157 cacheAt: #'any' |
102 negated: [ :each | false ] message: 'no input expected' |
158 ifAbsentPut: [ self |
|
159 on: [ :each | true ] message: 'input expected' |
|
160 negated: [ :each | false ] message: 'no input expected' ] |
103 ! |
161 ! |
104 |
162 |
105 anyExceptAnyOf: aCollection |
163 anyExceptAnyOf: aCollection |
106 ^ self |
164 ^ self |
107 on: [ :each | (aCollection includes: each) not ] message: 'any except ' , aCollection printString , ' expected' |
165 on: [ :each | (aCollection includes: each) not ] message: 'any except ' , aCollection printString , ' expected' |
123 endOfLine |
181 endOfLine |
124 |
182 |
125 ^ PPEndOfLineParser new. |
183 ^ PPEndOfLineParser new. |
126 ! |
184 ! |
127 |
185 |
|
186 eof |
|
187 |
|
188 ^ PPEndOfFileParser new |
|
189 ! |
|
190 |
128 expect: anObject |
191 expect: anObject |
129 ^ self expect: anObject message: anObject printString , ' expected' |
192 ^ self expect: anObject message: anObject printString , ' expected' |
130 ! |
193 ! |
131 |
194 |
132 expect: anObject message: aString |
195 expect: anObject message: aString |
133 ^ self |
196 ^ self |
134 on: [ :each | each = anObject ] message: aString |
197 on: [ :each | each = anObject ] message: aString |
135 negated: [ :each | each ~= anObject ] message: 'no ' , aString |
198 negated: [ :each | each ~= anObject ] message: 'no ' , aString |
136 ! ! |
199 ! |
137 |
200 |
|
201 startOfLogicalLine |
|
202 |
|
203 ^ PPStartOfLogicalLineParser new. |
|
204 ! |
|
205 |
|
206 startOfWord |
|
207 |
|
208 ^ PPStartOfWordParser new. |
|
209 ! ! |
138 |
210 |
139 !PPPredicateObjectParser methodsFor:'initialization'! |
211 !PPPredicateObjectParser methodsFor:'initialization'! |
140 |
212 |
141 initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString |
213 initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString |
142 predicate := aBlock. |
214 predicate := aBlock. |