* Boston, MA 02111-1307, USA.
*/
+#include <iostream>
#include <string>
-#include <assert.h>
#include <ctype.h>
#include <stdlib.h>
#include <string.h>
-
+#include "setup.h"
#include "lispreader.h"
#define TOKEN_ERROR -1
static char token_string[MAX_TOKEN_LENGTH + 1] = "";
static int token_length = 0;
-static lisp_object_t end_marker = { LISP_TYPE_EOF };
-static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR };
-static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR };
-static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR };
+static lisp_object_t end_marker = { LISP_TYPE_EOF, {{0, 0}} };
+static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR , {{0,0}} };
+static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR , {{0,0}} };
+static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR , {{0,0}} };
static void
_token_clear (void)
static void
_token_append (char c)
{
- assert(token_length < MAX_TOKEN_LENGTH);
+ if (token_length >= MAX_TOKEN_LENGTH)
+ throw LispReaderException("_token_append()", __FILE__, __LINE__);
token_string[token_length++] = c;
token_string[token_length] = '\0';
case LISP_STREAM_ANY:
return stream->v.any.next_char(stream->v.any.data);
}
- assert(0);
+
+ throw LispReaderException("_next_char()", __FILE__, __LINE__);
return EOF;
}
break;
default :
- assert(0);
+ throw LispReaderException("_unget_char()", __FILE__, __LINE__);
}
}
}
}
- assert(0);
+ throw LispReaderException("_scan()", __FILE__, __LINE__);
return TOKEN_ERROR;
}
int (*next_char) (void *data),
void (*unget_char) (char c, void *data))
{
- assert(next_char != 0 && unget_char != 0);
+ if (next_char == 0 || unget_char == 0)
+ throw LispReaderException("lisp_stream_init_any()", __FILE__, __LINE__);
stream->type = LISP_STREAM_ANY;
stream->v.any.data = data;
return lisp_make_boolean(0);
}
- assert(0);
+ throw LispReaderException("lisp_read()", __FILE__, __LINE__);
return &error_object;
}
int type;
int i;
lisp_object_t *pattern;
-
+ type = -1;
+
if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL)
return 0;
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);
+ if (lisp_type(pattern) != LISP_TYPE_PATTERN_VAR)
+ throw LispReaderException("_match_pattern_var", __FILE__, __LINE__);
switch (pattern->v.pattern.type)
{
for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub))
{
- assert(lisp_type(sub) == LISP_TYPE_CONS);
+ if (lisp_type(sub) != LISP_TYPE_CONS)
+ throw LispReaderException("_match_pattern_var()", __FILE__, __LINE__);
if (_match_pattern(lisp_car(sub), obj, vars))
matched = 1;
break;
default :
- assert(0);
+ throw LispReaderException("_match_pattern_var()", __FILE__, __LINE__);
}
if (vars != 0)
break;
default :
- assert(0);
+ throw LispReaderException("_match_pattern()", __FILE__, __LINE__);
}
return 0;
int
lisp_integer (lisp_object_t *obj)
{
- assert(obj->type == LISP_TYPE_INTEGER);
+ if (obj->type != LISP_TYPE_INTEGER)
+ throw LispReaderException("lisp_integer()", __FILE__, __LINE__);
return obj->v.integer;
}
char*
lisp_symbol (lisp_object_t *obj)
{
- assert(obj->type == LISP_TYPE_SYMBOL);
+ if (obj->type != LISP_TYPE_SYMBOL)
+ throw LispReaderException("lisp_symbol()", __FILE__, __LINE__);
return obj->v.string;
}
char*
lisp_string (lisp_object_t *obj)
{
- assert(obj->type == LISP_TYPE_STRING);
+ if (obj->type != LISP_TYPE_STRING)
+ throw LispReaderException("lisp_string()", __FILE__, __LINE__);
return obj->v.string;
}
int
lisp_boolean (lisp_object_t *obj)
{
- assert(obj->type == LISP_TYPE_BOOLEAN);
+ if (obj->type != LISP_TYPE_BOOLEAN)
+ throw LispReaderException("lisp_boolean()", __FILE__, __LINE__);
return obj->v.integer;
}
float
lisp_real (lisp_object_t *obj)
{
- assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER);
+ if (obj->type != LISP_TYPE_REAL && obj->type != LISP_TYPE_INTEGER)
+ throw LispReaderException("lisp_real()", __FILE__, __LINE__);
if (obj->type == LISP_TYPE_INTEGER)
return obj->v.integer;
lisp_object_t*
lisp_car (lisp_object_t *obj)
{
- assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
+ if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
+ throw LispReaderException("lisp_car()", __FILE__, __LINE__);
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);
+ if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
+ throw LispReaderException("lisp_cdr()", __FILE__, __LINE__);
return obj->v.cons.cdr;
}
else if (x[i] == 'd')
obj = lisp_cdr(obj);
else
- assert(0);
+ throw LispReaderException("lisp_cxr()", __FILE__, __LINE__);
return obj;
}
while (obj != 0)
{
- assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
+ if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
+ throw LispReaderException("lisp_list_length()", __FILE__, __LINE__);
++length;
obj = obj->v.cons.cdr;
{
while (index > 0)
{
- assert(obj != 0);
- assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
+ if (obj == 0)
+ throw LispReaderException("lisp_list_nth_cdr()", __FILE__, __LINE__);
+ if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
+ throw LispReaderException("lisp_list_nth_cdr()", __FILE__, __LINE__);
--index;
obj = obj->v.cons.cdr;
{
obj = lisp_list_nth_cdr(obj, index);
- assert(obj != 0);
+ if (obj == 0)
+ throw LispReaderException("lisp_list_nth()", __FILE__, __LINE__);
return obj->v.cons.car;
}
break;
default :
- assert(0);
+ throw LispReaderException("lisp_dump()", __FILE__, __LINE__);
}
}
lisp_object_t* obj = search_for (name);
if (obj)
{
+ if (!lisp_integer_p(lisp_car(obj)))
+ {
+ //st_abort("LispReader expected type integer at token: ", name); /* Instead of giving up, we return with false now. */
+ return false;
+ }
*i = lisp_integer(lisp_car(obj));
return true;
}
}
bool
+LispReader::read_lisp(const char* name, lisp_object_t** b)
+{
+ lisp_object_t* obj = search_for (name);
+ if (obj)
+ {
+ *b = obj;
+ return true;
+ }
+ else
+ return false;
+}
+
+bool
LispReader::read_float (const char* name, float* f)
{
lisp_object_t* obj = search_for (name);
if (obj)
{
+ if (!lisp_real_p(lisp_car(obj)) && !lisp_integer_p(lisp_car(obj)))
+ st_abort("LispReader expected type real at token: ", name);
*f = lisp_real(lisp_car(obj));
return true;
}
}
bool
-LispReader::read_int_vector (const char* name, std::vector<int>* vec)
+LispReader::read_string_vector (const char* name, std::vector<std::string>* vec)
{
lisp_object_t* obj = search_for (name);
if (obj)
{
while(!lisp_nil_p(obj))
{
- vec->push_back(lisp_integer(lisp_car(obj)));
+ if (!lisp_string_p(lisp_car(obj)))
+ st_abort("LispReader expected type string at token: ", name);
+ vec->push_back(lisp_string(lisp_car(obj)));
obj = lisp_cdr(obj);
}
return true;
}
bool
-LispReader::read_string (const char* name, std::string* str)
+LispReader::read_int_vector (const char* name, std::vector<int>* vec)
{
+ vec->clear();
lisp_object_t* obj = search_for (name);
if (obj)
{
- *str = lisp_string(lisp_car(obj));
+ while(!lisp_nil_p(obj))
+ {
+ if (!lisp_integer_p(lisp_car(obj)))
+ st_abort("LispReader expected type integer at token: ", name);
+ vec->push_back(lisp_integer(lisp_car(obj)));
+ obj = lisp_cdr(obj);
+ }
return true;
}
- return false;
+ return false;
}
bool
-LispReader::read_bool (const char* name, bool* b)
+LispReader::read_int_vector (const char* name, std::vector<unsigned int>* vec)
{
+ vec->clear();
lisp_object_t* obj = search_for (name);
if (obj)
{
- *b = lisp_boolean(lisp_car(obj));
+ while(!lisp_nil_p(obj))
+ {
+ if (!lisp_integer_p(lisp_car(obj)))
+ st_abort("LispReader expected type integer at token: ", name);
+ vec->push_back(lisp_integer(lisp_car(obj)));
+ obj = lisp_cdr(obj);
+ }
return true;
}
- return false;
+ return false;
}
-LispWriter::LispWriter (const char* name)
+bool
+LispReader::read_char_vector (const char* name, std::vector<char>* vec)
{
- lisp_objs.push_back(lisp_make_symbol (name));
+ lisp_object_t* obj = search_for (name);
+ if (obj)
+ {
+ while(!lisp_nil_p(obj))
+ {
+ vec->push_back(*lisp_string(lisp_car(obj)));
+ obj = lisp_cdr(obj);
+ }
+ return true;
+ }
+ return false;
}
-void
-LispWriter::append (lisp_object_t* obj)
+bool
+LispReader::read_string (const char* name, std::string* str)
{
- lisp_objs.push_back(obj);
+ lisp_object_t* obj = search_for (name);
+ if (obj)
+ {
+ if (!lisp_string_p(lisp_car(obj)))
+ st_abort("LispReader expected type string at token: ", name);
+ *str = lisp_string(lisp_car(obj));
+ return true;
+ }
+ return false;
}
-lisp_object_t*
-LispWriter::make_list3 (lisp_object_t* a, lisp_object_t* b, lisp_object_t* c)
+bool
+LispReader::read_bool (const char* name, bool* b)
{
- return lisp_make_cons (a, lisp_make_cons(b, lisp_make_cons(c, lisp_nil())));
+ lisp_object_t* obj = search_for (name);
+ if (obj)
+ {
+ if (!lisp_boolean_p(lisp_car(obj)))
+ st_abort("LispReader expected type bool at token: ", name);
+ *b = lisp_boolean(lisp_car(obj));
+ return true;
+ }
+ return false;
}
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)
+LispReader::get_lisp()
{
- append(make_list2 (lisp_make_symbol (name),
- lisp_make_real(f)));
+ return lst;
}
-void
-LispWriter::write_int (const char* name, int i)
+lisp_object_t* lisp_read_from_gzfile(const char* filename)
{
- append(make_list2 (lisp_make_symbol (name),
- lisp_make_integer(i)));
-}
+ bool done = false;
+ lisp_object_t* root_obj = 0;
+ int chunk_size = 128 * 1024;
+ int buf_pos = 0;
+ int try_number = 1;
+ char* buf = static_cast<char*>(malloc(chunk_size));
+ if (!buf)
+ throw LispReaderException("lisp_read_from_gzfile()", __FILE__, __LINE__);
+
+ gzFile in = gzopen(filename, "r");
+
+ while (!done)
+ {
+ int ret = gzread(in, buf + buf_pos, chunk_size);
+ if (ret == -1)
+ {
+ free (buf);
+ throw LispReaderException("Error while reading from file", __FILE__, __LINE__);
+ }
+ else if (ret == chunk_size) // buffer got full, eof not yet there so resize
+ {
+ buf_pos = chunk_size * try_number;
+ try_number += 1;
+ buf = static_cast<char*>(realloc(buf, chunk_size * try_number));
-void
-LispWriter::write_string (const char* name, const char* str)
-{
- append(make_list2 (lisp_make_symbol (name),
- lisp_make_string(str)));
-}
+ if (!buf)
+ throw LispReaderException("lisp_read_from_gzfile()", __FILE__, __LINE__);
+ }
+ else
+ {
+ // everything fine, encountered EOF
+ done = true;
+ }
+ }
+
+ lisp_stream_t stream;
+ lisp_stream_init_string (&stream, buf);
+ root_obj = lisp_read (&stream);
+
+ free(buf);
+ gzclose(in);
-void
-LispWriter::write_symbol (const char* name, const char* symname)
-{
- append(make_list2 (lisp_make_symbol (name),
- lisp_make_symbol(symname)));
+ return root_obj;
}
-void
-LispWriter::write_lisp_obj(const char* name, lisp_object_t* lst)
+bool has_suffix(const char* data, const char* suffix)
{
- append(make_list2 (lisp_make_symbol (name),
- lst));
-}
+ int suffix_len = strlen(suffix);
+ int data_len = strlen(data);
+
+ const char* data_suffix = (data + data_len - suffix_len);
-void
-LispWriter::write_boolean (const char* name, bool b)
-{
- append(make_list2 (lisp_make_symbol (name),
- lisp_make_boolean(b)));
+ if (data_suffix >= data)
+ {
+ return (strcmp(data_suffix, suffix) == 0);
+ }
+ else
+ {
+ return false;
+ }
}
-lisp_object_t*
-LispWriter::create_lisp ()
+lisp_object_t* lisp_read_from_file(const std::string& filename)
{
- lisp_object_t* lisp_obj = lisp_nil();
+ lisp_stream_t stream;
- for(std::vector<lisp_object_t*>::reverse_iterator i = lisp_objs.rbegin ();
- i != lisp_objs.rend (); ++i)
+ if (has_suffix(filename.c_str(), ".gz"))
{
- lisp_obj = lisp_make_cons (*i, lisp_obj);
+ return lisp_read_from_gzfile(filename.c_str());
}
- lisp_objs.clear();
+ else
+ {
+ lisp_object_t* obj = 0;
+ FILE* in = fopen(filename.c_str(), "r");
+
+ if (in)
+ {
+ lisp_stream_init_file(&stream, in);
+ obj = lisp_read(&stream);
+ fclose(in);
+ }
- return lisp_obj;
+ return obj;
+ }
}
+// EOF //