5 * Copyright (C) 1998-2000 Mark Probst
6 * Copyright (C) 2002 Ingo Ruhnke <grumbel@gmx.de>
8 * This library is free software; you can redistribute it and/or
9 * modify it under the terms of the GNU Library General Public
10 * License as published by the Free Software Foundation; either
11 * version 2 of the License, or (at your option) any later version.
13 * This library is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 * Library General Public License for more details.
18 * You should have received a copy of the GNU Library General Public
19 * License along with this library; if not, write to the
20 * Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 * Boston, MA 02111-1307, USA.
29 #include <lispreader.h>
31 #define TOKEN_ERROR -1
33 #define TOKEN_OPEN_PAREN 1
34 #define TOKEN_CLOSE_PAREN 2
35 #define TOKEN_SYMBOL 3
36 #define TOKEN_STRING 4
37 #define TOKEN_INTEGER 5
39 #define TOKEN_PATTERN_OPEN_PAREN 7
42 #define TOKEN_FALSE 10
45 #define MAX_TOKEN_LENGTH 1024
47 static char token_string[MAX_TOKEN_LENGTH + 1] = "";
48 static int token_length = 0;
50 static lisp_object_t end_marker = { LISP_TYPE_EOF };
51 static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR };
52 static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR };
53 static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR };
58 token_string[0] = '\0';
63 _token_append (char c)
65 assert(token_length < MAX_TOKEN_LENGTH);
67 token_string[token_length++] = c;
68 token_string[token_length] = '\0';
72 _next_char (lisp_stream_t *stream)
76 case LISP_STREAM_FILE :
77 return getc(stream->v.file);
79 case LISP_STREAM_STRING :
81 char c = stream->v.string.buf[stream->v.string.pos];
86 ++stream->v.string.pos;
92 return stream->v.any.next_char(stream->v.any.data);
99 _unget_char (char c, lisp_stream_t *stream)
101 switch (stream->type)
103 case LISP_STREAM_FILE :
104 ungetc(c, stream->v.file);
107 case LISP_STREAM_STRING :
108 --stream->v.string.pos;
111 case LISP_STREAM_ANY:
112 stream->v.any.unget_char(c, stream->v.any.data);
121 _scan (lisp_stream_t *stream)
123 static char *delims = "\"();";
131 c = _next_char(stream);
134 else if (c == ';') /* comment start */
137 c = _next_char(stream);
149 return TOKEN_OPEN_PAREN;
152 return TOKEN_CLOSE_PAREN;
157 c = _next_char(stream);
164 c = _next_char(stream);
186 c = _next_char(stream);
199 c = _next_char(stream);
204 return TOKEN_PATTERN_OPEN_PAREN;
211 if (isdigit(c) || c == '-')
213 int have_nondigits = 0;
215 int have_floating_point = 0;
222 have_floating_point++;
225 c = _next_char(stream);
227 if (c != EOF && !isdigit(c) && !isspace(c) && c != '.' && !strchr(delims, c))
230 while (c != EOF && !isspace(c) && !strchr(delims, c));
233 _unget_char(c, stream);
235 if (have_nondigits || !have_digits || have_floating_point > 1)
237 else if (have_floating_point == 1)
240 return TOKEN_INTEGER;
246 c = _next_char(stream);
247 if (c != EOF && !isspace(c) && !strchr(delims, c))
251 _unget_char(c, stream);
258 c = _next_char(stream);
260 while (c != EOF && !isspace(c) && !strchr(delims, c));
262 _unget_char(c, stream);
272 static lisp_object_t*
273 lisp_object_alloc (int type)
275 lisp_object_t *obj = (lisp_object_t*)malloc(sizeof(lisp_object_t));
283 lisp_stream_init_file (lisp_stream_t *stream, FILE *file)
285 stream->type = LISP_STREAM_FILE;
286 stream->v.file = file;
292 lisp_stream_init_string (lisp_stream_t *stream, char *buf)
294 stream->type = LISP_STREAM_STRING;
295 stream->v.string.buf = buf;
296 stream->v.string.pos = 0;
302 lisp_stream_init_any (lisp_stream_t *stream, void *data,
303 int (*next_char) (void *data),
304 void (*unget_char) (char c, void *data))
306 assert(next_char != 0 && unget_char != 0);
308 stream->type = LISP_STREAM_ANY;
309 stream->v.any.data = data;
310 stream->v.any.next_char= next_char;
311 stream->v.any.unget_char = unget_char;
317 lisp_make_integer (int value)
319 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_INTEGER);
321 obj->v.integer = value;
327 lisp_make_real (float value)
329 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_REAL);
337 lisp_make_symbol (const char *value)
339 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_SYMBOL);
341 obj->v.string = strdup(value);
347 lisp_make_string (const char *value)
349 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_STRING);
351 obj->v.string = strdup(value);
357 lisp_make_cons (lisp_object_t *car, lisp_object_t *cdr)
359 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_CONS);
361 obj->v.cons.car = car;
362 obj->v.cons.cdr = cdr;
368 lisp_make_boolean (int value)
370 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_BOOLEAN);
372 obj->v.integer = value ? 1 : 0;
377 static lisp_object_t*
378 lisp_make_pattern_cons (lisp_object_t *car, lisp_object_t *cdr)
380 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_CONS);
382 obj->v.cons.car = car;
383 obj->v.cons.cdr = cdr;
388 static lisp_object_t*
389 lisp_make_pattern_var (int type, int index, lisp_object_t *sub)
391 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_VAR);
393 obj->v.pattern.type = type;
394 obj->v.pattern.index = index;
395 obj->v.pattern.sub = sub;
401 lisp_read (lisp_stream_t *in)
403 int token = _scan(in);
404 lisp_object_t *obj = lisp_nil();
406 if (token == TOKEN_EOF)
412 return &error_object;
417 case TOKEN_OPEN_PAREN :
418 case TOKEN_PATTERN_OPEN_PAREN :
420 lisp_object_t *last = lisp_nil(), *car;
425 if (car == &error_object || car == &end_marker)
428 return &error_object;
430 else if (car == &dot_marker)
432 if (lisp_nil_p(last))
435 return &error_object;
439 if (car == &error_object || car == &end_marker)
446 last->v.cons.cdr = car;
448 if (_scan(in) != TOKEN_CLOSE_PAREN)
451 return &error_object;
454 car = &close_paren_marker;
457 else if (car != &close_paren_marker)
459 if (lisp_nil_p(last))
460 obj = last = (token == TOKEN_OPEN_PAREN ? lisp_make_cons(car, lisp_nil()) : lisp_make_pattern_cons(car, lisp_nil()));
462 last = last->v.cons.cdr = lisp_make_cons(car, lisp_nil());
465 while (car != &close_paren_marker);
469 case TOKEN_CLOSE_PAREN :
470 return &close_paren_marker;
473 return lisp_make_symbol(token_string);
476 return lisp_make_string(token_string);
479 return lisp_make_integer(atoi(token_string));
482 return lisp_make_real((float)atof(token_string));
488 return lisp_make_boolean(1);
491 return lisp_make_boolean(0);
495 return &error_object;
499 lisp_free (lisp_object_t *obj)
506 case LISP_TYPE_INTERNAL :
507 case LISP_TYPE_PARSE_ERROR :
511 case LISP_TYPE_SYMBOL :
512 case LISP_TYPE_STRING :
516 case LISP_TYPE_CONS :
517 case LISP_TYPE_PATTERN_CONS :
518 lisp_free(obj->v.cons.car);
519 lisp_free(obj->v.cons.cdr);
522 case LISP_TYPE_PATTERN_VAR :
523 lisp_free(obj->v.pattern.sub);
531 lisp_read_from_string (const char *buf)
533 lisp_stream_t stream;
535 lisp_stream_init_string(&stream, (char*)buf);
536 return lisp_read(&stream);
540 _compile_pattern (lisp_object_t **obj, int *index)
545 switch (lisp_type(*obj))
547 case LISP_TYPE_PATTERN_CONS :
556 { "any", LISP_PATTERN_ANY },
557 { "symbol", LISP_PATTERN_SYMBOL },
558 { "string", LISP_PATTERN_STRING },
559 { "integer", LISP_PATTERN_INTEGER },
560 { "real", LISP_PATTERN_REAL },
561 { "boolean", LISP_PATTERN_BOOLEAN },
562 { "list", LISP_PATTERN_LIST },
563 { "or", LISP_PATTERN_OR },
569 lisp_object_t *pattern;
571 if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL)
574 type_name = lisp_symbol(lisp_car(*obj));
575 for (i = 0; types[i].name != 0; ++i)
577 if (strcmp(types[i].name, type_name) == 0)
579 type = types[i].type;
584 if (types[i].name == 0)
587 if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0)
590 pattern = lisp_make_pattern_var(type, (*index)++, lisp_nil());
592 if (type == LISP_PATTERN_OR)
594 lisp_object_t *cdr = lisp_cdr(*obj);
596 if (!_compile_pattern(&cdr, index))
602 pattern->v.pattern.sub = cdr;
604 (*obj)->v.cons.cdr = lisp_nil();
613 case LISP_TYPE_CONS :
614 if (!_compile_pattern(&(*obj)->v.cons.car, index))
616 if (!_compile_pattern(&(*obj)->v.cons.cdr, index))
625 lisp_compile_pattern (lisp_object_t **obj, int *num_subs)
630 result = _compile_pattern(obj, &index);
632 if (result && num_subs != 0)
638 static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars);
641 _match_pattern_var (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
643 assert(lisp_type(pattern) == LISP_TYPE_PATTERN_VAR);
645 switch (pattern->v.pattern.type)
647 case LISP_PATTERN_ANY :
650 case LISP_PATTERN_SYMBOL :
651 if (obj == 0 || lisp_type(obj) != LISP_TYPE_SYMBOL)
655 case LISP_PATTERN_STRING :
656 if (obj == 0 || lisp_type(obj) != LISP_TYPE_STRING)
660 case LISP_PATTERN_INTEGER :
661 if (obj == 0 || lisp_type(obj) != LISP_TYPE_INTEGER)
665 case LISP_PATTERN_REAL :
666 if (obj == 0 || lisp_type(obj) != LISP_TYPE_REAL)
670 case LISP_PATTERN_BOOLEAN :
671 if (obj == 0 || lisp_type(obj) != LISP_TYPE_BOOLEAN)
675 case LISP_PATTERN_LIST :
676 if (obj == 0 || lisp_type(obj) != LISP_TYPE_CONS)
680 case LISP_PATTERN_OR :
685 for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub))
687 assert(lisp_type(sub) == LISP_TYPE_CONS);
689 if (_match_pattern(lisp_car(sub), obj, vars))
703 vars[pattern->v.pattern.index] = obj;
709 _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
717 if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR)
718 return _match_pattern_var(pattern, obj, vars);
720 if (lisp_type(pattern) != lisp_type(obj))
723 switch (lisp_type(pattern))
725 case LISP_TYPE_SYMBOL :
726 return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0;
728 case LISP_TYPE_STRING :
729 return strcmp(lisp_string(pattern), lisp_string(obj)) == 0;
731 case LISP_TYPE_INTEGER :
732 return lisp_integer(pattern) == lisp_integer(obj);
734 case LISP_TYPE_REAL :
735 return lisp_real(pattern) == lisp_real(obj);
737 case LISP_TYPE_CONS :
739 int result1, result2;
741 result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars);
742 result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars);
744 return result1 && result2;
756 lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs)
761 for (i = 0; i < num_subs; ++i)
762 vars[i] = &error_object;
764 return _match_pattern(pattern, obj, vars);
768 lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars)
770 lisp_object_t *pattern;
774 pattern = lisp_read_from_string(pattern_string);
776 if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF
777 || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR))
780 if (!lisp_compile_pattern(&pattern, &num_subs))
786 result = lisp_match_pattern(pattern, obj, vars, num_subs);
794 lisp_type (lisp_object_t *obj)
797 return LISP_TYPE_NIL;
802 lisp_integer (lisp_object_t *obj)
804 assert(obj->type == LISP_TYPE_INTEGER);
806 return obj->v.integer;
810 lisp_symbol (lisp_object_t *obj)
812 assert(obj->type == LISP_TYPE_SYMBOL);
814 return obj->v.string;
818 lisp_string (lisp_object_t *obj)
820 assert(obj->type == LISP_TYPE_STRING);
822 return obj->v.string;
826 lisp_boolean (lisp_object_t *obj)
828 assert(obj->type == LISP_TYPE_BOOLEAN);
830 return obj->v.integer;
834 lisp_real (lisp_object_t *obj)
836 assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER);
838 if (obj->type == LISP_TYPE_INTEGER)
839 return obj->v.integer;
844 lisp_car (lisp_object_t *obj)
846 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
848 return obj->v.cons.car;
852 lisp_cdr (lisp_object_t *obj)
854 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
856 return obj->v.cons.cdr;
860 lisp_cxr (lisp_object_t *obj, const char *x)
864 for (i = strlen(x) - 1; i >= 0; --i)
867 else if (x[i] == 'd')
876 lisp_list_length (lisp_object_t *obj)
882 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
885 obj = obj->v.cons.cdr;
892 lisp_list_nth_cdr (lisp_object_t *obj, int index)
897 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
900 obj = obj->v.cons.cdr;
907 lisp_list_nth (lisp_object_t *obj, int index)
909 obj = lisp_list_nth_cdr(obj, index);
913 return obj->v.cons.car;
917 lisp_dump (lisp_object_t *obj, FILE *out)
925 switch (lisp_type(obj))
928 fputs("#<eof>", out);
931 case LISP_TYPE_PARSE_ERROR :
932 fputs("#<error>", out);
935 case LISP_TYPE_INTEGER :
936 fprintf(out, "%d", lisp_integer(obj));
939 case LISP_TYPE_REAL :
940 fprintf(out, "%f", lisp_real(obj));
943 case LISP_TYPE_SYMBOL :
944 fputs(lisp_symbol(obj), out);
947 case LISP_TYPE_STRING :
952 for (p = lisp_string(obj); *p != 0; ++p)
954 if (*p == '"' || *p == '\\')
962 case LISP_TYPE_CONS :
963 case LISP_TYPE_PATTERN_CONS :
964 fputs(lisp_type(obj) == LISP_TYPE_CONS ? "(" : "#?(", out);
967 lisp_dump(lisp_car(obj), out);
971 if (lisp_type(obj) != LISP_TYPE_CONS
972 && lisp_type(obj) != LISP_TYPE_PATTERN_CONS)
985 case LISP_TYPE_BOOLEAN :
986 if (lisp_boolean(obj))
999 LispReader::LispReader (lisp_object_t* l)
1002 //std::cout << "LispReader: " << std::flush;
1003 //lisp_dump(lst, stdout);
1004 //std::cout << std::endl;
1008 LispReader::search_for(const char* name)
1010 //std::cout << "LispReader::search_for(" << name << ")" << std::endl;
1011 lisp_object_t* cursor = lst;
1013 while(!lisp_nil_p(cursor))
1015 lisp_object_t* cur = lisp_car(cursor);
1017 if (!lisp_cons_p(cur) || !lisp_symbol_p (lisp_car(cur)))
1019 lisp_dump(cur, stdout);
1020 //throw ConstruoError (std::string("LispReader: Read error in search_for ") + name);
1021 printf("LispReader: Read error in search\n");
1025 if (strcmp(lisp_symbol(lisp_car(cur)), name) == 0)
1027 return lisp_cdr(cur);
1031 cursor = lisp_cdr (cursor);
1037 LispReader::read_int (const char* name, int* i)
1039 lisp_object_t* obj = search_for (name);
1042 *i = lisp_integer(lisp_car(obj));
1049 LispReader::read_float (const char* name, float* f)
1051 lisp_object_t* obj = search_for (name);
1054 *f = lisp_real(lisp_car(obj));
1061 LispReader::read_bool (const char* name, bool* b)
1063 lisp_object_t* obj = search_for (name);
1066 *b = lisp_boolean(lisp_car(obj));
1072 LispWriter::LispWriter (const char* name)
1074 lisp_objs.push_back(lisp_make_symbol (name));
1078 LispWriter::append (lisp_object_t* obj)
1080 lisp_objs.push_back(obj);
1084 LispWriter::make_list3 (lisp_object_t* a, lisp_object_t* b, lisp_object_t* c)
1086 return lisp_make_cons (a, lisp_make_cons(b, lisp_make_cons(c, lisp_nil())));
1090 LispWriter::make_list2 (lisp_object_t* a, lisp_object_t* b)
1092 return lisp_make_cons (a, lisp_make_cons(b, lisp_nil()));
1096 LispWriter::write_float (const char* name, float f)
1098 append(make_list2 (lisp_make_symbol (name),
1099 lisp_make_real(f)));
1103 LispWriter::write_int (const char* name, int i)
1105 append(make_list2 (lisp_make_symbol (name),
1106 lisp_make_integer(i)));
1110 LispWriter::write_string (const char* name, const char* str)
1112 append(make_list2 (lisp_make_symbol (name),
1113 lisp_make_string(str)));
1117 LispWriter::write_symbol (const char* name, const char* symname)
1119 append(make_list2 (lisp_make_symbol (name),
1120 lisp_make_symbol(symname)));
1124 LispWriter::write_lisp_obj(const char* name, lisp_object_t* lst)
1126 append(make_list2 (lisp_make_symbol (name),
1131 LispWriter::write_boolean (const char* name, bool b)
1133 append(make_list2 (lisp_make_symbol (name),
1134 lisp_make_boolean(b)));
1138 LispWriter::create_lisp ()
1140 lisp_object_t* lisp_obj = lisp_nil();
1142 for(std::vector<lisp_object_t*>::reverse_iterator i = lisp_objs.rbegin ();
1143 i != lisp_objs.rend (); ++i)
1145 lisp_obj = lisp_make_cons (*i, lisp_obj);