comparison modules/parser.tp @ 239:6aab8a5a2be9

Don't expose internal helper functions in parser module
author Mike Pavone <pavone@retrodev.com>
date Sun, 05 Jan 2014 19:28:09 -0800
parents dae093baf36c
children 0e7982adc76b
comparison
equal deleted inserted replaced
238:3bfc00e4f5e5 239:6aab8a5a2be9
1 #{ 1 {
2 _applyMatch <- :fun tomatch { 2 _applyMatch <- :fun tomatch {
3 fun: tomatch 3 fun: tomatch
4 } 4 }
5 _matchString <- :str tomatch { 5 _matchString <- :str tomatch {
6 if: (tomatch isString?) { 6 if: (tomatch isString?) {
7 if: (tomatch length) < (str length) { 7 if: (tomatch length) < (str length) {
8 #{
9 matched? <- { false }
10 }
11 } else: {
12 if: (tomatch length) > (str length) {
13 tomatch <- tomatch from: 0 withLength: (str length)
14 }
15 if: str = tomatch {
16 #{
17 matched? <- { true }
18 matchlen <- { str length }
19 basicYield? <- { true }
20 yield <- { str }
21 }
22 } else: {
8 #{ 23 #{
9 matched? <- { false } 24 matched? <- { false }
10 } 25 }
11 } else: { 26 }
12 if: (tomatch length) > (str length) { 27 }
13 tomatch <- tomatch from: 0 withLength: (str length) 28 } else: {
14 } 29 #{
15 if: str = tomatch { 30 matched? <- { false }
16 #{ 31 }
17 matched? <- { true } 32 }
18 matchlen <- { str length } 33 }
19 basicYield? <- { true } 34 _makeMatchCall <- :matchexpr {
20 yield <- { str } 35 if: (matchexpr nodeType) = "lambda" {
21 } 36 #{
22 } else: { 37 valid? <- { true }
23 #{ 38 matchcall <- quote: (_applyMatch: matchexpr tomatch)
24 matched? <- { false } 39 }
25 } 40 } else: {
26 } 41 if: (matchexpr nodeType) = "symbol" {
27 }
28 } else: {
29 #{
30 matched? <- { false }
31 }
32 }
33 }
34 ifmatch:else <- :matchres :elseblock {
35 if: (matchres matched?) {
36 matchres
37 } else: {
38 elseblock:
39 }
40 }
41 _makeMatchCall <- :matchexpr {
42 if: (matchexpr nodeType) = "lambda" {
43 #{ 42 #{
44 valid? <- { true } 43 valid? <- { true }
45 matchcall <- quote: (_applyMatch: matchexpr tomatch) 44 matchcall <- quote: (matchexpr: tomatch)
46 } 45 }
47 } else: { 46 } else: {
48 if: (matchexpr nodeType) = "symbol" { 47 if: (matchexpr nodeType) = "strlit" {
49 #{ 48 #{
50 valid? <- { true } 49 valid? <- { true }
51 matchcall <- quote: (matchexpr: tomatch) 50 matchcall <- quote: (_matchString: matchexpr tomatch)
52 } 51 }
53 } else: { 52 } else: {
54 if: (matchexpr nodeType) = "strlit" { 53 if: (matchexpr nodeType) = "op" {
55 #{ 54 if: (matchexpr opName) = "." {
56 valid? <- { true } 55 left <- (_makeMatchCall: (matchexpr left)) matchcall
57 matchcall <- quote: (_matchString: matchexpr tomatch) 56 right <- (_makeMatchCall: (matchexpr right)) matchcall
58 } 57 #{
59 } else: { 58 valid? <- { true }
60 if: (matchexpr nodeType) = "op" { 59 matchcall <- quote: (_applyMatch: :tomatch {
61 if: (matchexpr opName) = "." { 60 lm <- left
62 left <- (_makeMatchCall: (matchexpr left)) matchcall 61 if: (lm matched?) {
63 right <- (_makeMatchCall: (matchexpr right)) matchcall 62 orig <- tomatch
64 #{ 63 tomatch <- tomatch from: (lm matchlen)
65 valid? <- { true } 64 rm <- right
66 matchcall <- quote: (_applyMatch: :tomatch { 65 if: (rm matched?) {
67 lm <- left 66 total <- (rm matchlen) + (lm matchlen)
68 if: (lm matched?) { 67 #{
69 orig <- tomatch 68 matched? <- { true }
70 tomatch <- tomatch from: (lm matchlen) 69 matchlen <- { total }
71 rm <- right 70 basicYield? <- { true }
72 if: (rm matched?) { 71 yield <- { orig from: 0 withLength: total }
73 total <- (rm matchlen) + (lm matchlen)
74 #{
75 matched? <- { true }
76 matchlen <- { total }
77 basicYield? <- { true }
78 yield <- { orig from: 0 withLength: total }
79 }
80 } else: {
81 rm
82 } 72 }
83 } else: { 73 } else: {
84 lm 74 rm
85 } 75 }
86 } tomatch) 76 } else: {
87 } 77 lm
88 } else: { 78 }
89 #{ 79 } tomatch)
90 valid? <- { false }
91 message <- "Unsupported operator " . (matchexpr opName)
92 }
93 } 80 }
94 } else: { 81 } else: {
95 #{ 82 #{
96 valid? <- { false } 83 valid? <- { false }
97 message <- "Unsupported AST node type " . (matchexpr nodeType) 84 message <- "Unsupported operator " . (matchexpr opName)
98 } 85 }
99 } 86 }
100 }
101 }
102 }
103 }
104 expandClass <- :chars {
105 if: (chars length) > 0 {
106 pos <- 0
107 inverted <- false
108 if: (chars byte: 0) = ("^" byte: 0) {
109 pos <- 1
110 inverted <- true
111 }
112 state_begin <- 0
113 state_normal <- 1
114 state_rangeend <- 2
115 state <- state_begin
116 out <- ""
117 while: { pos < (chars byte_length)} do: {
118 if: state = state_begin {
119 out <- out . (chars from: pos withLength: 1)
120 state <- state_normal
121 } else: { 87 } else: {
122 if: state = state_normal { 88 #{
123 if: (chars byte: pos) = ("-" byte: 0) { 89 valid? <- { false }
124 state <- state_rangeend 90 message <- "Unsupported AST node type " . (matchexpr nodeType)
125 } else: { 91 }
126 out <- out . (chars from: pos withLength: 1) 92 }
93 }
94 }
95 }
96 }
97 _nPlus <- :matchexpr min {
98 funexpr <- false
99 valid <- false
100 mc <- _makeMatchCall: matchexpr
101 if: (mc valid?) {
102 mcall <- mc matchcall
103 quote: :tomatch {
104 cur <- 0
105 count <- 0
106 n <- tomatch byte_length
107 orig <- tomatch
108 _match <- true
109 allBasic? <- true
110 yieldvals <- []
111 while: { _match && cur < n } do: {
112 res <- mcall
113 _match <- res matched?
114 if: _match {
115 count <- count + 1
116 //TODO: Use some kind of lightweight substring wrapper here
117 tomatch <- tomatch from: (res matchlen)
118 if: allBasic? {
119 ifnot: (res basicYield?) {
120 allBasic? <- false
121 if: cur > 0 {
122 yieldvals <- (orig from: 0 withLength: cur) | yieldvals
123 }
124 yieldvals <- (res yield) | yieldvals
127 } 125 }
128 } else: { 126 } else: {
129 rangestart <- out byte: ((out byte_length) - 1) 127 yieldvals <- (res yield) | yieldvals
130 rangeend <- chars byte: pos 128 }
131 if: rangeend < rangestart { 129 allBasic? <- allBasic? && (res basicYield?)
132 tmp <- rangeend 130 cur <- cur + (res matchlen)
133 rangeend <- rangestart 131 }
134 rangestart <- tmp 132 }
135 } 133 if: count >= min {
136 out <- out from: 0 withLength: ((out length) - 1) 134 if: allBasic? {
137 while: { rangestart <= rangeend } do: { 135 #{
138 out <- out . (rangestart asStringChar) 136 matched? <- { true }
139 rangestart <- rangestart + 1 137 matchlen <- { cur }
140 } 138 basicYield? <- { true }
141 state <- state_begin 139 yield <- { orig from: 0 withLength: cur }
142 } 140 }
143 } 141 } else: {
144 pos <- pos + 1 142 yieldvals <- yieldvals reverse
145 } 143 #{
146 if: inverted { 144 matched? <- { true }
147 old <- out 145 matchlen <- { cur }
148 out <- "" 146 basicYield? <- { false }
149 //skip control characters for now 147 yield <- { yieldvals }
150 cur <- 32 148 }
151 while: { cur < 256 } do: { 149 }
152 notfound <- true 150 } else: {
153 idx <- 0 151 #{
154 len <- (old length) 152 matched? <- { false }
155 while: { notfound && idx < len } do: { 153 }
156 if: cur = (old byte: idx) { 154 }
157 notfound <- false 155 }
158 } else: { 156 } else: {
159 idx <- idx + 1 157 print: "#error Invalid nPlus macro call: " . (mc message) . "\n"
160 } 158 }
161 } 159 }
162 if: notfound { 160 _expandClass <- :chars {
163 out <- out . (cur asStringChar) 161 if: (chars length) > 0 {
164 } 162 pos <- 0
165 cur <- cur + 1 163 inverted <- false
166 } 164 if: (chars byte: 0) = ("^" byte: 0) {
167 } 165 pos <- 1
168 out 166 inverted <- true
169 } else: { 167 }
170 "" 168 state_begin <- 0
169 state_normal <- 1
170 state_rangeend <- 2
171 state <- state_begin
172 out <- ""
173 while: { pos < (chars byte_length)} do: {
174 if: state = state_begin {
175 out <- out . (chars from: pos withLength: 1)
176 state <- state_normal
177 } else: {
178 if: state = state_normal {
179 if: (chars byte: pos) = ("-" byte: 0) {
180 state <- state_rangeend
181 } else: {
182 out <- out . (chars from: pos withLength: 1)
183 }
184 } else: {
185 rangestart <- out byte: ((out byte_length) - 1)
186 rangeend <- chars byte: pos
187 if: rangeend < rangestart {
188 tmp <- rangeend
189 rangeend <- rangestart
190 rangestart <- tmp
191 }
192 out <- out from: 0 withLength: ((out length) - 1)
193 while: { rangestart <= rangeend } do: {
194 out <- out . (rangestart asStringChar)
195 rangestart <- rangestart + 1
196 }
197 state <- state_begin
198 }
199 }
200 pos <- pos + 1
201 }
202 if: inverted {
203 old <- out
204 out <- ""
205 //skip control characters for now
206 cur <- 32
207 while: { cur < 256 } do: {
208 notfound <- true
209 idx <- 0
210 len <- (old length)
211 while: { notfound && idx < len } do: {
212 if: cur = (old byte: idx) {
213 notfound <- false
214 } else: {
215 idx <- idx + 1
216 }
217 }
218 if: notfound {
219 out <- out . (cur asStringChar)
220 }
221 cur <- cur + 1
222 }
223 }
224 out
225 } else: {
226 ""
227 }
228 }
229 _charClass <- :chars {
230 chars <- _expandClass: chars
231 charmap <- ""
232 char <- 0
233 while: { char < 256 } do: {
234 mchar <- 0
235 found <- false
236 while: { mchar < (chars byte_length)} do: {
237 if: (chars byte: mchar) = char {
238 found <- true
239 mchar <- chars byte_length
240 }
241 mchar <- mchar + 1
242 }
243 charmap <- charmap . (if: found { "t" } else: { "f" })
244 char <- char + 1
245 }
246 t <- "t" byte: 0
247 quote: :tomatch {
248 if: (tomatch isString?) {
249 if: (charmap byte: (tomatch byte: 0)) = t {
250 #{
251 matched? <- { true }
252 matchlen <- { 1 }
253 basicYield? <- { true }
254 yield <- { tomatch from: 0 withLength: 1 }
255 }
256 } else: {
257 #{
258 matched? <- { false }
259 }
260 }
261 } else: {
262 #{
263 matched? <- { false }
264 }
265 }
266 }
267 }
268 #{
269 ifmatch:else <- :matchres :elseblock {
270 if: (matchres matched?) {
271 matchres
272 } else: {
273 elseblock:
171 } 274 }
172 } 275 }
173 charClass <- macro: :rawchars { 276 charClass <- macro: :rawchars {
174 eval: rawchars :chars { 277 eval: rawchars :chars {
175 orig <- chars 278 _charClass: chars
176 chars <- expandClass: chars
177 charmap <- ""
178 char <- 0
179 while: { char < 256 } do: {
180 mchar <- 0
181 found <- false
182 while: { mchar < (chars byte_length)} do: {
183 if: (chars byte: mchar) = char {
184 found <- true
185 mchar <- chars byte_length
186 }
187 mchar <- mchar + 1
188 }
189 charmap <- charmap . (if: found { "t" } else: { "f" })
190 char <- char + 1
191 }
192 t <- "t" byte: 0
193 quote: :tomatch {
194 if: (tomatch isString?) {
195 if: (charmap byte: (tomatch byte: 0)) = t {
196 #{
197 matched? <- { true }
198 matchlen <- { 1 }
199 basicYield? <- { true }
200 yield <- { tomatch from: 0 withLength: 1 }
201 }
202 } else: {
203 #{
204 matched? <- { false }
205 }
206 }
207 } else: {
208 #{
209 matched? <- { false }
210 }
211 }
212 }
213 } else: { 279 } else: {
214 print: "#error Argument to charClass macro must be a compile-time constant\n" 280 print: "#error Argument to charClass macro must be a compile-time constant\n"
215 }
216 }
217
218 _nPlus <- :matchexpr min {
219 funexpr <- false
220 valid <- false
221 mc <- _makeMatchCall: matchexpr
222 if: (mc valid?) {
223 mcall <- mc matchcall
224 quote: :tomatch {
225 cur <- 0
226 count <- 0
227 n <- tomatch byte_length
228 orig <- tomatch
229 _match <- true
230 allBasic? <- true
231 yieldvals <- []
232 while: { _match && cur < n } do: {
233 res <- mcall
234 _match <- res matched?
235 if: _match {
236 count <- count + 1
237 //TODO: Use some kind of lightweight substring wrapper here
238 tomatch <- tomatch from: (res matchlen)
239 if: allBasic? {
240 ifnot: (res basicYield?) {
241 allBasic? <- false
242 if: cur > 0 {
243 yieldvals <- (orig from: 0 withLength: cur) | yieldvals
244 }
245 yieldvals <- (res yield) | yieldvals
246 }
247 } else: {
248 yieldvals <- (res yield) | yieldvals
249 }
250 allBasic? <- allBasic? && (res basicYield?)
251 cur <- cur + (res matchlen)
252 }
253 }
254 if: count >= min {
255 if: allBasic? {
256 #{
257 matched? <- { true }
258 matchlen <- { cur }
259 basicYield? <- { true }
260 yield <- { orig from: 0 withLength: cur }
261 }
262 } else: {
263 yieldvals <- yieldvals reverse
264 #{
265 matched? <- { true }
266 matchlen <- { cur }
267 basicYield? <- { false }
268 yield <- { yieldvals }
269 }
270 }
271 } else: {
272 #{
273 matched? <- { false }
274 }
275 }
276 }
277 } else: {
278 print: "#error Invalid nPlus macro call: " . (mc message) . "\n"
279 } 281 }
280 } 282 }
281 283
282 zeroPlus <- macro: :matchexpr { 284 zeroPlus <- macro: :matchexpr {
283 _nPlus: matchexpr 0 285 _nPlus: matchexpr 0
991 } else: { 993 } else: {
992 print: code . "\ndid not match\n" 994 print: code . "\ndid not match\n"
993 } 995 }
994 } 996 }
995 } 997 }
998 }