/* Remove top object from the sexp stack. */
static object_t *pop (reader_t * r)
{
if (!r->done && stack_height (r) <= 1)
{
read_error (r, "unbalanced parenthesis");
return err_symbol;
}
if (!r->done && r->state->dotpair_mode == 1)
{
read_error (r, "missing cdr object for dotted pair");
return err_symbol;
}
object_t *p = CDR (r->state->head);
CDR (r->state->head) = NIL;
obj_destroy (r->state->head);
if (r->state->vector_mode)
{
r->state--;
object_t *v = list2vector (p);
obj_destroy (p);
return v;
}
r->state--;
return p;
}
bool queue_dequeue(queue_t *queue, void *data)
{
if(stack_isempty(&(queue->out)))
{
uint32_t height;
while((height = stack_height(&(queue->in))) > 0)
{
void *element = stack_get_element_ptr(&(queue->in), height - 1);
stack_push(&(queue->out), element);
stack_remove_last(&(queue->in));
}
}
if(stack_isempty(&(queue->out)))
return false;
stack_pop(&(queue->out), data);
return true;
}
/* Read a single sexp from the reader. */
object_t *read_sexp (reader_t * r)
{
/* Check for a shebang line. */
if (r->shebang == -1)
{
char str[2];
str[0] = reader_getc (r);
str[1] = reader_getc (r);
if (str[0] == '#' && str[1] == '!')
{
/* Looks like a she-bang line. */
r->shebang = 1;
consume_line (r);
}
else
{
r->shebang = 0;
reader_putc (r, str[1]);
reader_putc (r, str[0]);
}
}
r->done = 0;
r->error = 0;
push (r);
print_prompt (r);
while (!r->eof && !r->error && (list_empty (r) || stack_height (r) > 1))
{
int nc, c = reader_getc (r);
switch (c)
{
case EOF:
r->eof = 1;
break;
/* Comments */
case ';':
consume_line (r);
break;
/* Dotted pair */
case '.':
nc = reader_getc (r);
if (strchr (" \t\r\n()", nc) != NULL)
{
if (r->state->dotpair_mode > 0)
read_error (r, "invalid dotted pair syntax");
else if (r->state->vector_mode > 0)
read_error (r, "dotted pair not allowed in vector");
else
{
r->state->dotpair_mode = 1;
reader_putc (r, nc);
}
}
else
{
/* Turn it into a decimal point. */
reader_putc (r, nc);
reader_putc (r, '.');
reader_putc (r, '0');
}
break;
/* Whitespace */
case '\n':
r->linecnt++;
print_prompt (r);
case ' ':
case '\t':
case '\r':
break;
/* Parenthesis */
case '(':
push (r);
break;
case ')':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Vectors */
case '[':
push (r);
r->state->vector_mode = 1;
break;
case ']':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (!r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Quoting */
case '\'':
push (r);
add (r, quote);
if (!r->error)
r->state->quote_mode = 1;
break;
/* strings */
case '"':
buf_read (r, "\"");
add (r, parse_str (r));
reader_getc (r); /* Throw away other quote. */
break;
/* numbers and symbols */
default:
buf_append (r, c);
buf_read (r, " \t\r\n()[];");
object_t *o = parse_atom (r);
if (!r->error)
add (r, o);
break;
}
}
if (!r->eof && !r->error)
consume_whitespace (r);
if (r->error)
return err_symbol;
/* Check state */
r->done = 1;
if (stack_height (r) > 1 || r->state->quote_mode
|| r->state->dotpair_mode == 1)
{
read_error (r, "premature end of file");
return err_symbol;
}
if (list_empty (r))
{
obj_destroy (pop (r));
return NIL;
}
object_t *wrap = pop (r);
object_t *sexp = UPREF (CAR (wrap));
obj_destroy (wrap);
return sexp;
}
static void print_prompt (reader_t * r)
{
if (r->interactive && stack_height (r) == 1)
printf ("%s", r->prompt);
}