qse/ase/lsp/read.c

430 lines
9.7 KiB
C
Raw Normal View History

2005-02-04 15:39:11 +00:00
/*
2005-09-24 08:16:02 +00:00
* $Id: read.c,v 1.16 2005-09-24 08:16:02 bacon Exp $
2005-02-04 15:39:11 +00:00
*/
2005-09-18 10:23:19 +00:00
#include <xp/lsp/lsp.h>
2005-06-06 16:04:18 +00:00
#include <xp/lsp/token.h>
2005-04-24 07:48:16 +00:00
#include <xp/bas/assert.h>
#include <xp/bas/ctype.h>
2005-02-04 15:39:11 +00:00
2005-02-04 16:00:37 +00:00
#define IS_SPACE(x) xp_isspace(x)
#define IS_DIGIT(x) xp_isdigit(x)
#define IS_ALPHA(x) xp_isalpha(x)
#define IS_ALNUM(x) xp_isalnum(x)
2005-02-04 15:39:11 +00:00
#define IS_IDENT(c) \
2005-02-04 16:23:34 +00:00
((c) == XP_CHAR('+') || (c) == XP_CHAR('-') || \
(c) == XP_CHAR('*') || (c) == XP_CHAR('/') || \
(c) == XP_CHAR('%') || (c) == XP_CHAR('&') || \
(c) == XP_CHAR('<') || (c) == XP_CHAR('>') || \
(c) == XP_CHAR('=') || (c) == XP_CHAR('_') || \
(c) == XP_CHAR('?'))
2005-02-04 15:39:11 +00:00
2005-09-18 10:23:19 +00:00
#define TOKEN_CLEAR(lsp) xp_lsp_token_clear (&(lsp)->token)
#define TOKEN_TYPE(lsp) (lsp)->token.type
#define TOKEN_IVALUE(lsp) (lsp)->token.ivalue
2005-09-20 11:19:15 +00:00
#define TOKEN_RVALUE(lsp) (lsp)->token.rvalue
2005-09-18 10:23:19 +00:00
#define TOKEN_SVALUE(lsp) (lsp)->token.name.buffer
#define TOKEN_SLENGTH(lsp) (lsp)->token.name.size
2005-02-04 15:39:11 +00:00
#define TOKEN_ADD_CHAR(lsp,ch) \
do { \
2005-09-18 12:20:43 +00:00
if (xp_lsp_token_addc(&(lsp)->token, ch) == -1) { \
2005-09-24 08:16:02 +00:00
lsp->errnum = XP_LSP_ERR_MEMORY; \
2005-02-04 15:39:11 +00:00
return -1; \
} \
} while (0)
2005-09-18 10:23:19 +00:00
#define TOKEN_COMPARE(lsp,str) xp_lsp_token_compare_name (&(lsp)->token, str)
2005-02-04 15:39:11 +00:00
#define TOKEN_END 0
#define TOKEN_INT 1
2005-09-20 11:19:15 +00:00
#define TOKEN_REAL 2
2005-02-04 15:39:11 +00:00
#define TOKEN_STRING 3
#define TOKEN_LPAREN 4
#define TOKEN_RPAREN 5
#define TOKEN_IDENT 6
#define TOKEN_QUOTE 7
#define TOKEN_DOT 8
#define TOKEN_INVALID 50
#define TOKEN_UNTERM_STRING 51
#define NEXT_CHAR(lsp) \
2005-09-18 13:06:43 +00:00
do { if (read_char(lsp) == -1) return -1;} while (0)
2005-02-04 15:39:11 +00:00
#define NEXT_TOKEN(lsp) \
2005-09-18 13:06:43 +00:00
do { if (read_token(lsp) == -1) return XP_NULL; } while (0)
2005-02-04 15:39:11 +00:00
2005-09-18 12:20:43 +00:00
static xp_lsp_obj_t* read_obj (xp_lsp_t* lsp);
static xp_lsp_obj_t* read_list (xp_lsp_t* lsp);
static xp_lsp_obj_t* read_quote (xp_lsp_t* lsp);
2005-09-18 13:06:43 +00:00
static int read_char (xp_lsp_t* lsp);
2005-09-18 12:20:43 +00:00
static int read_token (xp_lsp_t* lsp);
static int read_number (xp_lsp_t* lsp, int negative);
static int read_ident (xp_lsp_t* lsp);
static int read_string (xp_lsp_t* lsp);
2005-09-18 10:23:19 +00:00
xp_lsp_obj_t* xp_lsp_read (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
2005-09-20 08:05:32 +00:00
if (lsp->curc == XP_CHAR_EOF &&
read_char(lsp) == -1) return XP_NULL;
2005-02-04 15:39:11 +00:00
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_NONE;
2005-02-04 15:39:11 +00:00
NEXT_TOKEN (lsp);
if (lsp->mem->locked != XP_NULL) {
2005-09-18 10:23:19 +00:00
xp_lsp_unlock_all (lsp->mem->locked);
2005-02-04 15:39:11 +00:00
lsp->mem->locked = XP_NULL;
}
lsp->mem->locked = read_obj (lsp);
return lsp->mem->locked;
}
2005-09-18 10:23:19 +00:00
static xp_lsp_obj_t* read_obj (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
2005-09-18 10:23:19 +00:00
xp_lsp_obj_t* obj;
2005-02-04 15:39:11 +00:00
switch (TOKEN_TYPE(lsp)) {
case TOKEN_END:
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_END;
2005-02-04 15:39:11 +00:00
return XP_NULL;
case TOKEN_LPAREN:
NEXT_TOKEN (lsp);
return read_list (lsp);
case TOKEN_QUOTE:
NEXT_TOKEN (lsp);
return read_quote (lsp);
case TOKEN_INT:
2005-09-18 10:23:19 +00:00
obj = xp_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp));
2005-09-24 08:16:02 +00:00
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
2005-09-18 10:23:19 +00:00
xp_lsp_lock (obj);
2005-02-04 15:39:11 +00:00
return obj;
2005-09-20 11:19:15 +00:00
case TOKEN_REAL:
obj = xp_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp));
2005-09-24 08:16:02 +00:00
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
2005-09-18 10:23:19 +00:00
xp_lsp_lock (obj);
2005-02-04 15:39:11 +00:00
return obj;
case TOKEN_STRING:
2005-09-20 11:19:15 +00:00
obj = xp_lsp_make_stringx (
2005-02-04 15:39:11 +00:00
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
2005-09-24 08:16:02 +00:00
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
2005-09-18 10:23:19 +00:00
xp_lsp_lock (obj);
2005-02-04 15:39:11 +00:00
return obj;
case TOKEN_IDENT:
2005-02-05 05:18:20 +00:00
xp_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL);
2005-02-04 16:23:34 +00:00
if (TOKEN_COMPARE(lsp,XP_TEXT("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,XP_TEXT("t")) == 0) obj = lsp->mem->t;
2005-02-04 15:39:11 +00:00
else {
2005-09-20 11:19:15 +00:00
obj = xp_lsp_make_symbolx (
2005-02-04 15:39:11 +00:00
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
2005-09-24 08:16:02 +00:00
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
2005-09-18 10:23:19 +00:00
xp_lsp_lock (obj);
2005-02-04 15:39:11 +00:00
}
return obj;
}
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX;
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
2005-09-18 10:23:19 +00:00
static xp_lsp_obj_t* read_list (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
2005-09-18 10:23:19 +00:00
xp_lsp_obj_t* obj;
xp_lsp_obj_cons_t* p, * first = XP_NULL, * prev = XP_NULL;
2005-02-04 15:39:11 +00:00
while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
if (TOKEN_TYPE(lsp) == TOKEN_END) {
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX; // unexpected end of input
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
if (TOKEN_TYPE(lsp) == TOKEN_DOT) {
if (prev == XP_NULL) {
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX; // unexpected .
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
NEXT_TOKEN (lsp);
obj = read_obj (lsp);
if (obj == XP_NULL) {
2005-09-18 10:23:19 +00:00
if (lsp->errnum == XP_LSP_ERR_END) {
2005-02-04 15:39:11 +00:00
//unexpected end of input
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX;
2005-02-04 15:39:11 +00:00
}
return XP_NULL;
}
prev->cdr = obj;
NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX; // ) expected
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
break;
}
obj = read_obj (lsp);
if (obj == XP_NULL) {
2005-09-18 10:23:19 +00:00
if (lsp->errnum == XP_LSP_ERR_END) {
2005-02-04 15:39:11 +00:00
// unexpected end of input
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX;
2005-02-04 15:39:11 +00:00
}
return XP_NULL;
}
2005-09-18 10:23:19 +00:00
p = (xp_lsp_obj_cons_t*)xp_lsp_make_cons (
2005-02-04 15:39:11 +00:00
lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == XP_NULL) {
2005-09-24 08:16:02 +00:00
lsp->errnum = XP_LSP_ERR_MEMORY;
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
2005-09-18 10:23:19 +00:00
xp_lsp_lock ((xp_lsp_obj_t*)p);
2005-02-04 15:39:11 +00:00
if (first == XP_NULL) first = p;
2005-09-18 10:23:19 +00:00
if (prev != XP_NULL) prev->cdr = (xp_lsp_obj_t*)p;
2005-02-04 15:39:11 +00:00
p->car = obj;
prev = p;
NEXT_TOKEN (lsp);
}
2005-09-18 10:23:19 +00:00
return (first == XP_NULL)? lsp->mem->nil: (xp_lsp_obj_t*)first;
2005-02-04 15:39:11 +00:00
}
2005-09-18 10:23:19 +00:00
static xp_lsp_obj_t* read_quote (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
2005-09-18 10:23:19 +00:00
xp_lsp_obj_t* cons, * tmp;
2005-02-04 15:39:11 +00:00
tmp = read_obj (lsp);
if (tmp == XP_NULL) {
2005-09-18 10:23:19 +00:00
if (lsp->errnum == XP_LSP_ERR_END) {
2005-02-04 15:39:11 +00:00
// unexpected end of input
2005-09-18 10:23:19 +00:00
lsp->errnum = XP_LSP_ERR_SYNTAX;
2005-02-04 15:39:11 +00:00
}
return XP_NULL;
}
2005-09-18 10:23:19 +00:00
cons = xp_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil);
2005-02-04 15:39:11 +00:00
if (cons == XP_NULL) {
2005-09-24 08:16:02 +00:00
lsp->errnum = XP_LSP_ERR_MEMORY;
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
2005-09-18 10:23:19 +00:00
xp_lsp_lock (cons);
2005-02-04 15:39:11 +00:00
2005-09-18 10:23:19 +00:00
cons = xp_lsp_make_cons (lsp->mem, lsp->mem->quote, cons);
2005-02-04 15:39:11 +00:00
if (cons == XP_NULL) {
2005-09-24 08:16:02 +00:00
lsp->errnum = XP_LSP_ERR_MEMORY;
2005-02-04 15:39:11 +00:00
return XP_NULL;
}
2005-09-18 10:23:19 +00:00
xp_lsp_lock (cons);
2005-02-04 15:39:11 +00:00
return cons;
}
2005-09-18 13:06:43 +00:00
static int read_char (xp_lsp_t* lsp)
{
xp_ssize_t n;
if (lsp->input_func == XP_NULL) {
lsp->errnum = XP_LSP_ERR_INPUT_NOT_ATTACHED;
return -1;
}
n = lsp->input_func(XP_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1);
if (n == -1) {
lsp->errnum = XP_LSP_ERR_INPUT;
return -1;
}
if (n == 0) lsp->curc = XP_CHAR_EOF;
return 0;
}
2005-09-18 10:23:19 +00:00
static int read_token (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
2005-09-18 10:23:19 +00:00
xp_assert (lsp->input_func != XP_NULL);
2005-02-04 15:39:11 +00:00
TOKEN_CLEAR (lsp);
for (;;) {
// skip white spaces
while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here
2005-02-04 16:23:34 +00:00
if (lsp->curc == XP_CHAR(';')) {
2005-02-04 15:39:11 +00:00
do {
NEXT_CHAR (lsp);
2005-05-30 07:19:09 +00:00
} while (lsp->curc != XP_CHAR('\n') && lsp->curc != XP_CHAR_EOF);
2005-02-04 15:39:11 +00:00
}
else break;
}
2005-05-30 07:19:09 +00:00
if (lsp->curc == XP_CHAR_EOF) {
2005-02-04 15:39:11 +00:00
TOKEN_TYPE(lsp) = TOKEN_END;
return 0;
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('(')) {
2005-02-04 15:39:11 +00:00
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_LPAREN;
NEXT_CHAR (lsp);
return 0;
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR(')')) {
2005-02-04 15:39:11 +00:00
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_RPAREN;
NEXT_CHAR (lsp);
return 0;
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('\'')) {
2005-02-04 15:39:11 +00:00
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_QUOTE;
NEXT_CHAR (lsp);
return 0;
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('.')) {
2005-02-04 15:39:11 +00:00
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_DOT;
NEXT_CHAR (lsp);
return 0;
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('-')) {
2005-02-04 15:39:11 +00:00
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
2005-09-20 08:05:32 +00:00
if (IS_DIGIT(lsp->curc)) {
return read_number (lsp, 1);
}
else if (IS_IDENT(lsp->curc)) {
return read_ident (lsp);
}
else {
TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0;
}
2005-02-04 15:39:11 +00:00
}
else if (IS_DIGIT(lsp->curc)) {
return read_number (lsp, 0);
}
else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) {
return read_ident (lsp);
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('\"')) {
2005-02-04 15:39:11 +00:00
NEXT_CHAR (lsp);
return read_string (lsp);
}
TOKEN_TYPE(lsp) = TOKEN_INVALID;
NEXT_CHAR (lsp); // consume
return 0;
}
2005-09-18 10:23:19 +00:00
static int read_number (xp_lsp_t* lsp, int negative)
2005-02-04 15:39:11 +00:00
{
2005-09-18 10:23:19 +00:00
xp_lsp_int_t ivalue = 0;
2005-09-20 11:19:15 +00:00
xp_lsp_real_t rvalue = 0.;
2005-02-14 14:37:50 +00:00
2005-02-04 15:39:11 +00:00
do {
2005-02-14 14:37:50 +00:00
ivalue = ivalue * 10 + (lsp->curc - XP_CHAR('0'));
2005-02-04 15:39:11 +00:00
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
} while (IS_DIGIT(lsp->curc));
2005-09-20 11:19:15 +00:00
/* TODO: extend parsing floating point number */
if (lsp->curc == XP_CHAR('.')) {
xp_lsp_real_t fraction = 0.1;
2005-02-14 14:37:50 +00:00
2005-09-20 11:19:15 +00:00
NEXT_CHAR (lsp);
rvalue = (xp_lsp_real_t)ivalue;
while (IS_DIGIT(lsp->curc)) {
rvalue += (xp_lsp_real_t)(lsp->curc - XP_CHAR('0')) * fraction;
fraction *= 0.1;
NEXT_CHAR (lsp);
}
2005-02-04 15:39:11 +00:00
2005-09-20 11:19:15 +00:00
TOKEN_RVALUE(lsp) = rvalue;
TOKEN_TYPE(lsp) = TOKEN_REAL;
if (negative) rvalue *= -1;
}
else {
TOKEN_IVALUE(lsp) = ivalue;
TOKEN_TYPE(lsp) = TOKEN_INT;
if (negative) ivalue *= -1;
}
2005-02-04 15:39:11 +00:00
return 0;
}
2005-09-18 10:23:19 +00:00
static int read_ident (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
do {
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
} while (IS_ALNUM(lsp->curc) || IS_IDENT(lsp->curc));
TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0;
}
2005-09-18 10:23:19 +00:00
static int read_string (xp_lsp_t* lsp)
2005-02-04 15:39:11 +00:00
{
int escaped = 0;
2005-02-14 14:37:50 +00:00
xp_cint_t code = 0;
2005-02-04 15:39:11 +00:00
do {
2005-05-30 07:19:09 +00:00
if (lsp->curc == XP_CHAR_EOF) {
2005-02-04 15:39:11 +00:00
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0;
}
// TODO:
if (escaped == 3) {
/* \xNN */
}
else if (escaped == 2) {
/* \000 */
}
else if (escaped == 1) {
/* backslash + character */
2005-02-04 16:23:34 +00:00
if (lsp->curc == XP_CHAR('a'))
lsp->curc = XP_CHAR('\a');
else if (lsp->curc == XP_CHAR('b'))
lsp->curc = XP_CHAR('\b');
else if (lsp->curc == XP_CHAR('f'))
lsp->curc = XP_CHAR('\f');
else if (lsp->curc == XP_CHAR('n'))
lsp->curc = XP_CHAR('\n');
else if (lsp->curc == XP_CHAR('r'))
lsp->curc = XP_CHAR('\r');
else if (lsp->curc == XP_CHAR('t'))
lsp->curc = XP_CHAR('\t');
else if (lsp->curc == XP_CHAR('v'))
lsp->curc = XP_CHAR('\v');
else if (lsp->curc == XP_CHAR('0')) {
2005-02-04 15:39:11 +00:00
escaped = 2;
code = 0;
NEXT_CHAR (lsp);
continue;
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('x')) {
2005-02-04 15:39:11 +00:00
escaped = 3;
code = 0;
NEXT_CHAR (lsp);
continue;
}
}
2005-02-04 16:23:34 +00:00
else if (lsp->curc == XP_CHAR('\\')) {
2005-02-04 15:39:11 +00:00
escaped = 1;
NEXT_CHAR (lsp);
continue;
}
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
2005-02-04 16:23:34 +00:00
} while (lsp->curc != XP_CHAR('\"'));
2005-02-04 15:39:11 +00:00
TOKEN_TYPE(lsp) = TOKEN_STRING;
NEXT_CHAR (lsp);
return 0;
}