From: Tobias Gläßer Date: Wed, 17 Mar 2004 19:35:00 +0000 (+0000) Subject: merged lispreader with Ingo Ruhnke's Construo LispReader and LispWriter wrappers. X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=bc731f8cf00de3312dc3ba76e0f5d6c4a4e6ad9d;p=supertux.git merged lispreader with Ingo Ruhnke's Construo LispReader and LispWriter wrappers. SVN-Revision: 258 --- diff --git a/src/lispreader.cpp b/src/lispreader.cpp index 80be35c00..8f8bbed91 100644 --- a/src/lispreader.cpp +++ b/src/lispreader.cpp @@ -3,6 +3,7 @@ * lispreader.c * * Copyright (C) 1998-2000 Mark Probst + * Copyright (C) 2002 Ingo Ruhnke * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public @@ -54,575 +55,584 @@ static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR }; static void _token_clear (void) { - token_string[0] = '\0'; - token_length = 0; + token_string[0] = '\0'; + token_length = 0; } static void _token_append (char c) { - assert(token_length < MAX_TOKEN_LENGTH); + assert(token_length < MAX_TOKEN_LENGTH); - token_string[token_length++] = c; - token_string[token_length] = '\0'; + token_string[token_length++] = c; + token_string[token_length] = '\0'; } static int _next_char (lisp_stream_t *stream) { - switch (stream->type) + switch (stream->type) { - case LISP_STREAM_FILE : - return getc(stream->v.file); + case LISP_STREAM_FILE : + return getc(stream->v.file); - case LISP_STREAM_STRING : - { - char c = stream->v.string.buf[stream->v.string.pos]; + case LISP_STREAM_STRING : + { + char c = stream->v.string.buf[stream->v.string.pos]; - if (c == 0) - return EOF; + if (c == 0) + return EOF; - ++stream->v.string.pos; + ++stream->v.string.pos; - return c; - } + return c; + } - case LISP_STREAM_ANY: - return stream->v.any.next_char(stream->v.any.data); + case LISP_STREAM_ANY: + return stream->v.any.next_char(stream->v.any.data); } - assert(0); - return EOF; + assert(0); + return EOF; } static void _unget_char (char c, lisp_stream_t *stream) { - switch (stream->type) + switch (stream->type) { - case LISP_STREAM_FILE : - ungetc(c, stream->v.file); - break; - - case LISP_STREAM_STRING : - --stream->v.string.pos; - break; - - case LISP_STREAM_ANY: - stream->v.any.unget_char(c, stream->v.any.data); - break; - - default : - assert(0); + case LISP_STREAM_FILE : + ungetc(c, stream->v.file); + break; + + case LISP_STREAM_STRING : + --stream->v.string.pos; + break; + + case LISP_STREAM_ANY: + stream->v.any.unget_char(c, stream->v.any.data); + break; + + default : + assert(0); } } static int _scan (lisp_stream_t *stream) { - static char *delims = "\"();"; + static char *delims = "\"();"; - int c; + int c; - _token_clear(); + _token_clear(); - do + do { - c = _next_char(stream); - if (c == EOF) - return TOKEN_EOF; - else if (c == ';') /* comment start */ - while (1) - { - c = _next_char(stream); - if (c == EOF) - return TOKEN_EOF; - else if (c == '\n') - break; - } - } while (isspace(c)); - - switch (c) + c = _next_char(stream); + if (c == EOF) + return TOKEN_EOF; + else if (c == ';') /* comment start */ + while (1) + { + c = _next_char(stream); + if (c == EOF) + return TOKEN_EOF; + else if (c == '\n') + break; + } + } + while (isspace(c)); + + switch (c) { - case '(' : - return TOKEN_OPEN_PAREN; - - case ')' : - return TOKEN_CLOSE_PAREN; - - case '"' : - while (1) - { - c = _next_char(stream); - if (c == EOF) - return TOKEN_ERROR; - if (c == '"') - break; - if (c == '\\') - { - c = _next_char(stream); - - switch (c) - { - case EOF : - return TOKEN_ERROR; - - case 'n' : - c = '\n'; - break; - - case 't' : - c = '\t'; - break; - } - } - - _token_append(c); - } - return TOKEN_STRING; - - case '#' : - c = _next_char(stream); - if (c == EOF) - return TOKEN_ERROR; - - switch (c) - { - case 't' : - return TOKEN_TRUE; - - case 'f' : - return TOKEN_FALSE; - - case '?' : - c = _next_char(stream); - if (c == EOF) - return TOKEN_ERROR; - - if (c == '(') - return TOKEN_PATTERN_OPEN_PAREN; - else - return TOKEN_ERROR; - } - return TOKEN_ERROR; - - default : - if (isdigit(c) || c == '-') - { - int have_nondigits = 0; - int have_digits = 0; - int have_floating_point = 0; - - do - { - if (isdigit(c)) - have_digits = 1; - else if (c == '.') - have_floating_point++; - _token_append(c); - - c = _next_char(stream); - - if (c != EOF && !isdigit(c) && !isspace(c) && c != '.' && !strchr(delims, c)) - have_nondigits = 1; - } while (c != EOF && !isspace(c) && !strchr(delims, c)); - - if (c != EOF) - _unget_char(c, stream); - - if (have_nondigits || !have_digits || have_floating_point > 1) - return TOKEN_SYMBOL; - else if (have_floating_point == 1) - return TOKEN_REAL; - else - return TOKEN_INTEGER; - } - else - { - if (c == '.') - { - c = _next_char(stream); - if (c != EOF && !isspace(c) && !strchr(delims, c)) - _token_append('.'); - else - { - _unget_char(c, stream); - return TOKEN_DOT; - } - } - do - { - _token_append(c); - c = _next_char(stream); - } while (c != EOF && !isspace(c) && !strchr(delims, c)); - if (c != EOF) - _unget_char(c, stream); - - return TOKEN_SYMBOL; - } + case '(' : + return TOKEN_OPEN_PAREN; + + case ')' : + return TOKEN_CLOSE_PAREN; + + case '"' : + while (1) + { + c = _next_char(stream); + if (c == EOF) + return TOKEN_ERROR; + if (c == '"') + break; + if (c == '\\') + { + c = _next_char(stream); + + switch (c) + { + case EOF : + return TOKEN_ERROR; + + case 'n' : + c = '\n'; + break; + + case 't' : + c = '\t'; + break; + } + } + + _token_append(c); + } + return TOKEN_STRING; + + case '#' : + c = _next_char(stream); + if (c == EOF) + return TOKEN_ERROR; + + switch (c) + { + case 't' : + return TOKEN_TRUE; + + case 'f' : + return TOKEN_FALSE; + + case '?' : + c = _next_char(stream); + if (c == EOF) + return TOKEN_ERROR; + + if (c == '(') + return TOKEN_PATTERN_OPEN_PAREN; + else + return TOKEN_ERROR; + } + return TOKEN_ERROR; + + default : + if (isdigit(c) || c == '-') + { + int have_nondigits = 0; + int have_digits = 0; + int have_floating_point = 0; + + do + { + if (isdigit(c)) + have_digits = 1; + else if (c == '.') + have_floating_point++; + _token_append(c); + + c = _next_char(stream); + + if (c != EOF && !isdigit(c) && !isspace(c) && c != '.' && !strchr(delims, c)) + have_nondigits = 1; + } + while (c != EOF && !isspace(c) && !strchr(delims, c)); + + if (c != EOF) + _unget_char(c, stream); + + if (have_nondigits || !have_digits || have_floating_point > 1) + return TOKEN_SYMBOL; + else if (have_floating_point == 1) + return TOKEN_REAL; + else + return TOKEN_INTEGER; + } + else + { + if (c == '.') + { + c = _next_char(stream); + if (c != EOF && !isspace(c) && !strchr(delims, c)) + _token_append('.'); + else + { + _unget_char(c, stream); + return TOKEN_DOT; + } + } + do + { + _token_append(c); + c = _next_char(stream); + } + while (c != EOF && !isspace(c) && !strchr(delims, c)); + if (c != EOF) + _unget_char(c, stream); + + return TOKEN_SYMBOL; + } } - assert(0); - return TOKEN_ERROR; + assert(0); + return TOKEN_ERROR; } static lisp_object_t* lisp_object_alloc (int type) { - lisp_object_t *obj = (lisp_object_t*)malloc(sizeof(lisp_object_t)); + lisp_object_t *obj = (lisp_object_t*)malloc(sizeof(lisp_object_t)); - obj->type = type; + obj->type = type; - return obj; + return obj; } lisp_stream_t* lisp_stream_init_file (lisp_stream_t *stream, FILE *file) { - stream->type = LISP_STREAM_FILE; - stream->v.file = file; + stream->type = LISP_STREAM_FILE; + stream->v.file = file; - return stream; + return stream; } lisp_stream_t* lisp_stream_init_string (lisp_stream_t *stream, char *buf) { - stream->type = LISP_STREAM_STRING; - stream->v.string.buf = buf; - stream->v.string.pos = 0; + stream->type = LISP_STREAM_STRING; + stream->v.string.buf = buf; + stream->v.string.pos = 0; - return stream; + return stream; } -lisp_stream_t* -lisp_stream_init_any (lisp_stream_t *stream, void *data, - int (*next_char) (void *data), - void (*unget_char) (char c, void *data)) +lisp_stream_t* +lisp_stream_init_any (lisp_stream_t *stream, void *data, + int (*next_char) (void *data), + void (*unget_char) (char c, void *data)) { - assert(next_char != 0 && unget_char != 0); - - stream->type = LISP_STREAM_ANY; - stream->v.any.data = data; - stream->v.any.next_char= next_char; - stream->v.any.unget_char = unget_char; + assert(next_char != 0 && unget_char != 0); - return stream; + stream->type = LISP_STREAM_ANY; + stream->v.any.data = data; + stream->v.any.next_char= next_char; + stream->v.any.unget_char = unget_char; + + return stream; } lisp_object_t* lisp_make_integer (int value) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_INTEGER); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_INTEGER); - obj->v.integer = value; + obj->v.integer = value; - return obj; + return obj; } lisp_object_t* lisp_make_real (float value) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_REAL); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_REAL); - obj->v.real = value; + obj->v.real = value; - return obj; + return obj; } lisp_object_t* lisp_make_symbol (const char *value) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_SYMBOL); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_SYMBOL); - obj->v.string = strdup(value); + obj->v.string = strdup(value); - return obj; + return obj; } lisp_object_t* lisp_make_string (const char *value) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_STRING); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_STRING); - obj->v.string = strdup(value); + obj->v.string = strdup(value); - return obj; + return obj; } lisp_object_t* lisp_make_cons (lisp_object_t *car, lisp_object_t *cdr) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_CONS); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_CONS); - obj->v.cons.car = car; - obj->v.cons.cdr = cdr; + obj->v.cons.car = car; + obj->v.cons.cdr = cdr; - return obj; + return obj; } lisp_object_t* lisp_make_boolean (int value) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_BOOLEAN); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_BOOLEAN); - obj->v.integer = value ? 1 : 0; + obj->v.integer = value ? 1 : 0; - return obj; + return obj; } static lisp_object_t* lisp_make_pattern_cons (lisp_object_t *car, lisp_object_t *cdr) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_CONS); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_CONS); - obj->v.cons.car = car; - obj->v.cons.cdr = cdr; + obj->v.cons.car = car; + obj->v.cons.cdr = cdr; - return obj; + return obj; } static lisp_object_t* lisp_make_pattern_var (int type, int index, lisp_object_t *sub) { - lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_VAR); + lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_VAR); - obj->v.pattern.type = type; - obj->v.pattern.index = index; - obj->v.pattern.sub = sub; + obj->v.pattern.type = type; + obj->v.pattern.index = index; + obj->v.pattern.sub = sub; - return obj; + return obj; } lisp_object_t* lisp_read (lisp_stream_t *in) { - int token = _scan(in); - lisp_object_t *obj = lisp_nil(); + int token = _scan(in); + lisp_object_t *obj = lisp_nil(); - if (token == TOKEN_EOF) - return &end_marker; + if (token == TOKEN_EOF) + return &end_marker; - switch (token) + switch (token) { - case TOKEN_ERROR : - return &error_object; - - case TOKEN_EOF : - return &end_marker; - - case TOKEN_OPEN_PAREN : - case TOKEN_PATTERN_OPEN_PAREN : - { - lisp_object_t *last = lisp_nil(), *car; - - do - { - car = lisp_read(in); - if (car == &error_object || car == &end_marker) - { - lisp_free(obj); - return &error_object; - } - else if (car == &dot_marker) - { - if (lisp_nil_p(last)) - { - lisp_free(obj); - return &error_object; - } - - car = lisp_read(in); - if (car == &error_object || car == &end_marker) - { - lisp_free(obj); - return car; - } - else - { - last->v.cons.cdr = car; - - if (_scan(in) != TOKEN_CLOSE_PAREN) - { - lisp_free(obj); - return &error_object; - } - - car = &close_paren_marker; - } - } - else if (car != &close_paren_marker) - { - if (lisp_nil_p(last)) - obj = last = (token == TOKEN_OPEN_PAREN ? lisp_make_cons(car, lisp_nil()) : lisp_make_pattern_cons(car, lisp_nil())); - else - last = last->v.cons.cdr = lisp_make_cons(car, lisp_nil()); - } - } while (car != &close_paren_marker); - } - return obj; - - case TOKEN_CLOSE_PAREN : - return &close_paren_marker; - - case TOKEN_SYMBOL : - return lisp_make_symbol(token_string); - - case TOKEN_STRING : - return lisp_make_string(token_string); - - case TOKEN_INTEGER : - return lisp_make_integer(atoi(token_string)); - - case TOKEN_REAL : - return lisp_make_real((float)atof(token_string)); - - case TOKEN_DOT : - return &dot_marker; - - case TOKEN_TRUE : - return lisp_make_boolean(1); - - case TOKEN_FALSE : - return lisp_make_boolean(0); + case TOKEN_ERROR : + return &error_object; + + case TOKEN_EOF : + return &end_marker; + + case TOKEN_OPEN_PAREN : + case TOKEN_PATTERN_OPEN_PAREN : + { + lisp_object_t *last = lisp_nil(), *car; + + do + { + car = lisp_read(in); + if (car == &error_object || car == &end_marker) + { + lisp_free(obj); + return &error_object; + } + else if (car == &dot_marker) + { + if (lisp_nil_p(last)) + { + lisp_free(obj); + return &error_object; + } + + car = lisp_read(in); + if (car == &error_object || car == &end_marker) + { + lisp_free(obj); + return car; + } + else + { + last->v.cons.cdr = car; + + if (_scan(in) != TOKEN_CLOSE_PAREN) + { + lisp_free(obj); + return &error_object; + } + + car = &close_paren_marker; + } + } + else if (car != &close_paren_marker) + { + if (lisp_nil_p(last)) + obj = last = (token == TOKEN_OPEN_PAREN ? lisp_make_cons(car, lisp_nil()) : lisp_make_pattern_cons(car, lisp_nil())); + else + last = last->v.cons.cdr = lisp_make_cons(car, lisp_nil()); + } + } + while (car != &close_paren_marker); + } + return obj; + + case TOKEN_CLOSE_PAREN : + return &close_paren_marker; + + case TOKEN_SYMBOL : + return lisp_make_symbol(token_string); + + case TOKEN_STRING : + return lisp_make_string(token_string); + + case TOKEN_INTEGER : + return lisp_make_integer(atoi(token_string)); + + case TOKEN_REAL : + return lisp_make_real((float)atof(token_string)); + + case TOKEN_DOT : + return &dot_marker; + + case TOKEN_TRUE : + return lisp_make_boolean(1); + + case TOKEN_FALSE : + return lisp_make_boolean(0); } - assert(0); - return &error_object; + assert(0); + return &error_object; } void lisp_free (lisp_object_t *obj) { - if (obj == 0) - return; + if (obj == 0) + return; - switch (obj->type) + switch (obj->type) { - case LISP_TYPE_INTERNAL : - case LISP_TYPE_PARSE_ERROR : - case LISP_TYPE_EOF : - return; - - case LISP_TYPE_SYMBOL : - case LISP_TYPE_STRING : - free(obj->v.string); - break; - - case LISP_TYPE_CONS : - case LISP_TYPE_PATTERN_CONS : - lisp_free(obj->v.cons.car); - lisp_free(obj->v.cons.cdr); - break; - - case LISP_TYPE_PATTERN_VAR : - lisp_free(obj->v.pattern.sub); - break; + case LISP_TYPE_INTERNAL : + case LISP_TYPE_PARSE_ERROR : + case LISP_TYPE_EOF : + return; + + case LISP_TYPE_SYMBOL : + case LISP_TYPE_STRING : + free(obj->v.string); + break; + + case LISP_TYPE_CONS : + case LISP_TYPE_PATTERN_CONS : + lisp_free(obj->v.cons.car); + lisp_free(obj->v.cons.cdr); + break; + + case LISP_TYPE_PATTERN_VAR : + lisp_free(obj->v.pattern.sub); + break; } - free(obj); + free(obj); } lisp_object_t* lisp_read_from_string (const char *buf) { - lisp_stream_t stream; + lisp_stream_t stream; - lisp_stream_init_string(&stream, (char*)buf); - return lisp_read(&stream); + lisp_stream_init_string(&stream, (char*)buf); + return lisp_read(&stream); } static int _compile_pattern (lisp_object_t **obj, int *index) { - if (*obj == 0) - return 1; + if (*obj == 0) + return 1; - switch (lisp_type(*obj)) + switch (lisp_type(*obj)) { - case LISP_TYPE_PATTERN_CONS : - { - struct { char *name; int type; } types[] = - { - { "any", LISP_PATTERN_ANY }, - { "symbol", LISP_PATTERN_SYMBOL }, - { "string", LISP_PATTERN_STRING }, - { "integer", LISP_PATTERN_INTEGER }, - { "real", LISP_PATTERN_REAL }, - { "boolean", LISP_PATTERN_BOOLEAN }, - { "list", LISP_PATTERN_LIST }, - { "or", LISP_PATTERN_OR }, - { 0, 0 } - }; - char *type_name; - int type; - int i; - lisp_object_t *pattern; - - if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL) - return 0; - - type_name = lisp_symbol(lisp_car(*obj)); - for (i = 0; types[i].name != 0; ++i) - { - if (strcmp(types[i].name, type_name) == 0) - { - type = types[i].type; - break; - } - } - - if (types[i].name == 0) - return 0; - - if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0) - return 0; - - pattern = lisp_make_pattern_var(type, (*index)++, lisp_nil()); - - if (type == LISP_PATTERN_OR) - { - lisp_object_t *cdr = lisp_cdr(*obj); - - if (!_compile_pattern(&cdr, index)) - { - lisp_free(pattern); - return 0; - } - - pattern->v.pattern.sub = cdr; - - (*obj)->v.cons.cdr = lisp_nil(); - } - - lisp_free(*obj); - - *obj = pattern; - } - break; - - case LISP_TYPE_CONS : - if (!_compile_pattern(&(*obj)->v.cons.car, index)) - return 0; - if (!_compile_pattern(&(*obj)->v.cons.cdr, index)) - return 0; - break; + case LISP_TYPE_PATTERN_CONS : + { + struct + { + char *name; + int type; + } + types[] = + { + { "any", LISP_PATTERN_ANY }, + { "symbol", LISP_PATTERN_SYMBOL }, + { "string", LISP_PATTERN_STRING }, + { "integer", LISP_PATTERN_INTEGER }, + { "real", LISP_PATTERN_REAL }, + { "boolean", LISP_PATTERN_BOOLEAN }, + { "list", LISP_PATTERN_LIST }, + { "or", LISP_PATTERN_OR }, + { 0, 0 } + }; + char *type_name; + int type; + int i; + lisp_object_t *pattern; + + if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL) + return 0; + + type_name = lisp_symbol(lisp_car(*obj)); + for (i = 0; types[i].name != 0; ++i) + { + if (strcmp(types[i].name, type_name) == 0) + { + type = types[i].type; + break; + } + } + + if (types[i].name == 0) + return 0; + + if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0) + return 0; + + pattern = lisp_make_pattern_var(type, (*index)++, lisp_nil()); + + if (type == LISP_PATTERN_OR) + { + lisp_object_t *cdr = lisp_cdr(*obj); + + if (!_compile_pattern(&cdr, index)) + { + lisp_free(pattern); + return 0; + } + + pattern->v.pattern.sub = cdr; + + (*obj)->v.cons.cdr = lisp_nil(); + } + + lisp_free(*obj); + + *obj = pattern; + } + break; + + case LISP_TYPE_CONS : + if (!_compile_pattern(&(*obj)->v.cons.car, index)) + return 0; + if (!_compile_pattern(&(*obj)->v.cons.cdr, index)) + return 0; + break; } - return 1; + return 1; } int lisp_compile_pattern (lisp_object_t **obj, int *num_subs) { - int index = 0; - int result; + int index = 0; + int result; - result = _compile_pattern(obj, &index); + result = _compile_pattern(obj, &index); - if (result && num_subs != 0) - *num_subs = index; + if (result && num_subs != 0) + *num_subs = index; - return result; + return result; } static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars); @@ -630,356 +640,512 @@ static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_obje static int _match_pattern_var (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars) { - assert(lisp_type(pattern) == LISP_TYPE_PATTERN_VAR); + assert(lisp_type(pattern) == LISP_TYPE_PATTERN_VAR); - switch (pattern->v.pattern.type) + switch (pattern->v.pattern.type) { - case LISP_PATTERN_ANY : - break; - - case LISP_PATTERN_SYMBOL : - if (obj == 0 || lisp_type(obj) != LISP_TYPE_SYMBOL) - return 0; - break; - - case LISP_PATTERN_STRING : - if (obj == 0 || lisp_type(obj) != LISP_TYPE_STRING) - return 0; - break; - - case LISP_PATTERN_INTEGER : - if (obj == 0 || lisp_type(obj) != LISP_TYPE_INTEGER) - return 0; - break; - - case LISP_PATTERN_REAL : - if (obj == 0 || lisp_type(obj) != LISP_TYPE_REAL) - return 0; - break; - - case LISP_PATTERN_BOOLEAN : - if (obj == 0 || lisp_type(obj) != LISP_TYPE_BOOLEAN) - return 0; - break; - - case LISP_PATTERN_LIST : - if (obj == 0 || lisp_type(obj) != LISP_TYPE_CONS) - return 0; - break; - - case LISP_PATTERN_OR : - { - lisp_object_t *sub; - int matched = 0; - - for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub)) - { - assert(lisp_type(sub) == LISP_TYPE_CONS); - - if (_match_pattern(lisp_car(sub), obj, vars)) - matched = 1; - } - - if (!matched) - return 0; - } - break; - - default : - assert(0); + case LISP_PATTERN_ANY : + break; + + case LISP_PATTERN_SYMBOL : + if (obj == 0 || lisp_type(obj) != LISP_TYPE_SYMBOL) + return 0; + break; + + case LISP_PATTERN_STRING : + if (obj == 0 || lisp_type(obj) != LISP_TYPE_STRING) + return 0; + break; + + case LISP_PATTERN_INTEGER : + if (obj == 0 || lisp_type(obj) != LISP_TYPE_INTEGER) + return 0; + break; + + case LISP_PATTERN_REAL : + if (obj == 0 || lisp_type(obj) != LISP_TYPE_REAL) + return 0; + break; + + case LISP_PATTERN_BOOLEAN : + if (obj == 0 || lisp_type(obj) != LISP_TYPE_BOOLEAN) + return 0; + break; + + case LISP_PATTERN_LIST : + if (obj == 0 || lisp_type(obj) != LISP_TYPE_CONS) + return 0; + break; + + case LISP_PATTERN_OR : + { + lisp_object_t *sub; + int matched = 0; + + for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub)) + { + assert(lisp_type(sub) == LISP_TYPE_CONS); + + if (_match_pattern(lisp_car(sub), obj, vars)) + matched = 1; + } + + if (!matched) + return 0; + } + break; + + default : + assert(0); } - if (vars != 0) - vars[pattern->v.pattern.index] = obj; + if (vars != 0) + vars[pattern->v.pattern.index] = obj; - return 1; + return 1; } static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars) { - if (pattern == 0) - return obj == 0; + if (pattern == 0) + return obj == 0; - if (obj == 0) - return 0; + if (obj == 0) + return 0; - if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR) - return _match_pattern_var(pattern, obj, vars); + if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR) + return _match_pattern_var(pattern, obj, vars); - if (lisp_type(pattern) != lisp_type(obj)) - return 0; + if (lisp_type(pattern) != lisp_type(obj)) + return 0; - switch (lisp_type(pattern)) + switch (lisp_type(pattern)) { - case LISP_TYPE_SYMBOL : - return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0; + case LISP_TYPE_SYMBOL : + return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0; - case LISP_TYPE_STRING : - return strcmp(lisp_string(pattern), lisp_string(obj)) == 0; + case LISP_TYPE_STRING : + return strcmp(lisp_string(pattern), lisp_string(obj)) == 0; - case LISP_TYPE_INTEGER : - return lisp_integer(pattern) == lisp_integer(obj); + case LISP_TYPE_INTEGER : + return lisp_integer(pattern) == lisp_integer(obj); - case LISP_TYPE_REAL : - return lisp_real(pattern) == lisp_real(obj); + case LISP_TYPE_REAL : + return lisp_real(pattern) == lisp_real(obj); - case LISP_TYPE_CONS : - { - int result1, result2; + case LISP_TYPE_CONS : + { + int result1, result2; - result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars); - result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars); + result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars); + result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars); - return result1 && result2; - } - break; + return result1 && result2; + } + break; - default : - assert(0); + default : + assert(0); } - return 0; + return 0; } int lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs) { - int i; + int i; - if (vars != 0) - for (i = 0; i < num_subs; ++i) - vars[i] = &error_object; + if (vars != 0) + for (i = 0; i < num_subs; ++i) + vars[i] = &error_object; - return _match_pattern(pattern, obj, vars); + return _match_pattern(pattern, obj, vars); } int lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars) { - lisp_object_t *pattern; - int result; - int num_subs; + lisp_object_t *pattern; + int result; + int num_subs; - pattern = lisp_read_from_string(pattern_string); + pattern = lisp_read_from_string(pattern_string); - if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF - || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR)) - return 0; + if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF + || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR)) + return 0; - if (!lisp_compile_pattern(&pattern, &num_subs)) + if (!lisp_compile_pattern(&pattern, &num_subs)) { - lisp_free(pattern); - return 0; + lisp_free(pattern); + return 0; } - result = lisp_match_pattern(pattern, obj, vars, num_subs); + result = lisp_match_pattern(pattern, obj, vars, num_subs); - lisp_free(pattern); + lisp_free(pattern); - return result; + return result; } int lisp_type (lisp_object_t *obj) { - if (obj == 0) - return LISP_TYPE_NIL; - return obj->type; + if (obj == 0) + return LISP_TYPE_NIL; + return obj->type; } int lisp_integer (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_INTEGER); + assert(obj->type == LISP_TYPE_INTEGER); - return obj->v.integer; + return obj->v.integer; } char* lisp_symbol (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_SYMBOL); + assert(obj->type == LISP_TYPE_SYMBOL); - return obj->v.string; + return obj->v.string; } char* lisp_string (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_STRING); + assert(obj->type == LISP_TYPE_STRING); - return obj->v.string; + return obj->v.string; } int lisp_boolean (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_BOOLEAN); + assert(obj->type == LISP_TYPE_BOOLEAN); - return obj->v.integer; + return obj->v.integer; } float lisp_real (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER); + assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER); - if (obj->type == LISP_TYPE_INTEGER) - return obj->v.integer; - return obj->v.real; + if (obj->type == LISP_TYPE_INTEGER) + return obj->v.integer; + return obj->v.real; } - + lisp_object_t* lisp_car (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); - return obj->v.cons.car; + return obj->v.cons.car; } lisp_object_t* lisp_cdr (lisp_object_t *obj) { - assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); - return obj->v.cons.cdr; + return obj->v.cons.cdr; } lisp_object_t* lisp_cxr (lisp_object_t *obj, const char *x) { - int i; + int i; - for (i = strlen(x) - 1; i >= 0; --i) - if (x[i] == 'a') - obj = lisp_car(obj); - else if (x[i] == 'd') - obj = lisp_cdr(obj); - else - assert(0); + for (i = strlen(x) - 1; i >= 0; --i) + if (x[i] == 'a') + obj = lisp_car(obj); + else if (x[i] == 'd') + obj = lisp_cdr(obj); + else + assert(0); - return obj; + return obj; } int lisp_list_length (lisp_object_t *obj) { - int length = 0; + int length = 0; - while (obj != 0) + while (obj != 0) { - assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); - ++length; - obj = obj->v.cons.cdr; + ++length; + obj = obj->v.cons.cdr; } - return length; + return length; } lisp_object_t* lisp_list_nth_cdr (lisp_object_t *obj, int index) { - while (index > 0) + while (index > 0) { - assert(obj != 0); - assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + assert(obj != 0); + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); - --index; - obj = obj->v.cons.cdr; + --index; + obj = obj->v.cons.cdr; } - return obj; + return obj; } lisp_object_t* lisp_list_nth (lisp_object_t *obj, int index) { - obj = lisp_list_nth_cdr(obj, index); + obj = lisp_list_nth_cdr(obj, index); - assert(obj != 0); + assert(obj != 0); - return obj->v.cons.car; + return obj->v.cons.car; } void lisp_dump (lisp_object_t *obj, FILE *out) { - if (obj == 0) + if (obj == 0) + { + fprintf(out, "()"); + return; + } + + switch (lisp_type(obj)) + { + case LISP_TYPE_EOF : + fputs("#", out); + break; + + case LISP_TYPE_PARSE_ERROR : + fputs("#", out); + break; + + case LISP_TYPE_INTEGER : + fprintf(out, "%d", lisp_integer(obj)); + break; + + case LISP_TYPE_REAL : + fprintf(out, "%f", lisp_real(obj)); + break; + + case LISP_TYPE_SYMBOL : + fputs(lisp_symbol(obj), out); + break; + + case LISP_TYPE_STRING : + { + char *p; + + fputc('"', out); + for (p = lisp_string(obj); *p != 0; ++p) + { + if (*p == '"' || *p == '\\') + fputc('\\', out); + fputc(*p, out); + } + fputc('"', out); + } + break; + + case LISP_TYPE_CONS : + case LISP_TYPE_PATTERN_CONS : + fputs(lisp_type(obj) == LISP_TYPE_CONS ? "(" : "#?(", out); + while (obj != 0) + { + lisp_dump(lisp_car(obj), out); + obj = lisp_cdr(obj); + if (obj != 0) + { + if (lisp_type(obj) != LISP_TYPE_CONS + && lisp_type(obj) != LISP_TYPE_PATTERN_CONS) + { + fputs(" . ", out); + lisp_dump(obj, out); + break; + } + else + fputc(' ', out); + } + } + fputc(')', out); + break; + + case LISP_TYPE_BOOLEAN : + if (lisp_boolean(obj)) + fputs("#t", out); + else + fputs("#f", out); + break; + + default : + assert(0); + } +} + +using namespace std; + +LispReader::LispReader (lisp_object_t* l) + : lst (l) +{ + //std::cout << "LispReader: " << std::flush; + //lisp_dump(lst, stdout); + //std::cout << std::endl; +} + +lisp_object_t* +LispReader::search_for(const char* name) +{ + //std::cout << "LispReader::search_for(" << name << ")" << std::endl; + lisp_object_t* cursor = lst; + + while(!lisp_nil_p(cursor)) + { + lisp_object_t* cur = lisp_car(cursor); + + if (!lisp_cons_p(cur) || !lisp_symbol_p (lisp_car(cur))) + { + lisp_dump(cur, stdout); + //throw ConstruoError (std::string("LispReader: Read error in search_for ") + name); + printf("LispReader: Read error in search\n"); + } + else + { + if (strcmp(lisp_symbol(lisp_car(cur)), name) == 0) + { + return lisp_cdr(cur); + } + } + + cursor = lisp_cdr (cursor); + } + return 0; +} + +bool +LispReader::read_int (const char* name, int* i) +{ + lisp_object_t* obj = search_for (name); + if (obj) + { + *i = lisp_integer(lisp_car(obj)); + return true; + } + return false; +} + +bool +LispReader::read_float (const char* name, float* f) +{ + lisp_object_t* obj = search_for (name); + if (obj) + { + *f = lisp_real(lisp_car(obj)); + return true; + } + return false; +} + +bool +LispReader::read_bool (const char* name, bool* b) +{ + lisp_object_t* obj = search_for (name); + if (obj) { - fprintf(out, "()"); - return; + *b = lisp_boolean(lisp_car(obj)); + return true; } + return false; +} + +LispWriter::LispWriter (const char* name) +{ + lisp_objs.push_back(lisp_make_symbol (name)); +} + +void +LispWriter::append (lisp_object_t* obj) +{ + lisp_objs.push_back(obj); +} + +lisp_object_t* +LispWriter::make_list3 (lisp_object_t* a, lisp_object_t* b, lisp_object_t* c) +{ + return lisp_make_cons (a, lisp_make_cons(b, lisp_make_cons(c, lisp_nil()))); +} + +lisp_object_t* +LispWriter::make_list2 (lisp_object_t* a, lisp_object_t* b) +{ + return lisp_make_cons (a, lisp_make_cons(b, lisp_nil())); +} + +void +LispWriter::write_float (const char* name, float f) +{ + append(make_list2 (lisp_make_symbol (name), + lisp_make_real(f))); +} + +void +LispWriter::write_int (const char* name, int i) +{ + append(make_list2 (lisp_make_symbol (name), + lisp_make_integer(i))); +} + +void +LispWriter::write_string (const char* name, const char* str) +{ + append(make_list2 (lisp_make_symbol (name), + lisp_make_string(str))); +} - switch (lisp_type(obj)) +void +LispWriter::write_symbol (const char* name, const char* symname) +{ + append(make_list2 (lisp_make_symbol (name), + lisp_make_symbol(symname))); +} + +void +LispWriter::write_lisp_obj(const char* name, lisp_object_t* lst) +{ + append(make_list2 (lisp_make_symbol (name), + lst)); +} + +void +LispWriter::write_boolean (const char* name, bool b) +{ + append(make_list2 (lisp_make_symbol (name), + lisp_make_boolean(b))); +} + +lisp_object_t* +LispWriter::create_lisp () +{ + lisp_object_t* lisp_obj = lisp_nil(); + + for(std::vector::reverse_iterator i = lisp_objs.rbegin (); + i != lisp_objs.rend (); ++i) { - case LISP_TYPE_EOF : - fputs("#", out); - break; - - case LISP_TYPE_PARSE_ERROR : - fputs("#", out); - break; - - case LISP_TYPE_INTEGER : - fprintf(out, "%d", lisp_integer(obj)); - break; - - case LISP_TYPE_REAL : - fprintf(out, "%f", lisp_real(obj)); - break; - - case LISP_TYPE_SYMBOL : - fputs(lisp_symbol(obj), out); - break; - - case LISP_TYPE_STRING : - { - char *p; - - fputc('"', out); - for (p = lisp_string(obj); *p != 0; ++p) - { - if (*p == '"' || *p == '\\') - fputc('\\', out); - fputc(*p, out); - } - fputc('"', out); - } - break; - - case LISP_TYPE_CONS : - case LISP_TYPE_PATTERN_CONS : - fputs(lisp_type(obj) == LISP_TYPE_CONS ? "(" : "#?(", out); - while (obj != 0) - { - lisp_dump(lisp_car(obj), out); - obj = lisp_cdr(obj); - if (obj != 0) - { - if (lisp_type(obj) != LISP_TYPE_CONS - && lisp_type(obj) != LISP_TYPE_PATTERN_CONS) - { - fputs(" . ", out); - lisp_dump(obj, out); - break; - } - else - fputc(' ', out); - } - } - fputc(')', out); - break; - - case LISP_TYPE_BOOLEAN : - if (lisp_boolean(obj)) - fputs("#t", out); - else - fputs("#f", out); - break; - - default : - assert(0); + lisp_obj = lisp_make_cons (*i, lisp_obj); } + lisp_objs.clear(); + + return lisp_obj; } + diff --git a/src/lispreader.h b/src/lispreader.h index eb8c0574c..d42741468 100644 --- a/src/lispreader.h +++ b/src/lispreader.h @@ -3,6 +3,7 @@ * lispreader.h * * Copyright (C) 1998-2000 Mark Probst + * Copyright (C) 2002 Ingo Ruhnke * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public @@ -24,6 +25,7 @@ #define __LISPREADER_H__ #include +#include #define LISP_STREAM_FILE 1 #define LISP_STREAM_STRING 2 @@ -52,57 +54,62 @@ #define LISP_PATTERN_OR 8 typedef struct -{ + { int type; union - { - FILE *file; - struct - { - char *buf; - int pos; - } string; + { + FILE *file; struct - { - void *data; - int (*next_char) (void *data); - void (*unget_char) (char c, void *data); - } any; - } v; -} lisp_stream_t; + { + char *buf; + int pos; + } + string; + struct + { + void *data; + int (*next_char) (void *data); + void (*unget_char) (char c, void *data); + } + any; + } v; + } +lisp_stream_t; typedef struct _lisp_object_t lisp_object_t; struct _lisp_object_t -{ + { int type; union - { - struct - { - struct _lisp_object_t *car; - struct _lisp_object_t *cdr; - } cons; - - char *string; - int integer; - float real; - - struct - { - int type; - int index; - struct _lisp_object_t *sub; - } pattern; - } v; -}; + { + struct + { + struct _lisp_object_t *car; + struct _lisp_object_t *cdr; + } + cons; + + char *string; + int integer; + float real; + + struct + { + int type; + int index; + struct _lisp_object_t *sub; + } + pattern; + } v; + }; lisp_stream_t* lisp_stream_init_file (lisp_stream_t *stream, FILE *file); lisp_stream_t* lisp_stream_init_string (lisp_stream_t *stream, char *buf); -lisp_stream_t* lisp_stream_init_any (lisp_stream_t *stream, void *data, - int (*next_char) (void *data), - void (*unget_char) (char c, void *data)); +lisp_stream_t* lisp_stream_init_any (lisp_stream_t *stream, void *data, + int (*next_char) (void *data), + void (*unget_char) (char c, void *data)); lisp_object_t* lisp_read (lisp_stream_t *in); void lisp_free (lisp_object_t *obj); @@ -147,4 +154,42 @@ void lisp_dump (lisp_object_t *obj, FILE *out); #define lisp_cons_p(obj) (lisp_type((obj)) == LISP_TYPE_CONS) #define lisp_boolean_p(obj) (lisp_type((obj)) == LISP_TYPE_BOOLEAN) +/** */ +class LispReader + { + private: + lisp_object_t* lst; + + lisp_object_t* search_for(const char* name); + public: + /** cur == ((pos 1 2 3) (id 12 3 4)...) */ + LispReader (lisp_object_t* l); + + bool read_int (const char* name, int* i); + bool read_float (const char* name, float* f); + bool read_bool (const char* name, bool* b); + }; + +/** */ +class LispWriter + { + private: + std::vector lisp_objs; + + void append (lisp_object_t* obj); + lisp_object_t* make_list3 (lisp_object_t*, lisp_object_t*, lisp_object_t*); + lisp_object_t* make_list2 (lisp_object_t*, lisp_object_t*); + public: + LispWriter (const char* name); + void write_float (const char* name, float f); + void write_int (const char* name, int i); + void write_boolean (const char* name, bool b); + void write_string (const char* name, const char* str); + void write_symbol (const char* name, const char* symname); + void write_lisp_obj(const char* name, lisp_object_t* lst); + + /** caller is responible to free the returned lisp_object_t */ + lisp_object_t* create_lisp (); + }; + #endif