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;
573 if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL)
576 type_name = lisp_symbol(lisp_car(*obj));
577 for (i = 0; types[i].name != 0; ++i)
579 if (strcmp(types[i].name, type_name) == 0)
581 type = types[i].type;
586 if (types[i].name == 0)
589 if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0)
592 pattern = lisp_make_pattern_var(type, (*index)++, lisp_nil());
594 if (type == LISP_PATTERN_OR)
596 lisp_object_t *cdr = lisp_cdr(*obj);
598 if (!_compile_pattern(&cdr, index))
604 pattern->v.pattern.sub = cdr;
606 (*obj)->v.cons.cdr = lisp_nil();
615 case LISP_TYPE_CONS :
616 if (!_compile_pattern(&(*obj)->v.cons.car, index))
618 if (!_compile_pattern(&(*obj)->v.cons.cdr, index))
627 lisp_compile_pattern (lisp_object_t **obj, int *num_subs)
632 result = _compile_pattern(obj, &index);
634 if (result && num_subs != 0)
640 static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars);
643 _match_pattern_var (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
645 assert(lisp_type(pattern) == LISP_TYPE_PATTERN_VAR);
647 switch (pattern->v.pattern.type)
649 case LISP_PATTERN_ANY :
652 case LISP_PATTERN_SYMBOL :
653 if (obj == 0 || lisp_type(obj) != LISP_TYPE_SYMBOL)
657 case LISP_PATTERN_STRING :
658 if (obj == 0 || lisp_type(obj) != LISP_TYPE_STRING)
662 case LISP_PATTERN_INTEGER :
663 if (obj == 0 || lisp_type(obj) != LISP_TYPE_INTEGER)
667 case LISP_PATTERN_REAL :
668 if (obj == 0 || lisp_type(obj) != LISP_TYPE_REAL)
672 case LISP_PATTERN_BOOLEAN :
673 if (obj == 0 || lisp_type(obj) != LISP_TYPE_BOOLEAN)
677 case LISP_PATTERN_LIST :
678 if (obj == 0 || lisp_type(obj) != LISP_TYPE_CONS)
682 case LISP_PATTERN_OR :
687 for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub))
689 assert(lisp_type(sub) == LISP_TYPE_CONS);
691 if (_match_pattern(lisp_car(sub), obj, vars))
705 vars[pattern->v.pattern.index] = obj;
711 _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars)
719 if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR)
720 return _match_pattern_var(pattern, obj, vars);
722 if (lisp_type(pattern) != lisp_type(obj))
725 switch (lisp_type(pattern))
727 case LISP_TYPE_SYMBOL :
728 return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0;
730 case LISP_TYPE_STRING :
731 return strcmp(lisp_string(pattern), lisp_string(obj)) == 0;
733 case LISP_TYPE_INTEGER :
734 return lisp_integer(pattern) == lisp_integer(obj);
736 case LISP_TYPE_REAL :
737 return lisp_real(pattern) == lisp_real(obj);
739 case LISP_TYPE_CONS :
741 int result1, result2;
743 result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars);
744 result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars);
746 return result1 && result2;
758 lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs)
763 for (i = 0; i < num_subs; ++i)
764 vars[i] = &error_object;
766 return _match_pattern(pattern, obj, vars);
770 lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars)
772 lisp_object_t *pattern;
776 pattern = lisp_read_from_string(pattern_string);
778 if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF
779 || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR))
782 if (!lisp_compile_pattern(&pattern, &num_subs))
788 result = lisp_match_pattern(pattern, obj, vars, num_subs);
796 lisp_type (lisp_object_t *obj)
799 return LISP_TYPE_NIL;
804 lisp_integer (lisp_object_t *obj)
806 assert(obj->type == LISP_TYPE_INTEGER);
808 return obj->v.integer;
812 lisp_symbol (lisp_object_t *obj)
814 assert(obj->type == LISP_TYPE_SYMBOL);
816 return obj->v.string;
820 lisp_string (lisp_object_t *obj)
822 assert(obj->type == LISP_TYPE_STRING);
824 return obj->v.string;
828 lisp_boolean (lisp_object_t *obj)
830 assert(obj->type == LISP_TYPE_BOOLEAN);
832 return obj->v.integer;
836 lisp_real (lisp_object_t *obj)
838 assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER);
840 if (obj->type == LISP_TYPE_INTEGER)
841 return obj->v.integer;
846 lisp_car (lisp_object_t *obj)
848 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
850 return obj->v.cons.car;
854 lisp_cdr (lisp_object_t *obj)
856 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
858 return obj->v.cons.cdr;
862 lisp_cxr (lisp_object_t *obj, const char *x)
866 for (i = strlen(x) - 1; i >= 0; --i)
869 else if (x[i] == 'd')
878 lisp_list_length (lisp_object_t *obj)
884 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
887 obj = obj->v.cons.cdr;
894 lisp_list_nth_cdr (lisp_object_t *obj, int index)
899 assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
902 obj = obj->v.cons.cdr;
909 lisp_list_nth (lisp_object_t *obj, int index)
911 obj = lisp_list_nth_cdr(obj, index);
915 return obj->v.cons.car;
919 lisp_dump (lisp_object_t *obj, FILE *out)
927 switch (lisp_type(obj))
930 fputs("#<eof>", out);
933 case LISP_TYPE_PARSE_ERROR :
934 fputs("#<error>", out);
937 case LISP_TYPE_INTEGER :
938 fprintf(out, "%d", lisp_integer(obj));
941 case LISP_TYPE_REAL :
942 fprintf(out, "%f", lisp_real(obj));
945 case LISP_TYPE_SYMBOL :
946 fputs(lisp_symbol(obj), out);
949 case LISP_TYPE_STRING :
954 for (p = lisp_string(obj); *p != 0; ++p)
956 if (*p == '"' || *p == '\\')
964 case LISP_TYPE_CONS :
965 case LISP_TYPE_PATTERN_CONS :
966 fputs(lisp_type(obj) == LISP_TYPE_CONS ? "(" : "#?(", out);
969 lisp_dump(lisp_car(obj), out);
973 if (lisp_type(obj) != LISP_TYPE_CONS
974 && lisp_type(obj) != LISP_TYPE_PATTERN_CONS)
987 case LISP_TYPE_BOOLEAN :
988 if (lisp_boolean(obj))
1001 LispReader::LispReader (lisp_object_t* l)
1004 //std::cout << "LispReader: " << std::flush;
1005 //lisp_dump(lst, stdout);
1006 //std::cout << std::endl;
1010 LispReader::search_for(const char* name)
1012 //std::cout << "LispReader::search_for(" << name << ")" << std::endl;
1013 lisp_object_t* cursor = lst;
1015 while(!lisp_nil_p(cursor))
1017 lisp_object_t* cur = lisp_car(cursor);
1019 if (!lisp_cons_p(cur) || !lisp_symbol_p (lisp_car(cur)))
1021 lisp_dump(cur, stdout);
1022 //throw ConstruoError (std::string("LispReader: Read error in search_for ") + name);
1023 printf("LispReader: Read error in search\n");
1027 if (strcmp(lisp_symbol(lisp_car(cur)), name) == 0)
1029 return lisp_cdr(cur);
1033 cursor = lisp_cdr (cursor);
1039 LispReader::read_int (const char* name, int* i)
1041 lisp_object_t* obj = search_for (name);
1044 *i = lisp_integer(lisp_car(obj));
1051 LispReader::read_float (const char* name, float* f)
1053 lisp_object_t* obj = search_for (name);
1056 *f = lisp_real(lisp_car(obj));
1063 LispReader::read_string_vector (const char* name, std::vector<std::string>* vec)
1065 lisp_object_t* obj = search_for (name);
1068 while(!lisp_nil_p(obj))
1070 vec->push_back(lisp_string(lisp_car(obj)));
1071 obj = lisp_cdr(obj);
1079 LispReader::read_int_vector (const char* name, std::vector<int>* vec)
1081 lisp_object_t* obj = search_for (name);
1084 while(!lisp_nil_p(obj))
1086 vec->push_back(lisp_integer(lisp_car(obj)));
1087 obj = lisp_cdr(obj);
1095 LispReader::read_char_vector (const char* name, std::vector<char>* vec)
1097 lisp_object_t* obj = search_for (name);
1100 while(!lisp_nil_p(obj))
1102 vec->push_back(*lisp_string(lisp_car(obj)));
1103 obj = lisp_cdr(obj);
1111 LispReader::read_string (const char* name, std::string* str)
1113 lisp_object_t* obj = search_for (name);
1117 *str = lisp_string(lisp_car(obj));
1124 LispReader::read_bool (const char* name, bool* b)
1126 lisp_object_t* obj = search_for (name);
1129 *b = lisp_boolean(lisp_car(obj));
1135 LispWriter::LispWriter (const char* name)
1137 lisp_objs.push_back(lisp_make_symbol (name));
1141 LispWriter::append (lisp_object_t* obj)
1143 lisp_objs.push_back(obj);
1147 LispWriter::make_list3 (lisp_object_t* a, lisp_object_t* b, lisp_object_t* c)
1149 return lisp_make_cons (a, lisp_make_cons(b, lisp_make_cons(c, lisp_nil())));
1153 LispWriter::make_list2 (lisp_object_t* a, lisp_object_t* b)
1155 return lisp_make_cons (a, lisp_make_cons(b, lisp_nil()));
1159 LispWriter::write_float (const char* name, float f)
1161 append(make_list2 (lisp_make_symbol (name),
1162 lisp_make_real(f)));
1166 LispWriter::write_int (const char* name, int i)
1168 append(make_list2 (lisp_make_symbol (name),
1169 lisp_make_integer(i)));
1173 LispWriter::write_string (const char* name, const char* str)
1175 append(make_list2 (lisp_make_symbol (name),
1176 lisp_make_string(str)));
1180 LispWriter::write_symbol (const char* name, const char* symname)
1182 append(make_list2 (lisp_make_symbol (name),
1183 lisp_make_symbol(symname)));
1187 LispWriter::write_lisp_obj(const char* name, lisp_object_t* lst)
1189 append(make_list2 (lisp_make_symbol (name),
1194 LispWriter::write_boolean (const char* name, bool b)
1196 append(make_list2 (lisp_make_symbol (name),
1197 lisp_make_boolean(b)));
1201 LispWriter::create_lisp ()
1203 lisp_object_t* lisp_obj = lisp_nil();
1205 for(std::vector<lisp_object_t*>::reverse_iterator i = lisp_objs.rbegin ();
1206 i != lisp_objs.rend (); ++i)
1208 lisp_obj = lisp_make_cons (*i, lisp_obj);
1216 void mygzungetc(char c, void* file)
1221 lisp_stream_t* lisp_stream_init_gzfile (lisp_stream_t *stream, gzFile file)
1223 return lisp_stream_init_any (stream, file, gzgetc, mygzungetc);
1227 lisp_object_t* lisp_read_from_gzfile(const char* filename)
1230 lisp_object_t* root_obj = 0;
1231 int chunk_size = 128 * 1024;
1234 char* buf = static_cast<char*>(malloc(chunk_size));
1237 gzFile in = gzopen(filename, "r");
1241 int ret = gzread(in, buf + buf_pos, chunk_size);
1245 assert(!"Error while reading from file");
1247 else if (ret == chunk_size) // buffer got full, eof not yet there so resize
1249 buf_pos = chunk_size * try_number;
1251 buf = static_cast<char*>(realloc(buf, chunk_size * try_number));
1256 // everything fine, encountered EOF
1261 lisp_stream_t stream;
1262 lisp_stream_init_string (&stream, buf);
1263 root_obj = lisp_read (&stream);
1271 bool has_suffix(const char* data, const char* suffix)
1273 int suffix_len = strlen(suffix);
1274 int data_len = strlen(data);
1276 const char* data_suffix = (data + data_len - suffix_len);
1278 if (data_suffix >= data)
1280 return (strcmp(data_suffix, suffix) == 0);
1288 lisp_object_t* lisp_read_from_file(const std::string& filename)
1290 lisp_stream_t stream;
1292 if (has_suffix(filename.c_str(), ".gz"))
1294 return lisp_read_from_gzfile(filename.c_str());
1296 lisp_object_t* obj = 0;
1297 gzFile in = gzopen(filename, "r");
1301 lisp_stream_init_gzfile(&stream, in);
1302 obj = lisp_read(&stream);
1310 lisp_object_t* obj = 0;
1311 FILE* in = fopen(filename.c_str(), "r");
1315 lisp_stream_init_file(&stream, in);
1316 obj = lisp_read(&stream);