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.
30 #include "lispreader.h"
32 #define TOKEN_ERROR -1
34 #define TOKEN_OPEN_PAREN 1
35 #define TOKEN_CLOSE_PAREN 2
36 #define TOKEN_SYMBOL 3
37 #define TOKEN_STRING 4
38 #define TOKEN_INTEGER 5
40 #define TOKEN_PATTERN_OPEN_PAREN 7
43 #define TOKEN_FALSE 10
46 #define MAX_TOKEN_LENGTH 1024
48 static char token_string[MAX_TOKEN_LENGTH + 1] = "";
49 static int token_length = 0;
51 static lisp_object_t end_marker = { LISP_TYPE_EOF };
52 static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR };
53 static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR };
54 static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR };
59 token_string[0] = '\0';
64 _token_append (char c)
66 assert(token_length < MAX_TOKEN_LENGTH);
68 token_string[token_length++] = c;
69 token_string[token_length] = '\0';
73 _next_char (lisp_stream_t *stream)
77 case LISP_STREAM_FILE :
78 return getc(stream->v.file);
80 case LISP_STREAM_STRING :
82 char c = stream->v.string.buf[stream->v.string.pos];
87 ++stream->v.string.pos;
93 return stream->v.any.next_char(stream->v.any.data);
100 _unget_char (char c, lisp_stream_t *stream)
102 switch (stream->type)
104 case LISP_STREAM_FILE :
105 ungetc(c, stream->v.file);
108 case LISP_STREAM_STRING :
109 --stream->v.string.pos;
112 case LISP_STREAM_ANY:
113 stream->v.any.unget_char(c, stream->v.any.data);
122 _scan (lisp_stream_t *stream)
124 static char *delims = "\"();";
132 c = _next_char(stream);
135 else if (c == ';') /* comment start */
138 c = _next_char(stream);
150 return TOKEN_OPEN_PAREN;
153 return TOKEN_CLOSE_PAREN;
158 c = _next_char(stream);
165 c = _next_char(stream);
187 c = _next_char(stream);
200 c = _next_char(stream);
205 return TOKEN_PATTERN_OPEN_PAREN;
212 if (isdigit(c) || c == '-')
214 int have_nondigits = 0;
216 int have_floating_point = 0;
223 have_floating_point++;
226 c = _next_char(stream);
228 if (c != EOF && !isdigit(c) && !isspace(c) && c != '.' && !strchr(delims, c))
231 while (c != EOF && !isspace(c) && !strchr(delims, c));
234 _unget_char(c, stream);
236 if (have_nondigits || !have_digits || have_floating_point > 1)
238 else if (have_floating_point == 1)
241 return TOKEN_INTEGER;
247 c = _next_char(stream);
248 if (c != EOF && !isspace(c) && !strchr(delims, c))
252 _unget_char(c, stream);
259 c = _next_char(stream);
261 while (c != EOF && !isspace(c) && !strchr(delims, c));
263 _unget_char(c, stream);
273 static lisp_object_t*
274 lisp_object_alloc (int type)
276 lisp_object_t *obj = (lisp_object_t*)malloc(sizeof(lisp_object_t));
284 lisp_stream_init_file (lisp_stream_t *stream, FILE *file)
286 stream->type = LISP_STREAM_FILE;
287 stream->v.file = file;
293 lisp_stream_init_string (lisp_stream_t *stream, char *buf)
295 stream->type = LISP_STREAM_STRING;
296 stream->v.string.buf = buf;
297 stream->v.string.pos = 0;
303 lisp_stream_init_any (lisp_stream_t *stream, void *data,
304 int (*next_char) (void *data),
305 void (*unget_char) (char c, void *data))
307 assert(next_char != 0 && unget_char != 0);
309 stream->type = LISP_STREAM_ANY;
310 stream->v.any.data = data;
311 stream->v.any.next_char= next_char;
312 stream->v.any.unget_char = unget_char;
318 lisp_make_integer (int value)
320 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_INTEGER);
322 obj->v.integer = value;
328 lisp_make_real (float value)
330 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_REAL);
338 lisp_make_symbol (const char *value)
340 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_SYMBOL);
342 obj->v.string = strdup(value);
348 lisp_make_string (const char *value)
350 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_STRING);
352 obj->v.string = strdup(value);
358 lisp_make_cons (lisp_object_t *car, lisp_object_t *cdr)
360 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_CONS);
362 obj->v.cons.car = car;
363 obj->v.cons.cdr = cdr;
369 lisp_make_boolean (int value)
371 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_BOOLEAN);
373 obj->v.integer = value ? 1 : 0;
378 static lisp_object_t*
379 lisp_make_pattern_cons (lisp_object_t *car, lisp_object_t *cdr)
381 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_CONS);
383 obj->v.cons.car = car;
384 obj->v.cons.cdr = cdr;
389 static lisp_object_t*
390 lisp_make_pattern_var (int type, int index, lisp_object_t *sub)
392 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_VAR);
394 obj->v.pattern.type = type;
395 obj->v.pattern.index = index;
396 obj->v.pattern.sub = sub;
402 lisp_read (lisp_stream_t *in)
404 int token = _scan(in);
405 lisp_object_t *obj = lisp_nil();
407 if (token == TOKEN_EOF)
413 return &error_object;
418 case TOKEN_OPEN_PAREN :
419 case TOKEN_PATTERN_OPEN_PAREN :
421 lisp_object_t *last = lisp_nil(), *car;
426 if (car == &error_object || car == &end_marker)
429 return &error_object;
431 else if (car == &dot_marker)
433 if (lisp_nil_p(last))
436 return &error_object;
440 if (car == &error_object || car == &end_marker)
447 last->v.cons.cdr = car;
449 if (_scan(in) != TOKEN_CLOSE_PAREN)
452 return &error_object;
455 car = &close_paren_marker;
458 else if (car != &close_paren_marker)
460 if (lisp_nil_p(last))
461 obj = last = (token == TOKEN_OPEN_PAREN ? lisp_make_cons(car, lisp_nil()) : lisp_make_pattern_cons(car, lisp_nil()));
463 last = last->v.cons.cdr = lisp_make_cons(car, lisp_nil());
466 while (car != &close_paren_marker);
470 case TOKEN_CLOSE_PAREN :
471 return &close_paren_marker;
474 return lisp_make_symbol(token_string);
477 return lisp_make_string(token_string);
480 return lisp_make_integer(atoi(token_string));
483 return lisp_make_real((float)atof(token_string));
489 return lisp_make_boolean(1);
492 return lisp_make_boolean(0);
496 return &error_object;
500 lisp_free (lisp_object_t *obj)
507 case LISP_TYPE_INTERNAL :
508 case LISP_TYPE_PARSE_ERROR :
512 case LISP_TYPE_SYMBOL :
513 case LISP_TYPE_STRING :
517 case LISP_TYPE_CONS :
518 case LISP_TYPE_PATTERN_CONS :
519 lisp_free(obj->v.cons.car);
520 lisp_free(obj->v.cons.cdr);
523 case LISP_TYPE_PATTERN_VAR :
524 lisp_free(obj->v.pattern.sub);
532 lisp_read_from_string (const char *buf)
534 lisp_stream_t stream;
536 lisp_stream_init_string(&stream, (char*)buf);
537 return lisp_read(&stream);
541 _compile_pattern (lisp_object_t **obj, int *index)
546 switch (lisp_type(*obj))
548 case LISP_TYPE_PATTERN_CONS :
557 { "any", LISP_PATTERN_ANY },
558 { "symbol", LISP_PATTERN_SYMBOL },
559 { "string", LISP_PATTERN_STRING },
560 { "integer", LISP_PATTERN_INTEGER },
561 { "real", LISP_PATTERN_REAL },
562 { "boolean", LISP_PATTERN_BOOLEAN },
563 { "list", LISP_PATTERN_LIST },
564 { "or", LISP_PATTERN_OR },
570 lisp_object_t *pattern;
572 if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL)
575 type_name = lisp_symbol(lisp_car(*obj));
576 for (i = 0; types[i].name != 0; ++i)
578 if (strcmp(types[i].name, type_name) == 0)
580 type = types[i].type;
585 if (types[i].name == 0)
588 if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0)
591 pattern = lisp_make_pattern_var(type, (*index)++, lisp_nil());
593 if (type == LISP_PATTERN_OR)
595 lisp_object_t *cdr = lisp_cdr(*obj);
597 if (!_compile_pattern(&cdr, index))
603 pattern->v.pattern.sub = cdr;
605 (*obj)->v.cons.cdr = lisp_nil();
614 case LISP_TYPE_CONS :
615 if (!_compile_pattern(&(*obj)->v.cons.car, index))
617 if (!_compile_pattern(&(*obj)->v.cons.cdr, index))
626 lisp_compile_pattern (lisp_object_t **obj, int *num_subs)
631 result = _compile_pattern(obj, &index);
633 if (result && num_subs != 0)
639 static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars);
642 _match_pattern_var (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
644 assert(lisp_type(pattern) == LISP_TYPE_PATTERN_VAR);
646 switch (pattern->v.pattern.type)
648 case LISP_PATTERN_ANY :
651 case LISP_PATTERN_SYMBOL :
652 if (obj == 0 || lisp_type(obj) != LISP_TYPE_SYMBOL)
656 case LISP_PATTERN_STRING :
657 if (obj == 0 || lisp_type(obj) != LISP_TYPE_STRING)
661 case LISP_PATTERN_INTEGER :
662 if (obj == 0 || lisp_type(obj) != LISP_TYPE_INTEGER)
666 case LISP_PATTERN_REAL :
667 if (obj == 0 || lisp_type(obj) != LISP_TYPE_REAL)
671 case LISP_PATTERN_BOOLEAN :
672 if (obj == 0 || lisp_type(obj) != LISP_TYPE_BOOLEAN)
676 case LISP_PATTERN_LIST :
677 if (obj == 0 || lisp_type(obj) != LISP_TYPE_CONS)
681 case LISP_PATTERN_OR :
686 for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub))
688 assert(lisp_type(sub) == LISP_TYPE_CONS);
690 if (_match_pattern(lisp_car(sub), obj, vars))
704 vars[pattern->v.pattern.index] = obj;
710 _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
718 if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR)
719 return _match_pattern_var(pattern, obj, vars);
721 if (lisp_type(pattern) != lisp_type(obj))
724 switch (lisp_type(pattern))
726 case LISP_TYPE_SYMBOL :
727 return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0;
729 case LISP_TYPE_STRING :
730 return strcmp(lisp_string(pattern), lisp_string(obj)) == 0;
732 case LISP_TYPE_INTEGER :
733 return lisp_integer(pattern) == lisp_integer(obj);
735 case LISP_TYPE_REAL :
736 return lisp_real(pattern) == lisp_real(obj);
738 case LISP_TYPE_CONS :
740 int result1, result2;
742 result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars);
743 result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars);
745 return result1 && result2;
757 lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs)
762 for (i = 0; i < num_subs; ++i)
763 vars[i] = &error_object;
765 return _match_pattern(pattern, obj, vars);
769 lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars)
771 lisp_object_t *pattern;
775 pattern = lisp_read_from_string(pattern_string);
777 if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF
778 || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR))
781 if (!lisp_compile_pattern(&pattern, &num_subs))
787 result = lisp_match_pattern(pattern, obj, vars, num_subs);
795 lisp_type (lisp_object_t *obj)
798 return LISP_TYPE_NIL;
803 lisp_integer (lisp_object_t *obj)
805 assert(obj->type == LISP_TYPE_INTEGER);
807 return obj->v.integer;
811 lisp_symbol (lisp_object_t *obj)
813 assert(obj->type == LISP_TYPE_SYMBOL);
815 return obj->v.string;
819 lisp_string (lisp_object_t *obj)
821 assert(obj->type == LISP_TYPE_STRING);
823 return obj->v.string;
827 lisp_boolean (lisp_object_t *obj)
829 assert(obj->type == LISP_TYPE_BOOLEAN);
831 return obj->v.integer;
835 lisp_real (lisp_object_t *obj)
837 assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER);
839 if (obj->type == LISP_TYPE_INTEGER)
840 return obj->v.integer;
845 lisp_car (lisp_object_t *obj)
847 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
849 return obj->v.cons.car;
853 lisp_cdr (lisp_object_t *obj)
855 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
857 return obj->v.cons.cdr;
861 lisp_cxr (lisp_object_t *obj, const char *x)
865 for (i = strlen(x) - 1; i >= 0; --i)
868 else if (x[i] == 'd')
877 lisp_list_length (lisp_object_t *obj)
883 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
886 obj = obj->v.cons.cdr;
893 lisp_list_nth_cdr (lisp_object_t *obj, int index)
898 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
901 obj = obj->v.cons.cdr;
908 lisp_list_nth (lisp_object_t *obj, int index)
910 obj = lisp_list_nth_cdr(obj, index);
914 return obj->v.cons.car;
918 lisp_dump (lisp_object_t *obj, FILE *out)
926 switch (lisp_type(obj))
929 fputs("#<eof>", out);
932 case LISP_TYPE_PARSE_ERROR :
933 fputs("#<error>", out);
936 case LISP_TYPE_INTEGER :
937 fprintf(out, "%d", lisp_integer(obj));
940 case LISP_TYPE_REAL :
941 fprintf(out, "%f", lisp_real(obj));
944 case LISP_TYPE_SYMBOL :
945 fputs(lisp_symbol(obj), out);
948 case LISP_TYPE_STRING :
953 for (p = lisp_string(obj); *p != 0; ++p)
955 if (*p == '"' || *p == '\\')
963 case LISP_TYPE_CONS :
964 case LISP_TYPE_PATTERN_CONS :
965 fputs(lisp_type(obj) == LISP_TYPE_CONS ? "(" : "#?(", out);
968 lisp_dump(lisp_car(obj), out);
972 if (lisp_type(obj) != LISP_TYPE_CONS
973 && lisp_type(obj) != LISP_TYPE_PATTERN_CONS)
986 case LISP_TYPE_BOOLEAN :
987 if (lisp_boolean(obj))
1000 LispReader::LispReader (lisp_object_t* l)
1003 //std::cout << "LispReader: " << std::flush;
1004 //lisp_dump(lst, stdout);
1005 //std::cout << std::endl;
1009 LispReader::search_for(const char* name)
1011 //std::cout << "LispReader::search_for(" << name << ")" << std::endl;
1012 lisp_object_t* cursor = lst;
1014 while(!lisp_nil_p(cursor))
1016 lisp_object_t* cur = lisp_car(cursor);
1018 if (!lisp_cons_p(cur) || !lisp_symbol_p (lisp_car(cur)))
1020 lisp_dump(cur, stdout);
1021 //throw ConstruoError (std::string("LispReader: Read error in search_for ") + name);
1022 printf("LispReader: Read error in search\n");
1026 if (strcmp(lisp_symbol(lisp_car(cur)), name) == 0)
1028 return lisp_cdr(cur);
1032 cursor = lisp_cdr (cursor);
1038 LispReader::read_int (const char* name, int* i)
1040 lisp_object_t* obj = search_for (name);
1043 *i = lisp_integer(lisp_car(obj));
1050 LispReader::read_float (const char* name, float* f)
1052 lisp_object_t* obj = search_for (name);
1055 *f = lisp_real(lisp_car(obj));
1062 LispReader::read_int_vector (const char* name, std::vector<int>* vec)
1064 lisp_object_t* obj = search_for (name);
1067 while(!lisp_nil_p(obj))
1069 vec->push_back(lisp_integer(lisp_car(obj)));
1070 obj = lisp_cdr(obj);
1078 LispReader::read_string (const char* name, std::string* str)
1080 lisp_object_t* obj = search_for (name);
1083 *str = lisp_string(lisp_car(obj));
1090 LispReader::read_bool (const char* name, bool* b)
1092 lisp_object_t* obj = search_for (name);
1095 *b = lisp_boolean(lisp_car(obj));
1101 LispWriter::LispWriter (const char* name)
1103 lisp_objs.push_back(lisp_make_symbol (name));
1107 LispWriter::append (lisp_object_t* obj)
1109 lisp_objs.push_back(obj);
1113 LispWriter::make_list3 (lisp_object_t* a, lisp_object_t* b, lisp_object_t* c)
1115 return lisp_make_cons (a, lisp_make_cons(b, lisp_make_cons(c, lisp_nil())));
1119 LispWriter::make_list2 (lisp_object_t* a, lisp_object_t* b)
1121 return lisp_make_cons (a, lisp_make_cons(b, lisp_nil()));
1125 LispWriter::write_float (const char* name, float f)
1127 append(make_list2 (lisp_make_symbol (name),
1128 lisp_make_real(f)));
1132 LispWriter::write_int (const char* name, int i)
1134 append(make_list2 (lisp_make_symbol (name),
1135 lisp_make_integer(i)));
1139 LispWriter::write_string (const char* name, const char* str)
1141 append(make_list2 (lisp_make_symbol (name),
1142 lisp_make_string(str)));
1146 LispWriter::write_symbol (const char* name, const char* symname)
1148 append(make_list2 (lisp_make_symbol (name),
1149 lisp_make_symbol(symname)));
1153 LispWriter::write_lisp_obj(const char* name, lisp_object_t* lst)
1155 append(make_list2 (lisp_make_symbol (name),
1160 LispWriter::write_boolean (const char* name, bool b)
1162 append(make_list2 (lisp_make_symbol (name),
1163 lisp_make_boolean(b)));
1167 LispWriter::create_lisp ()
1169 lisp_object_t* lisp_obj = lisp_nil();
1171 for(std::vector<lisp_object_t*>::reverse_iterator i = lisp_objs.rbegin ();
1172 i != lisp_objs.rend (); ++i)
1174 lisp_obj = lisp_make_cons (*i, lisp_obj);