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.
31 #include "lispreader.h"
33 #define TOKEN_ERROR -1
35 #define TOKEN_OPEN_PAREN 1
36 #define TOKEN_CLOSE_PAREN 2
37 #define TOKEN_SYMBOL 3
38 #define TOKEN_STRING 4
39 #define TOKEN_INTEGER 5
41 #define TOKEN_PATTERN_OPEN_PAREN 7
44 #define TOKEN_FALSE 10
47 #define MAX_TOKEN_LENGTH 4096
49 static char token_string[MAX_TOKEN_LENGTH + 1] = "";
50 static int token_length = 0;
52 static lisp_object_t end_marker = { LISP_TYPE_EOF, {{0, 0}} };
53 static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR , {{0,0}} };
54 static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR , {{0,0}} };
55 static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR , {{0,0}} };
60 token_string[0] = '\0';
65 _token_append (char c)
67 if (token_length >= MAX_TOKEN_LENGTH)
68 throw LispReaderException("_token_append()", __FILE__, __LINE__);
70 token_string[token_length++] = c;
71 token_string[token_length] = '\0';
75 _next_char (lisp_stream_t *stream)
79 case LISP_STREAM_FILE :
80 return getc(stream->v.file);
82 case LISP_STREAM_STRING :
84 char c = stream->v.string.buf[stream->v.string.pos];
89 ++stream->v.string.pos;
95 return stream->v.any.next_char(stream->v.any.data);
98 throw LispReaderException("_next_char()", __FILE__, __LINE__);
103 _unget_char (char c, lisp_stream_t *stream)
105 switch (stream->type)
107 case LISP_STREAM_FILE :
108 ungetc(c, stream->v.file);
111 case LISP_STREAM_STRING :
112 --stream->v.string.pos;
115 case LISP_STREAM_ANY:
116 stream->v.any.unget_char(c, stream->v.any.data);
120 throw LispReaderException("_unget_char()", __FILE__, __LINE__);
125 _scan (lisp_stream_t *stream)
127 static char *delims = "\"();";
135 c = _next_char(stream);
138 else if (c == ';') /* comment start */
141 c = _next_char(stream);
153 return TOKEN_OPEN_PAREN;
156 return TOKEN_CLOSE_PAREN;
161 c = _next_char(stream);
168 c = _next_char(stream);
190 c = _next_char(stream);
203 c = _next_char(stream);
208 return TOKEN_PATTERN_OPEN_PAREN;
215 if (isdigit(c) || c == '-')
217 int have_nondigits = 0;
219 int have_floating_point = 0;
226 have_floating_point++;
229 c = _next_char(stream);
231 if (c != EOF && !isdigit(c) && !isspace(c) && c != '.' && !strchr(delims, c))
234 while (c != EOF && !isspace(c) && !strchr(delims, c));
237 _unget_char(c, stream);
239 if (have_nondigits || !have_digits || have_floating_point > 1)
241 else if (have_floating_point == 1)
244 return TOKEN_INTEGER;
250 c = _next_char(stream);
251 if (c != EOF && !isspace(c) && !strchr(delims, c))
255 _unget_char(c, stream);
262 c = _next_char(stream);
264 while (c != EOF && !isspace(c) && !strchr(delims, c));
266 _unget_char(c, stream);
272 throw LispReaderException("_scan()", __FILE__, __LINE__);
276 static lisp_object_t*
277 lisp_object_alloc (int type)
279 lisp_object_t *obj = (lisp_object_t*)malloc(sizeof(lisp_object_t));
287 lisp_stream_init_file (lisp_stream_t *stream, FILE *file)
289 stream->type = LISP_STREAM_FILE;
290 stream->v.file = file;
296 lisp_stream_init_string (lisp_stream_t *stream, char *buf)
298 stream->type = LISP_STREAM_STRING;
299 stream->v.string.buf = buf;
300 stream->v.string.pos = 0;
306 lisp_stream_init_any (lisp_stream_t *stream, void *data,
307 int (*next_char) (void *data),
308 void (*unget_char) (char c, void *data))
310 if (next_char == 0 || unget_char == 0)
311 throw LispReaderException("lisp_stream_init_any()", __FILE__, __LINE__);
313 stream->type = LISP_STREAM_ANY;
314 stream->v.any.data = data;
315 stream->v.any.next_char= next_char;
316 stream->v.any.unget_char = unget_char;
322 lisp_make_integer (int value)
324 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_INTEGER);
326 obj->v.integer = value;
332 lisp_make_real (float value)
334 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_REAL);
342 lisp_make_symbol (const char *value)
344 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_SYMBOL);
346 obj->v.string = strdup(value);
352 lisp_make_string (const char *value)
354 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_STRING);
356 obj->v.string = strdup(value);
362 lisp_make_cons (lisp_object_t *car, lisp_object_t *cdr)
364 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_CONS);
366 obj->v.cons.car = car;
367 obj->v.cons.cdr = cdr;
373 lisp_make_boolean (int value)
375 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_BOOLEAN);
377 obj->v.integer = value ? 1 : 0;
382 static lisp_object_t*
383 lisp_make_pattern_cons (lisp_object_t *car, lisp_object_t *cdr)
385 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_CONS);
387 obj->v.cons.car = car;
388 obj->v.cons.cdr = cdr;
393 static lisp_object_t*
394 lisp_make_pattern_var (int type, int index, lisp_object_t *sub)
396 lisp_object_t *obj = lisp_object_alloc(LISP_TYPE_PATTERN_VAR);
398 obj->v.pattern.type = type;
399 obj->v.pattern.index = index;
400 obj->v.pattern.sub = sub;
406 lisp_read (lisp_stream_t *in)
408 int token = _scan(in);
409 lisp_object_t *obj = lisp_nil();
411 if (token == TOKEN_EOF)
417 return &error_object;
422 case TOKEN_OPEN_PAREN :
423 case TOKEN_PATTERN_OPEN_PAREN :
425 lisp_object_t *last = lisp_nil(), *car;
430 if (car == &error_object || car == &end_marker)
433 return &error_object;
435 else if (car == &dot_marker)
437 if (lisp_nil_p(last))
440 return &error_object;
444 if (car == &error_object || car == &end_marker)
451 last->v.cons.cdr = car;
453 if (_scan(in) != TOKEN_CLOSE_PAREN)
456 return &error_object;
459 car = &close_paren_marker;
462 else if (car != &close_paren_marker)
464 if (lisp_nil_p(last))
465 obj = last = (token == TOKEN_OPEN_PAREN ? lisp_make_cons(car, lisp_nil()) : lisp_make_pattern_cons(car, lisp_nil()));
467 last = last->v.cons.cdr = lisp_make_cons(car, lisp_nil());
470 while (car != &close_paren_marker);
474 case TOKEN_CLOSE_PAREN :
475 return &close_paren_marker;
478 return lisp_make_symbol(token_string);
481 return lisp_make_string(token_string);
484 return lisp_make_integer(atoi(token_string));
487 return lisp_make_real((float)atof(token_string));
493 return lisp_make_boolean(1);
496 return lisp_make_boolean(0);
499 throw LispReaderException("lisp_read()", __FILE__, __LINE__);
500 return &error_object;
504 lisp_free (lisp_object_t *obj)
509 /** We have to use this iterative code, because the recursive function
510 * produces a stack overflow and crashs on OSX 10.2
512 std::vector<lisp_object_t*> objs;
515 while(!objs.empty()) {
516 lisp_object_t* obj = objs.back();
520 case LISP_TYPE_INTERNAL :
521 case LISP_TYPE_PARSE_ERROR :
525 case LISP_TYPE_SYMBOL :
526 case LISP_TYPE_STRING :
530 case LISP_TYPE_CONS :
531 case LISP_TYPE_PATTERN_CONS :
533 objs.push_back(obj->v.cons.car);
535 objs.push_back(obj->v.cons.cdr);
538 case LISP_TYPE_PATTERN_VAR :
539 if(obj->v.pattern.sub)
540 objs.push_back(obj->v.pattern.sub);
549 lisp_read_from_string (const char *buf)
551 lisp_stream_t stream;
553 lisp_stream_init_string(&stream, (char*)buf);
554 return lisp_read(&stream);
558 _compile_pattern (lisp_object_t **obj, int *index)
563 switch (lisp_type(*obj))
565 case LISP_TYPE_PATTERN_CONS :
574 { "any", LISP_PATTERN_ANY },
575 { "symbol", LISP_PATTERN_SYMBOL },
576 { "string", LISP_PATTERN_STRING },
577 { "integer", LISP_PATTERN_INTEGER },
578 { "real", LISP_PATTERN_REAL },
579 { "boolean", LISP_PATTERN_BOOLEAN },
580 { "list", LISP_PATTERN_LIST },
581 { "or", LISP_PATTERN_OR },
587 lisp_object_t *pattern;
590 if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL)
593 type_name = lisp_symbol(lisp_car(*obj));
594 for (i = 0; types[i].name != 0; ++i)
596 if (strcmp(types[i].name, type_name) == 0)
598 type = types[i].type;
603 if (types[i].name == 0)
606 if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0)
609 pattern = lisp_make_pattern_var(type, (*index)++, lisp_nil());
611 if (type == LISP_PATTERN_OR)
613 lisp_object_t *cdr = lisp_cdr(*obj);
615 if (!_compile_pattern(&cdr, index))
621 pattern->v.pattern.sub = cdr;
623 (*obj)->v.cons.cdr = lisp_nil();
632 case LISP_TYPE_CONS :
633 if (!_compile_pattern(&(*obj)->v.cons.car, index))
635 if (!_compile_pattern(&(*obj)->v.cons.cdr, index))
644 lisp_compile_pattern (lisp_object_t **obj, int *num_subs)
649 result = _compile_pattern(obj, &index);
651 if (result && num_subs != 0)
657 static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars);
660 _match_pattern_var (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
662 if (lisp_type(pattern) != LISP_TYPE_PATTERN_VAR)
663 throw LispReaderException("_match_pattern_var", __FILE__, __LINE__);
665 switch (pattern->v.pattern.type)
667 case LISP_PATTERN_ANY :
670 case LISP_PATTERN_SYMBOL :
671 if (obj == 0 || lisp_type(obj) != LISP_TYPE_SYMBOL)
675 case LISP_PATTERN_STRING :
676 if (obj == 0 || lisp_type(obj) != LISP_TYPE_STRING)
680 case LISP_PATTERN_INTEGER :
681 if (obj == 0 || lisp_type(obj) != LISP_TYPE_INTEGER)
685 case LISP_PATTERN_REAL :
686 if (obj == 0 || lisp_type(obj) != LISP_TYPE_REAL)
690 case LISP_PATTERN_BOOLEAN :
691 if (obj == 0 || lisp_type(obj) != LISP_TYPE_BOOLEAN)
695 case LISP_PATTERN_LIST :
696 if (obj == 0 || lisp_type(obj) != LISP_TYPE_CONS)
700 case LISP_PATTERN_OR :
705 for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub))
707 if (lisp_type(sub) != LISP_TYPE_CONS)
708 throw LispReaderException("_match_pattern_var()", __FILE__, __LINE__);
710 if (_match_pattern(lisp_car(sub), obj, vars))
720 throw LispReaderException("_match_pattern_var()", __FILE__, __LINE__);
724 vars[pattern->v.pattern.index] = obj;
730 _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
738 if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR)
739 return _match_pattern_var(pattern, obj, vars);
741 if (lisp_type(pattern) != lisp_type(obj))
744 switch (lisp_type(pattern))
746 case LISP_TYPE_SYMBOL :
747 return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0;
749 case LISP_TYPE_STRING :
750 return strcmp(lisp_string(pattern), lisp_string(obj)) == 0;
752 case LISP_TYPE_INTEGER :
753 return lisp_integer(pattern) == lisp_integer(obj);
755 case LISP_TYPE_REAL :
756 return lisp_real(pattern) == lisp_real(obj);
758 case LISP_TYPE_CONS :
760 int result1, result2;
762 result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars);
763 result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars);
765 return result1 && result2;
770 throw LispReaderException("_match_pattern()", __FILE__, __LINE__);
777 lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs)
782 for (i = 0; i < num_subs; ++i)
783 vars[i] = &error_object;
785 return _match_pattern(pattern, obj, vars);
789 lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars)
791 lisp_object_t *pattern;
795 pattern = lisp_read_from_string(pattern_string);
797 if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF
798 || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR))
801 if (!lisp_compile_pattern(&pattern, &num_subs))
807 result = lisp_match_pattern(pattern, obj, vars, num_subs);
815 lisp_type (lisp_object_t *obj)
818 return LISP_TYPE_NIL;
823 lisp_integer (lisp_object_t *obj)
825 if (obj->type != LISP_TYPE_INTEGER)
826 throw LispReaderException("lisp_integer()", __FILE__, __LINE__);
828 return obj->v.integer;
832 lisp_symbol (lisp_object_t *obj)
834 if (obj->type != LISP_TYPE_SYMBOL)
835 throw LispReaderException("lisp_symbol()", __FILE__, __LINE__);
837 return obj->v.string;
841 lisp_string (lisp_object_t *obj)
843 if (obj->type != LISP_TYPE_STRING)
844 throw LispReaderException("lisp_string()", __FILE__, __LINE__);
846 return obj->v.string;
850 lisp_boolean (lisp_object_t *obj)
852 if (obj->type != LISP_TYPE_BOOLEAN)
853 throw LispReaderException("lisp_boolean()", __FILE__, __LINE__);
855 return obj->v.integer;
859 lisp_real (lisp_object_t *obj)
861 if (obj->type != LISP_TYPE_REAL && obj->type != LISP_TYPE_INTEGER)
862 throw LispReaderException("lisp_real()", __FILE__, __LINE__);
864 if (obj->type == LISP_TYPE_INTEGER)
865 return obj->v.integer;
870 lisp_car (lisp_object_t *obj)
872 if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
873 throw LispReaderException("lisp_car()", __FILE__, __LINE__);
875 return obj->v.cons.car;
879 lisp_cdr (lisp_object_t *obj)
881 if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
882 throw LispReaderException("lisp_cdr()", __FILE__, __LINE__);
884 return obj->v.cons.cdr;
888 lisp_cxr (lisp_object_t *obj, const char *x)
892 for (i = strlen(x) - 1; i >= 0; --i)
895 else if (x[i] == 'd')
898 throw LispReaderException("lisp_cxr()", __FILE__, __LINE__);
904 lisp_list_length (lisp_object_t *obj)
910 if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
911 throw LispReaderException("lisp_list_length()", __FILE__, __LINE__);
914 obj = obj->v.cons.cdr;
921 lisp_list_nth_cdr (lisp_object_t *obj, int index)
926 throw LispReaderException("lisp_list_nth_cdr()", __FILE__, __LINE__);
927 if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
928 throw LispReaderException("lisp_list_nth_cdr()", __FILE__, __LINE__);
931 obj = obj->v.cons.cdr;
938 lisp_list_nth (lisp_object_t *obj, int index)
940 obj = lisp_list_nth_cdr(obj, index);
943 throw LispReaderException("lisp_list_nth()", __FILE__, __LINE__);
945 return obj->v.cons.car;
949 lisp_dump (lisp_object_t *obj, FILE *out)
957 switch (lisp_type(obj))
960 fputs("#<eof>", out);
963 case LISP_TYPE_PARSE_ERROR :
964 fputs("#<error>", out);
967 case LISP_TYPE_INTEGER :
968 fprintf(out, "%d", lisp_integer(obj));
971 case LISP_TYPE_REAL :
972 fprintf(out, "%f", lisp_real(obj));
975 case LISP_TYPE_SYMBOL :
976 fputs(lisp_symbol(obj), out);
979 case LISP_TYPE_STRING :
984 for (p = lisp_string(obj); *p != 0; ++p)
986 if (*p == '"' || *p == '\\')
994 case LISP_TYPE_CONS :
995 case LISP_TYPE_PATTERN_CONS :
996 fputs(lisp_type(obj) == LISP_TYPE_CONS ? "(" : "#?(", out);
999 lisp_dump(lisp_car(obj), out);
1000 obj = lisp_cdr(obj);
1003 if (lisp_type(obj) != LISP_TYPE_CONS
1004 && lisp_type(obj) != LISP_TYPE_PATTERN_CONS)
1007 lisp_dump(obj, out);
1017 case LISP_TYPE_BOOLEAN :
1018 if (lisp_boolean(obj))
1025 throw LispReaderException("lisp_dump()", __FILE__, __LINE__);
1029 using namespace std;
1031 LispReader::LispReader (lisp_object_t* l)
1036 LispReader::~LispReader()
1043 LispReader::load(const std::string& filename, const std::string& toplevellist)
1045 lisp_object_t* obj = lisp_read_from_file(filename);
1047 if(obj->type == LISP_TYPE_EOF || obj->type == LISP_TYPE_PARSE_ERROR) {
1049 throw LispReaderException("LispReader::load", __FILE__, __LINE__);
1052 if(toplevellist != lisp_symbol(lisp_car(obj))) {
1054 throw LispReaderException("LispReader::load wrong toplevel symbol",
1055 __FILE__, __LINE__);
1058 LispReader* reader = new LispReader(lisp_cdr(obj));
1059 reader->owner = obj;
1065 LispReader::search_for(const char* name)
1067 //std::cout << "LispReader::search_for(" << name << ")" << std::endl;
1068 lisp_object_t* cursor = lst;
1070 while(!lisp_nil_p(cursor))
1072 lisp_object_t* cur = lisp_car(cursor);
1074 if (!lisp_cons_p(cur) || !lisp_symbol_p (lisp_car(cur)))
1076 lisp_dump(cur, stdout);
1077 //throw ConstruoError (std::string("LispReader: Read error in search_for ") + name);
1078 printf("LispReader: Read error in search\n");
1082 if (strcmp(lisp_symbol(lisp_car(cur)), name) == 0)
1084 return lisp_cdr(cur);
1088 cursor = lisp_cdr (cursor);
1094 LispReader::read_int (const char* name, int& i)
1096 lisp_object_t* obj = search_for (name);
1100 if (!lisp_integer_p(lisp_car(obj)))
1103 i = lisp_integer(lisp_car(obj));
1108 LispReader::read_lisp(const char* name, lisp_object_t*& b)
1110 lisp_object_t* obj = search_for (name);
1119 LispReader::read_lisp(const char* name)
1121 return search_for(name);
1125 LispReader::read_float (const char* name, float& f)
1127 lisp_object_t* obj = search_for (name);
1131 if (!lisp_real_p(lisp_car(obj)) && !lisp_integer_p(lisp_car(obj)))
1132 st_abort("LispReader expected type real at token: ", name);
1134 f = lisp_real(lisp_car(obj));
1139 LispReader::read_string_vector (const char* name, std::vector<std::string>& vec)
1141 lisp_object_t* obj = search_for (name);
1146 while(!lisp_nil_p(obj))
1148 if (!lisp_string_p(lisp_car(obj)))
1149 st_abort("LispReader expected type string at token: ", name);
1150 vec.push_back(lisp_string(lisp_car(obj)));
1151 obj = lisp_cdr(obj);
1157 LispReader::read_int_vector (const char* name, std::vector<int>& vec)
1159 lisp_object_t* obj = search_for (name);
1164 while(!lisp_nil_p(obj))
1166 if (!lisp_integer_p(lisp_car(obj)))
1167 st_abort("LispReader expected type integer at token: ", name);
1168 vec.push_back(lisp_integer(lisp_car(obj)));
1169 obj = lisp_cdr(obj);
1175 LispReader::read_int_vector (const char* name, std::vector<unsigned int>& vec)
1177 lisp_object_t* obj = search_for (name);
1182 while(!lisp_nil_p(obj))
1184 if (!lisp_integer_p(lisp_car(obj)))
1185 st_abort("LispReader expected type integer at token: ", name);
1186 vec.push_back(lisp_integer(lisp_car(obj)));
1187 obj = lisp_cdr(obj);
1193 LispReader::read_char_vector (const char* name, std::vector<char>& vec)
1195 lisp_object_t* obj = search_for (name);
1200 while(!lisp_nil_p(obj))
1202 vec.push_back(*lisp_string(lisp_car(obj)));
1203 obj = lisp_cdr(obj);
1209 LispReader::read_string (const char* name, std::string& str, bool translatable)
1214 /* Internationalization support: check for the suffix: str + "-" + $LANG variable.
1215 If not found, use the regular string.
1216 So, translating a string in a Lisp file would result in something like:
1217 (text "Hello World!")
1218 (text-fr "Bonjour Monde!")
1219 being fr the value of LANG (echo $LANG) for the language we want to translate to */
1221 char str_[1024]; // check, for instance, for (title-fr_FR "Bonjour")
1222 sprintf(str_, "%s-%s", name, getenv("LANG"));
1224 obj = search_for (str_);
1226 if(!obj) // check, for instance, for (title-fr "Bonjour")
1229 strncpy(lang, getenv("LANG"), 2);
1231 sprintf(str_, "%s-%s", name, lang);
1233 obj = search_for (str_);
1236 if(!obj) // check, for instance, for (title "Hello")
1237 obj = search_for (name);
1240 obj = search_for (name);
1245 if (!lisp_string_p(lisp_car(obj)))
1246 st_abort("LispReader expected type string at token: ", name);
1247 str = lisp_string(lisp_car(obj));
1252 LispReader::read_bool (const char* name, bool& b)
1254 lisp_object_t* obj = search_for (name);
1258 if (!lisp_boolean_p(lisp_car(obj)))
1259 st_abort("LispReader expected type bool at token: ", name);
1260 b = lisp_boolean(lisp_car(obj));
1265 LispReader::get_lisp()
1270 lisp_object_t* lisp_read_from_file(const std::string& filename)
1272 FILE* in = fopen(filename.c_str(), "r");
1277 lisp_stream_t stream;
1278 lisp_stream_init_file(&stream, in);
1279 lisp_object_t* obj = lisp_read(&stream);