quipu mercurial repository
Revision | 9364c2929259b9bf9ddaee65780ffd8e7ec35d45 (tree) |
---|---|
Time | 2018-07-20 08:27:00 |
Author | Agustina Arzille <avarzille@rise...> |
Commiter | Agustina Arzille |
Export reader interface
@@ -1141,9 +1141,11 @@ | ||
1141 | 1141 | if (!sg.strmp) |
1142 | 1142 | qp_return (NIL); |
1143 | 1143 | |
1144 | + reader rd (interp, sg.strmp->as_obj ()); | |
1145 | + | |
1144 | 1146 | while (true) |
1145 | 1147 | { |
1146 | - object expr = read_sexpr (interp, sg.strmp->as_obj ()); | |
1148 | + object expr = rd.read_sexpr (); | |
1147 | 1149 | if (expr == EOS) |
1148 | 1150 | break; |
1149 | 1151 |
@@ -323,7 +323,7 @@ | ||
323 | 323 | return (this->compile_short_circuit (env, tail, forms, NIL, OPX_(BRT))); |
324 | 324 | } |
325 | 325 | |
326 | - int compile_arglist (object env, object expr); | |
326 | + int compile_arglist (object env, object expr, int off = 1); | |
327 | 327 | void compile_builtin_call (object env, bool tail, |
328 | 328 | object expr, int builtin, int nargs); |
329 | 329 |
@@ -798,7 +798,6 @@ | ||
798 | 798 | interp->raise2 ("syntax-error", buf); |
799 | 799 | } |
800 | 800 | |
801 | -// XXX: Ordered list. | |
802 | 801 | static const struct |
803 | 802 | { |
804 | 803 | object code; |
@@ -1202,19 +1201,20 @@ | ||
1202 | 1201 | return (r); |
1203 | 1202 | } |
1204 | 1203 | |
1205 | -int bc_compiler::compile_arglist (object env, object expr) | |
1204 | +int bc_compiler::compile_arglist (object env, object expr, int off) | |
1206 | 1205 | { |
1207 | 1206 | int ret = 0; |
1207 | + this->cur_f().stkdisp += off; | |
1208 | 1208 | |
1209 | - for (++this->cur_f().stkdisp; expr != NIL; | |
1210 | - expr = xcdr (expr), ++ret, ++this->cur_f().stkdisp) | |
1209 | + for (; expr != NIL; expr = xcdr (expr), | |
1210 | + ++ret, ++this->cur_f().stkdisp) | |
1211 | 1211 | if (xcons_p (expr)) |
1212 | 1212 | this->compile_in (env, false, xcar (expr)); |
1213 | 1213 | else |
1214 | 1214 | this->interp->raise2 ("arg-error", |
1215 | 1215 | "apply: argument list must not be dotted"); |
1216 | 1216 | |
1217 | - this->cur_f().stkdisp -= ret + 1; | |
1217 | + this->cur_f().stkdisp -= ret + off; | |
1218 | 1218 | return (ret); |
1219 | 1219 | } |
1220 | 1220 |
@@ -1262,10 +1262,8 @@ | ||
1262 | 1262 | // Evaluate the calling function's definition. |
1263 | 1263 | this->compile_in (env, false, h); |
1264 | 1264 | } |
1265 | - else | |
1266 | - --this->cur_f().stkdisp; | |
1267 | 1265 | |
1268 | - int nargs = this->compile_arglist (env, xcdr (expr)); | |
1266 | + int nargs = this->compile_arglist (env, xcdr (expr), bidx < 0); | |
1269 | 1267 | if (!(bidx < 0)) |
1270 | 1268 | this->compile_builtin_call (env, tail, expr, bidx, nargs); |
1271 | 1269 | else |
@@ -1507,6 +1505,8 @@ | ||
1507 | 1505 | |
1508 | 1506 | // Complex expression. |
1509 | 1507 | e1 = xcar (expr); |
1508 | + if (!symbol_p (e1)) | |
1509 | + return (this->compile_app (env, tail, expr)); | |
1510 | 1510 | |
1511 | 1511 | switch (get_specform (as_str (symname (e1)))) |
1512 | 1512 | { |
@@ -214,372 +214,330 @@ | ||
214 | 214 | return (nullptr); |
215 | 215 | } |
216 | 216 | |
217 | -class rdstate | |
217 | +reader::reader (interpreter *ip, object input) : interp (ip), | |
218 | + pairs_valref (ip, intobj (0)) | |
218 | 219 | { |
219 | -public: | |
220 | - interpreter *interp; | |
221 | - valref pairs_valref; | |
222 | - local_varobj<array> pairs; | |
223 | - object stpairs[16]; | |
224 | - int pair_cnt; | |
225 | - char stbuf[256]; | |
226 | - char *bufp; | |
227 | - int bufcnt; | |
228 | - int bufmax; | |
229 | - int toktype; | |
230 | - stream *src; | |
231 | - int bq_level; | |
232 | - bool unquoted; | |
220 | + this->pairs.type = typecode::ARRAY; | |
221 | + this->pairs.full = 0; | |
222 | + this->pairs.data = this->stpairs; | |
223 | + this->pairs.len = QP_NELEM (this->stpairs); | |
233 | 224 | |
234 | - rdstate (interpreter *ip, object input_src) : interp (ip), | |
235 | - pairs_valref (ip, intobj (0)) | |
236 | - { | |
237 | - this->pairs.type = typecode::ARRAY; | |
238 | - this->pairs.full = 0; | |
239 | - this->pairs.data = this->stpairs; | |
240 | - this->pairs.len = QP_NELEM (this->stpairs); | |
225 | + this->pair_cnt = 0; | |
226 | + for (int i = 0; i < this->pairs.len; ++i) | |
227 | + this->pairs.data[i] = UNBOUND; | |
241 | 228 | |
242 | - this->pair_cnt = 0; | |
243 | - for (int i = 0; i < this->pairs.len; ++i) | |
244 | - this->pairs.data[i] = UNBOUND; | |
229 | + this->bufmax = QP_NELEM (this->stbuf); | |
230 | + this->bufp = this->stbuf; | |
245 | 231 | |
246 | - this->bufmax = QP_NELEM (this->stbuf); | |
247 | - this->bufp = this->stbuf; | |
232 | + this->take (); | |
233 | + this->src = as_stream (input); | |
234 | + *this->pairs_valref = this->pairs.as_obj (); | |
235 | +} | |
248 | 236 | |
249 | - this->take (); | |
250 | - this->src = as_stream (input_src); | |
251 | - this->bq_level = 0; | |
252 | - this->unquoted = false; | |
253 | - *this->pairs_valref = this->pairs.as_obj (); | |
237 | +void reader::take () | |
238 | +{ | |
239 | + this->toktype = TOK_NONE; | |
240 | + this->bufcnt = 0; | |
241 | +} | |
242 | + | |
243 | +void reader::push_ch (const schar& ch) | |
244 | +{ | |
245 | + if (this->bufcnt + ch.len >= this->bufmax) | |
246 | + { | |
247 | + int nsize = (int)upsize (this->bufcnt + ch.len + 1); | |
248 | + char *nbuf = (char *)xmalloc (nsize); | |
249 | + | |
250 | + memcpy (nbuf, this->bufp, this->bufcnt); | |
251 | + if (this->bufp != this->stbuf) | |
252 | + xfree (this->bufp); | |
253 | + | |
254 | + this->bufp = nbuf; | |
255 | + this->bufmax = nsize; | |
254 | 256 | } |
255 | 257 | |
256 | - bool cantread_p () const | |
257 | - { | |
258 | - return (this->src->eos_p () || this->src->err_p ()); | |
259 | - } | |
260 | - | |
261 | - void take () | |
262 | - { | |
263 | - this->toktype = TOK_NONE; | |
264 | - this->bufcnt = 0; | |
265 | - } | |
266 | - | |
267 | - void accum (const schar& ch) | |
268 | - { | |
269 | - if (this->bufcnt + ch.len >= this->bufmax) | |
270 | - { | |
271 | - int nsize = (int)upsize (this->bufcnt + ch.len + 1); | |
272 | - char *nbuf = (char *)xmalloc (nsize); | |
258 | + fscpy (this->bufp + this->bufcnt, ch.buf, ch.len); | |
259 | + this->bufcnt += ch.len; | |
260 | +} | |
273 | 261 | |
274 | - memcpy (nbuf, this->bufp, this->bufcnt); | |
275 | - if (this->bufp != this->stbuf) | |
276 | - xfree (this->bufp); | |
277 | - | |
278 | - this->bufp = nbuf; | |
279 | - this->bufmax = nsize; | |
280 | - } | |
262 | +bool reader::read_token (schar& ch, int digs) | |
263 | +{ | |
264 | + bool first = true; | |
265 | + int esc_p = 0, sym_p = 0; | |
266 | + while (true) | |
267 | + { | |
268 | + if (!first && !this->src->sgetc (this->interp, ch)) | |
269 | + goto term; | |
281 | 270 | |
282 | - fscpy (this->bufp + this->bufcnt, ch.buf, ch.len); | |
283 | - this->bufcnt += ch.len; | |
284 | - } | |
285 | - | |
286 | - bool read_token (schar& ch, int digs) | |
287 | - { | |
288 | - bool first = true; | |
289 | - int esc_p = 0, sym_p = 0; | |
290 | - while (true) | |
271 | + first = false; | |
272 | + if (ch.uc == '|') | |
273 | + esc_p ^= (sym_p = 1); | |
274 | + else if (ch.uc == '\\') | |
291 | 275 | { |
292 | - if (!first && !this->src->sgetc (this->interp, ch)) | |
276 | + sym_p = 1; | |
277 | + if (!this->src->sgetc (this->interp, ch)) | |
293 | 278 | goto term; |
294 | 279 | |
295 | - first = false; | |
296 | - if (ch.uc == '|') | |
297 | - esc_p ^= (sym_p = 1); | |
298 | - else if (ch.uc == '\\') | |
299 | - { | |
300 | - sym_p = 1; | |
301 | - if (!this->src->sgetc (this->interp, ch)) | |
302 | - goto term; | |
303 | - | |
304 | - this->accum (ch); | |
305 | - } | |
306 | - else if (!esc_p && (!symchar_p (ch.uc) && | |
307 | - (!digs || isdigit (ch.uc)))) | |
308 | - break; | |
309 | - else | |
310 | - this->accum (ch); | |
280 | + this->push_ch (ch); | |
311 | 281 | } |
312 | - | |
313 | - this->src->ungetuc (ch.buf, ch.len); | |
314 | - term: | |
315 | - this->bufp[this->bufcnt] = '\0'; | |
316 | - return (sym_p != 0); | |
317 | - } | |
318 | - | |
319 | - void expand () | |
320 | - { | |
321 | - int nmax = this->pairs.len * 2, mask = (nmax >> 1) - 1; | |
322 | - object *p2 = (object *)xmalloc (nmax * sizeof (*p2)); | |
323 | - | |
324 | - for (int i = 0; i < nmax; ++i) | |
325 | - p2[i] = UNBOUND; | |
326 | - | |
327 | - for (int i = 0, j = 0; j < this->pair_cnt; i += 2) | |
328 | - { | |
329 | - object *tmp = &this->pairs.data[i]; | |
330 | - if (*tmp == UNBOUND) | |
331 | - continue; | |
332 | - | |
333 | - for (int pb = 1, bucket = (int)(*tmp & mask) ; ; | |
334 | - bucket = (bucket + pb++) & mask) | |
335 | - if (p2[bucket * 2] == UNBOUND) | |
336 | - { | |
337 | - p2[bucket * 2] = *tmp; | |
338 | - break; | |
339 | - } | |
340 | - | |
341 | - ++j; | |
342 | - } | |
343 | - | |
344 | - object *prev = this->pairs.data; | |
345 | - this->pairs.data = p2; | |
346 | - this->pairs.len = nmax; | |
347 | - | |
348 | - if (prev != this->stpairs) | |
349 | - xfree (prev); | |
282 | + else if (!esc_p && (!symchar_p (ch.uc) && | |
283 | + (!digs || isdigit (ch.uc)))) | |
284 | + break; | |
285 | + else | |
286 | + this->push_ch (ch); | |
350 | 287 | } |
351 | 288 | |
352 | - object gethash (object lbl) const | |
289 | + this->src->ungetuc (ch.buf, ch.len); | |
290 | +term: | |
291 | + this->bufp[this->bufcnt] = '\0'; | |
292 | + return (sym_p != 0); | |
293 | +} | |
294 | + | |
295 | +void reader::expand () | |
296 | +{ | |
297 | + int nmax = this->pairs.len * 2, mask = (nmax >> 1) - 1; | |
298 | + object *p2 = (object *)xmalloc (nmax * sizeof (*p2)); | |
299 | + | |
300 | + for (int i = 0; i < nmax; ++i) | |
301 | + p2[i] = UNBOUND; | |
302 | + | |
303 | + for (int i = 0, j = 0; j < this->pair_cnt; i += 2) | |
353 | 304 | { |
354 | - for (int pb = 1, mask = (this->pairs.len >> 1) - 1, | |
355 | - bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask) | |
356 | - { | |
357 | - const object *p = &this->pairs.data[bucket * 2]; | |
358 | - if (*p == lbl) | |
359 | - return (p[1]); | |
360 | - else if (*p != UNBOUND) | |
361 | - return (UNBOUND); | |
362 | - } | |
305 | + object *tmp = &this->pairs.data[i]; | |
306 | + if (*tmp == UNBOUND) | |
307 | + continue; | |
308 | + | |
309 | + for (int pb = 1, bucket = (int)(*tmp & mask) ; ; | |
310 | + bucket = (bucket + pb++) & mask) | |
311 | + if (p2[bucket * 2] == UNBOUND) | |
312 | + { | |
313 | + p2[bucket * 2] = *tmp; | |
314 | + break; | |
315 | + } | |
316 | + | |
317 | + ++j; | |
363 | 318 | } |
364 | 319 | |
365 | - object* puthash (object lbl) | |
320 | + object *prev = this->pairs.data; | |
321 | + this->pairs.data = p2; | |
322 | + this->pairs.len = nmax; | |
323 | + | |
324 | + if (prev != this->stpairs) | |
325 | + xfree (prev); | |
326 | +} | |
327 | + | |
328 | +object reader::gethash (object lbl) const | |
329 | +{ | |
330 | + for (int pb = 1, mask = (this->pairs.len >> 1) - 1, | |
331 | + bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask) | |
366 | 332 | { |
367 | - for (int pb = 1, mask = (this->pairs.len >> 1) - 1, | |
368 | - bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask) | |
333 | + const object *p = &this->pairs.data[bucket * 2]; | |
334 | + if (*p == lbl) | |
335 | + return (p[1]); | |
336 | + else if (*p != UNBOUND) | |
337 | + return (UNBOUND); | |
338 | + } | |
339 | +} | |
340 | + | |
341 | +object* reader::puthash (object lbl) | |
342 | +{ | |
343 | + for (int pb = 1, mask = (this->pairs.len >> 1) - 1, | |
344 | + bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask) | |
345 | + { | |
346 | + object *p = &this->pairs.data[bucket * 2]; | |
347 | + if (*p == lbl) | |
348 | + return (p + 1); | |
349 | + else if (*p == UNBOUND) | |
369 | 350 | { |
370 | - object *p = &this->pairs.data[bucket * 2]; | |
371 | - if (*p == lbl) | |
372 | - return (p + 1); | |
373 | - else if (*p == UNBOUND) | |
351 | + *p = lbl; | |
352 | + if (this->pairs.len * 75 <= this->pair_cnt * 100) | |
374 | 353 | { |
375 | - *p = lbl; | |
376 | - if (this->pairs.len * 75 <= this->pair_cnt * 100) | |
377 | - { | |
378 | - this->expand (); | |
379 | - return (this->puthash (lbl)); | |
380 | - } | |
354 | + this->expand (); | |
355 | + return (this->puthash (lbl)); | |
356 | + } | |
381 | 357 | |
382 | - ++this->pair_cnt; | |
383 | - return (p + 1); | |
384 | - } | |
358 | + ++this->pair_cnt; | |
359 | + return (p + 1); | |
385 | 360 | } |
386 | 361 | } |
362 | +} | |
387 | 363 | |
388 | - bool nextc (schar& ch) | |
364 | +bool reader::nextc (schar& ch) | |
365 | +{ | |
366 | + do | |
389 | 367 | { |
390 | - do | |
391 | - { | |
368 | + if (!this->src->sgetc (this->interp, ch)) | |
369 | + return (false); | |
370 | + else if (ch.uc == ';') | |
371 | + do | |
392 | 372 | if (!this->src->sgetc (this->interp, ch)) |
393 | 373 | return (false); |
394 | - else if (ch.uc == ';') | |
395 | - do | |
396 | - if (!this->src->sgetc (this->interp, ch)) | |
397 | - return (false); | |
398 | - while (ch.uc != '\n'); | |
399 | - } | |
400 | - while (isspace (ch.uc)); | |
374 | + while (ch.uc != '\n'); | |
401 | 375 | |
402 | - return (true); | |
376 | + if (ch.uc == '\n') | |
377 | + ++this->lineno; | |
403 | 378 | } |
379 | + while (isspace (ch.uc)); | |
404 | 380 | |
405 | - uint32_t peek () | |
381 | + return (true); | |
382 | +} | |
383 | + | |
384 | +uint32_t reader::peek () | |
385 | +{ | |
386 | + schar ch; | |
387 | + if (this->toktype != TOK_NONE) | |
388 | + return (this->toktype); | |
389 | + else if (!this->nextc (ch)) | |
390 | + return (TOK_NONE); | |
391 | + | |
392 | + switch (ch.uc) | |
406 | 393 | { |
407 | - schar ch; | |
408 | - if (this->toktype != TOK_NONE) | |
409 | - return (this->toktype); | |
410 | - else if (!this->nextc (ch)) | |
411 | - return (TOK_NONE); | |
412 | - | |
413 | - switch (ch.uc) | |
414 | - { | |
415 | 394 | #define DISPATCH(ch, tok) \ |
416 | 395 | case ch: \ |
417 | 396 | this->toktype = TOK_##tok; \ |
418 | 397 | break |
419 | - DISPATCH ('(', OPEN); | |
420 | - DISPATCH (')', CLOSE); | |
421 | - DISPATCH ('[', OPENB); | |
422 | - DISPATCH (']', CLOSEB); | |
423 | - DISPATCH ('{', OPENBRACE); | |
424 | - DISPATCH ('}', CLOSEBRACE); | |
425 | - DISPATCH ('\'', QUOTE); | |
426 | - DISPATCH ('`', BQ); | |
427 | - DISPATCH (',', COMMA); | |
428 | - DISPATCH ('"', DQUOTE); | |
429 | - DISPATCH ('\\', CHAR); | |
398 | + | |
399 | + DISPATCH ('(', OPEN); | |
400 | + DISPATCH (')', CLOSE); | |
401 | + DISPATCH ('[', OPENB); | |
402 | + DISPATCH (']', CLOSEB); | |
403 | + DISPATCH ('{', OPENBRACE); | |
404 | + DISPATCH ('}', CLOSEBRACE); | |
405 | + DISPATCH ('\'', QUOTE); | |
406 | + DISPATCH ('`', BQ); | |
407 | + DISPATCH (',', COMMA); | |
408 | + DISPATCH ('"', DQUOTE); | |
409 | + DISPATCH ('\\', CHAR); | |
430 | 410 | |
431 | - case '#': | |
411 | + case '#': | |
412 | + { | |
413 | + if (!this->src->sgetc (this->interp, ch)) | |
414 | + this->interp->raise2 ("parse-error", "read: invalid read macro"); | |
415 | + else if (ch.uc == '.') | |
416 | + this->toktype = TOK_SHARPDOT; | |
417 | + else if (ch.uc == '\'') | |
418 | + this->toktype = TOK_SHARPQUOTE; | |
419 | + else if (ch.uc == '(') | |
420 | + this->toktype = TOK_SHARPOPEN; | |
421 | + else if (ch.uc == '<') | |
422 | + this->interp->raise2 ("parse-error", "read: unreadable object"); | |
423 | + else if (ch.uc == ':') | |
432 | 424 | { |
433 | 425 | if (!this->src->sgetc (this->interp, ch)) |
434 | - interp->raise2 ("parse-error", "read: invalid read macro"); | |
435 | - else if (ch.uc == '.') | |
436 | - toktype = TOK_SHARPDOT; | |
437 | - else if (ch.uc == '\'') | |
438 | - toktype = TOK_SHARPQUOTE; | |
439 | - else if (ch.uc == '(') | |
440 | - this->toktype = TOK_SHARPOPEN; | |
441 | - else if (ch.uc == '<') | |
442 | - interp->raise2 ("parse-error", "read: unreadable object"); | |
443 | - else if (ch.uc == ':') | |
444 | - { | |
445 | - if (!this->src->sgetc (this->interp, ch)) | |
446 | - interp->raise2 ("parse-error", | |
447 | - "read: premature end of input"); | |
426 | + this->interp->raise2 ("parse-error", | |
427 | + "read: premature end of input"); | |
448 | 428 | |
449 | - this->read_token (ch, 0); | |
450 | - if (numtok_p (interp, this->bufp, this->bufcnt)) | |
451 | - interp->raise2 ("parse-error", | |
452 | - "read: invalid syntax after #: reader macro"); | |
429 | + this->read_token (ch, 0); | |
430 | + if (numtok_p (interp, this->bufp, this->bufcnt)) | |
431 | + this->interp->raise2 ("parse-error", | |
432 | + "read: invalid syntax after #: reader macro"); | |
453 | 433 | |
454 | - this->toktype = TOK_SYM; | |
455 | - interp->push (alloc_sym (interp)); | |
456 | - symname(interp->stktop ()) = | |
457 | - string::make (interp, this->bufp, this->bufcnt); | |
458 | - interp->pop (); | |
459 | - } | |
460 | - else if (isdigit (ch.uc)) | |
434 | + this->toktype = TOK_SYM; | |
435 | + this->interp->push (alloc_sym (interp)); | |
436 | + symname(interp->stktop ()) = | |
437 | + string::make (interp, this->bufp, this->bufcnt); | |
438 | + this->interp->pop (); | |
439 | + } | |
440 | + else if (isdigit (ch.uc)) | |
441 | + { | |
442 | + this->read_token (ch, 1); | |
443 | + this->src->sgetc (this->interp, ch); | |
444 | + | |
445 | + if (ch.uc == '#') | |
446 | + this->toktype = TOK_BACKREF; | |
447 | + else if (ch.uc == '=') | |
448 | + this->toktype = TOK_LABEL; | |
449 | + else | |
450 | + this->interp->raise2 ("parse-error", "read: invalid label"); | |
451 | + | |
452 | + errno = 0; | |
453 | + char *endp; | |
454 | + long xv = strtol (bufp, &endp, 10); | |
455 | + if (*endp != '\0' || errno != 0) | |
456 | + this->interp->raise2 ("parse-error", "read: invalid label"); | |
457 | + | |
458 | + this->interp->retval = intobj (xv); | |
459 | + } | |
460 | + else if (ch.uc == '!') | |
461 | + { | |
462 | + do | |
463 | + this->src->sgetc (this->interp, ch); | |
464 | + while (ch.uc != UEOF && ch.uc != '\n'); | |
465 | + | |
466 | + return (this->peek ()); | |
467 | + } | |
468 | + else if (ch.uc == '"') | |
469 | + this->toktype = TOK_SHARPDQUOT; | |
470 | + else if (ch.uc == '|') | |
471 | + { | |
472 | + for (int lvl = 1 ; ; ) | |
461 | 473 | { |
462 | - this->read_token (ch, 1); | |
463 | 474 | this->src->sgetc (this->interp, ch); |
464 | - | |
465 | - if (ch.uc == '#') | |
466 | - this->toktype = TOK_BACKREF; | |
467 | - else if (ch.uc == '=') | |
468 | - this->toktype = TOK_LABEL; | |
469 | - else | |
470 | - interp->raise2 ("parse-error", "read: invalid label"); | |
471 | - | |
472 | - errno = 0; | |
473 | - char *endp; | |
474 | - long xv = strtol (bufp, &endp, 10); | |
475 | - if (*endp != '\0' || errno != 0) | |
476 | - interp->raise2 ("parse-error", "read: invalid label"); | |
477 | - | |
478 | - interp->retval = intobj (xv); | |
479 | - } | |
480 | - else if (ch.uc == '!') | |
481 | - { | |
482 | - do | |
483 | - this->src->sgetc (this->interp, ch); | |
484 | - while (ch.uc != UEOF && ch.uc != '\n'); | |
485 | - | |
486 | - return (this->peek ()); | |
487 | - } | |
488 | - else if (ch.uc == '"') | |
489 | - this->toktype = TOK_SHARPDQUOT; | |
490 | - else if (ch.uc == '|') | |
491 | - { | |
492 | - for (int lvl = 1 ; ; ) | |
475 | + got_hashp: | |
476 | + if (ch.uc == UEOF) | |
477 | + this->interp->raise2 ("parse-error", | |
478 | + "read: premature end of input"); | |
479 | + else if (ch.uc == '|') | |
493 | 480 | { |
494 | 481 | this->src->sgetc (this->interp, ch); |
495 | - got_hashp: | |
496 | - if (ch.uc == UEOF) | |
497 | - interp->raise2 ("parse-error", | |
498 | - "read: premature end of input"); | |
499 | - else if (ch.uc == '|') | |
482 | + if (ch.uc == '#') | |
500 | 483 | { |
501 | - this->src->sgetc (this->interp, ch); | |
502 | - if (ch.uc == '#') | |
503 | - { | |
504 | - if (--lvl == 0) | |
505 | - break; | |
484 | + if (--lvl == 0) | |
485 | + break; | |
506 | 486 | |
507 | - continue; | |
508 | - } | |
509 | - | |
510 | - goto got_hashp; | |
487 | + continue; | |
511 | 488 | } |
512 | - else if (ch.uc == '#') | |
513 | - { | |
514 | - this->src->sgetc (this->interp, ch); | |
515 | - if (ch.uc == '|') | |
516 | - ++lvl; | |
517 | - else | |
518 | - goto got_hashp; | |
519 | - } | |
489 | + | |
490 | + goto got_hashp; | |
520 | 491 | } |
521 | - | |
522 | - return (this->peek ()); | |
492 | + else if (ch.uc == '#') | |
493 | + { | |
494 | + this->src->sgetc (this->interp, ch); | |
495 | + if (ch.uc == '|') | |
496 | + ++lvl; | |
497 | + else | |
498 | + goto got_hashp; | |
499 | + } | |
523 | 500 | } |
524 | - else | |
525 | - interp->raise2 ("parse-error", "read: unknown read macro"); | |
526 | - | |
527 | - break; | |
528 | - } | |
529 | 501 | |
530 | - default: | |
531 | - // Number or symbol. | |
532 | - if (!this->read_token (ch, 0)) | |
533 | - { | |
534 | - if (*this->bufp == '.' && this->bufp[1] == '\0') | |
535 | - return (this->toktype = TOK_DOT); | |
536 | - else if (numtok_p (interp, this->bufp, this->bufcnt)) | |
537 | - return (this->toktype = TOK_NUM); | |
538 | - } | |
502 | + return (this->peek ()); | |
503 | + } | |
504 | + else | |
505 | + this->interp->raise2 ("parse-error", "read: unknown read macro"); | |
539 | 506 | |
540 | - this->toktype = TOK_SYM; | |
541 | - if (this->bufcnt == 3 && memcmp ("nil", this->bufp, 3) == 0) | |
542 | - interp->retval = NIL; | |
543 | - else if (*this->bufp == 't' && this->bufcnt == 1) | |
544 | - interp->retval = QP_S(t); | |
545 | - else | |
546 | - { // XXX: Use the right package. | |
547 | - if (*this->bufp == ':') | |
548 | - symbol::make_kword (interp, this->bufp + 1); | |
549 | - else | |
550 | - intern (interp, this->bufp, this->bufcnt); | |
551 | - } | |
552 | - | |
553 | - break; | |
507 | + break; | |
554 | 508 | } |
555 | 509 | |
556 | -#undef DISPATCH | |
557 | - return (toktype); | |
510 | + default: | |
511 | + // Number or symbol. | |
512 | + if (!this->read_token (ch, 0)) | |
513 | + { | |
514 | + if (*this->bufp == '.' && this->bufp[1] == '\0') | |
515 | + return (this->toktype = TOK_DOT); | |
516 | + else if (numtok_p (interp, this->bufp, this->bufcnt)) | |
517 | + return (this->toktype = TOK_NUM); | |
518 | + } | |
519 | + | |
520 | + this->toktype = TOK_SYM; | |
521 | + if (this->bufcnt == 3 && memcmp ("nil", this->bufp, 3) == 0) | |
522 | + this->interp->retval = NIL; | |
523 | + else if (*this->bufp == 't' && this->bufcnt == 1) | |
524 | + this->interp->retval = QP_S(t); | |
525 | + else | |
526 | + { // XXX: Use the right package. | |
527 | + if (*this->bufp == ':') | |
528 | + symbol::make_kword (interp, this->bufp + 1); | |
529 | + else | |
530 | + intern (interp, this->bufp, this->bufcnt); | |
531 | + } | |
532 | + | |
533 | + break; | |
558 | 534 | } |
559 | 535 | |
560 | - object read_sexpr (object); | |
561 | - object read_list (object); | |
562 | - object read_bq (object); | |
563 | - object read_comma (object); | |
564 | - object read_array (object); | |
565 | - object read_table (object); | |
566 | - object read_tree (object); | |
567 | - object read_bvector (); | |
568 | - object read_str (); | |
569 | - object read_char (); | |
536 | +#undef DISPATCH | |
537 | + return (toktype); | |
538 | +} | |
570 | 539 | |
571 | - ~rdstate () | |
572 | - { | |
573 | - *this->pairs_valref = intobj (0); | |
574 | - | |
575 | - if (this->pairs.data != this->stpairs) | |
576 | - xfree (this->pairs.data); | |
577 | - if (this->bufp != this->stbuf) | |
578 | - xfree (this->bufp); | |
579 | - } | |
580 | -}; | |
581 | - | |
582 | -object rdstate::read_array (object lbl) | |
540 | +object reader::read_array (object lbl) | |
583 | 541 | { |
584 | 542 | object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy; |
585 | 543 | int asz = 4; |
@@ -589,7 +547,7 @@ | ||
589 | 547 | *dstp = ap->as_obj (); |
590 | 548 | while (this->peek () != TOK_CLOSEB) |
591 | 549 | { |
592 | - if (this->cantread_p ()) | |
550 | + if (!this->readable_p ()) | |
593 | 551 | this->interp->raise2 ("parse-error", "read: premature end of input"); |
594 | 552 | |
595 | 553 | if (ap->len >= asz) |
@@ -617,7 +575,7 @@ | ||
617 | 575 | return (this->interp->retval); |
618 | 576 | } |
619 | 577 | |
620 | -object rdstate::read_table (object lbl) | |
578 | +object reader::read_table (object lbl) | |
621 | 579 | { |
622 | 580 | object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy; |
623 | 581 | valref ret (this->interp, alloc_table (this->interp, 1, NIL, NIL)); |
@@ -626,7 +584,7 @@ | ||
626 | 584 | |
627 | 585 | for (*dstp = *ret; this->peek () != TOK_CLOSEBRACE; ) |
628 | 586 | { |
629 | - if (this->cantread_p ()) | |
587 | + if (!this->readable_p ()) | |
630 | 588 | this->interp->raise2 ("parse-error", "read: premature end of input"); |
631 | 589 | else if (both) |
632 | 590 | { |
@@ -648,7 +606,7 @@ | ||
648 | 606 | qp_return (*ret); |
649 | 607 | } |
650 | 608 | |
651 | -object rdstate::read_tree (object lbl) | |
609 | +object reader::read_tree (object lbl) | |
652 | 610 | { |
653 | 611 | object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy; |
654 | 612 | valref ret (this->interp, alloc_tree (this->interp, NIL)); |
@@ -656,7 +614,7 @@ | ||
656 | 614 | |
657 | 615 | for (*dstp = *ret; this->peek () != TOK_CLOSE; ) |
658 | 616 | { |
659 | - if (this->cantread_p ()) | |
617 | + if (!this->readable_p ()) | |
660 | 618 | this->interp->raise2 ("parse-error", "read: premature end of input"); |
661 | 619 | |
662 | 620 | *key = this->read_sexpr (UNBOUND); |
@@ -688,7 +646,7 @@ | ||
688 | 646 | return (-1); |
689 | 647 | } |
690 | 648 | |
691 | -object rdstate::read_bvector () | |
649 | +object reader::read_bvector () | |
692 | 650 | { |
693 | 651 | int bsz = 16; |
694 | 652 | bvector *ret = bvector::alloc_raw (bsz); |
@@ -758,7 +716,7 @@ | ||
758 | 716 | return (this->interp->retval); |
759 | 717 | } |
760 | 718 | |
761 | -object rdstate::read_str () | |
719 | +object reader::read_str () | |
762 | 720 | { |
763 | 721 | int bsz = 16; |
764 | 722 | string *sp = string::alloc_raw (bsz); |
@@ -850,7 +808,7 @@ | ||
850 | 808 | return (this->interp->retval); |
851 | 809 | } |
852 | 810 | |
853 | -object rdstate::read_char () | |
811 | +object reader::read_char () | |
854 | 812 | { |
855 | 813 | schar cv; |
856 | 814 | if (!this->src->sgetc (this->interp, cv)) |
@@ -894,7 +852,7 @@ | ||
894 | 852 | qp_return (charobj (cv.uc)); |
895 | 853 | } |
896 | 854 | |
897 | -object rdstate::read_list (object lbl) | |
855 | +object reader::read_list (object lbl) | |
898 | 856 | { |
899 | 857 | object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy; |
900 | 858 | valref lr (this->interp, NIL); |
@@ -914,7 +872,7 @@ | ||
914 | 872 | tok = this->peek (); |
915 | 873 | break; |
916 | 874 | } |
917 | - else if (this->cantread_p ()) | |
875 | + else if (!this->readable_p ()) | |
918 | 876 | this->interp->raise2 ("parse-error", "read: premature end of input"); |
919 | 877 | } |
920 | 878 |
@@ -945,7 +903,7 @@ | ||
945 | 903 | interp->raise2 ("parse-error", errmsg); |
946 | 904 | } |
947 | 905 | |
948 | -object rdstate::read_comma (object lbl) | |
906 | +object reader::read_comma (object lbl) | |
949 | 907 | { |
950 | 908 | if (this->bq_level <= 0) |
951 | 909 | this->interp->raise2 ("parse-error", "read: more commas than backquotes"); |
@@ -977,7 +935,7 @@ | ||
977 | 935 | qp_return (this->interp->alval); |
978 | 936 | } |
979 | 937 | |
980 | -object rdstate::read_bq (object lbl) | |
938 | +object reader::read_bq (object lbl) | |
981 | 939 | { |
982 | 940 | this->unquoted = false; |
983 | 941 | ++this->bq_level; |
@@ -1378,7 +1336,7 @@ | ||
1378 | 1336 | } |
1379 | 1337 | } |
1380 | 1338 | |
1381 | -object rdstate::read_sexpr (object lbl) | |
1339 | +object reader::read_sexpr (object lbl) | |
1382 | 1340 | { |
1383 | 1341 | uint32_t tok = this->peek (); |
1384 | 1342 | this->take (); |
@@ -1495,19 +1453,19 @@ | ||
1495 | 1453 | return (this->interp->retval); |
1496 | 1454 | } |
1497 | 1455 | |
1498 | -object read_sexpr (interpreter *interp, object src) | |
1456 | +object reader::read_sexpr () | |
1499 | 1457 | { |
1500 | - rdstate rd (interp, src); | |
1458 | + return (this->read_sexpr (UNBOUND)); | |
1459 | +} | |
1501 | 1460 | |
1502 | - try | |
1503 | - { | |
1504 | - return (rd.read_sexpr (UNBOUND)); | |
1505 | - } | |
1506 | - catch (...) | |
1507 | - { | |
1508 | - rd.src->discard (); | |
1509 | - throw; | |
1510 | - } | |
1461 | +reader::~reader () | |
1462 | +{ | |
1463 | + *this->pairs_valref = intobj (0); | |
1464 | + | |
1465 | + if (this->pairs.data != this->stpairs) | |
1466 | + xfree (this->pairs.data); | |
1467 | + if (this->bufp != this->stbuf) | |
1468 | + xfree (this->bufp); | |
1511 | 1469 | } |
1512 | 1470 | |
1513 | 1471 | // String interpolation. |
@@ -1540,7 +1498,7 @@ | ||
1540 | 1498 | instrm.ops = ops; |
1541 | 1499 | instrm.io_flags = STRM_UTF8 | STRM_READ; |
1542 | 1500 | |
1543 | - rdstate rd (interp, instrm.as_obj ()); | |
1501 | + reader rd (interp, instrm.as_obj ()); | |
1544 | 1502 | object ret = rd.read_sexpr (UNBOUND); |
1545 | 1503 | |
1546 | 1504 | if (ret != EOS) |
@@ -7,10 +7,63 @@ | ||
7 | 7 | #include "str.h" |
8 | 8 | #include "function.h" |
9 | 9 | #include "symbol.h" |
10 | +#include "array.h" | |
10 | 11 | |
11 | 12 | QP_DECLS_BEGIN |
12 | 13 | |
13 | -QP_EXPORT object read_sexpr (interpreter *__interp, object __src); | |
14 | +class reader | |
15 | +{ | |
16 | +public: | |
17 | + interpreter *interp; | |
18 | + valref pairs_valref; | |
19 | + local_varobj<array> pairs; | |
20 | + object stpairs[16]; | |
21 | + int pair_cnt; | |
22 | + char stbuf[256]; | |
23 | + char *bufp; | |
24 | + int bufcnt; | |
25 | + int bufmax; | |
26 | + int toktype; | |
27 | + stream *src; | |
28 | + uint32_t lineno = 0; | |
29 | + int bq_level = 0; | |
30 | + bool unquoted = false; | |
31 | + bool raised = false; | |
32 | + | |
33 | + reader (interpreter *__interp, object __input); | |
34 | + | |
35 | + bool readable_p () const | |
36 | + { | |
37 | + return (!this->src->eos_p () && !this->src->err_p ()); | |
38 | + } | |
39 | + | |
40 | + void take (); | |
41 | + | |
42 | + bool read_token (schar& __ch, int __digs); | |
43 | + | |
44 | + void expand (); | |
45 | + | |
46 | + object gethash (object __label) const; | |
47 | + object* puthash (object __label); | |
48 | + | |
49 | + bool nextc (schar& __ch); | |
50 | + void push_ch (const schar& __ch); | |
51 | + uint32_t peek (); | |
52 | + | |
53 | + object read_sexpr (); | |
54 | + object read_sexpr (object __label); | |
55 | + object read_list (object __label); | |
56 | + object read_bq (object __label); | |
57 | + object read_comma (object __label); | |
58 | + object read_array (object __label); | |
59 | + object read_table (object __label); | |
60 | + object read_tree (object __label); | |
61 | + object read_bvector (); | |
62 | + object read_str (); | |
63 | + object read_char (); | |
64 | + | |
65 | + ~reader (); | |
66 | +}; | |
14 | 67 | |
15 | 68 | QP_EXPORT object expand_str (interpreter *__interp, object __str); |
16 | 69 |
@@ -87,6 +87,7 @@ | ||
87 | 87 | } |
88 | 88 | |
89 | 89 | interpreter *interp = main_interp; |
90 | + reader rd (interp, in_stream); | |
90 | 91 | |
91 | 92 | while (true) |
92 | 93 | { |
@@ -95,7 +96,7 @@ | ||
95 | 96 | |
96 | 97 | try |
97 | 98 | { |
98 | - object expr = read_sexpr (interp, in_stream); | |
99 | + object expr = rd.read_sexpr (); | |
99 | 100 | if (expr == EOS) |
100 | 101 | break; |
101 | 102 |