*** empty log message ***
This commit is contained in:
parent
5615eb8208
commit
250170a4f8
188
ase/lsp/eval.c
188
ase/lsp/eval.c
@ -1,36 +1,36 @@
|
||||
/*
|
||||
* $Id: eval.c,v 1.7 2005-05-28 13:34:26 bacon Exp $
|
||||
* $Id: eval.c,v 1.8 2005-09-18 10:18:35 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/lsp/lisp.h>
|
||||
#include <xp/lsp/lsp.h>
|
||||
#include <xp/lsp/env.h>
|
||||
#include <xp/lsp/primitive.h>
|
||||
#include <xp/lsp/prim.h>
|
||||
#include <xp/bas/assert.h>
|
||||
|
||||
static xp_lisp_obj_t* make_func (xp_lisp_t* lsp, xp_lisp_obj_t* cdr, int is_macro);
|
||||
static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons);
|
||||
static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* actual);
|
||||
static xp_lsp_obj_t* make_func (xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro);
|
||||
static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons);
|
||||
static xp_lsp_obj_t* apply (xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* actual);
|
||||
|
||||
xp_lisp_obj_t* xp_lisp_eval (xp_lisp_t* lsp, xp_lisp_obj_t* obj)
|
||||
xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj)
|
||||
{
|
||||
lsp->error = XP_LISP_ERR_NONE;
|
||||
lsp->errnum = XP_LSP_ERR_NONE;
|
||||
|
||||
if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS)
|
||||
if (XP_LSP_TYPE(obj) == XP_LSP_OBJ_CONS)
|
||||
return eval_cons (lsp, obj);
|
||||
else if (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL) {
|
||||
xp_lisp_assoc_t* assoc;
|
||||
else if (XP_LSP_TYPE(obj) == XP_LSP_OBJ_SYMBOL) {
|
||||
xp_lsp_assoc_t* assoc;
|
||||
|
||||
/*
|
||||
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
|
||||
printf ("lambda or macro can't be used as a normal symbol\n");
|
||||
lsp->error = XP_LISP_ERR_BAD_SYMBOL;
|
||||
lsp->errnum = XP_LSP_ERR_BAD_SYMBOL;
|
||||
return XP_NULL;
|
||||
}
|
||||
*/
|
||||
|
||||
if ((assoc = xp_lisp_lookup (lsp->mem, obj)) == XP_NULL) {
|
||||
if ((assoc = xp_lsp_lookup (lsp->mem, obj)) == XP_NULL) {
|
||||
if (lsp->opt_undef_symbol) {
|
||||
lsp->error = XP_LISP_ERR_UNDEF_SYMBOL;
|
||||
lsp->errnum = XP_LSP_ERR_UNDEF_SYMBOL;
|
||||
return XP_NULL;
|
||||
}
|
||||
return lsp->mem->nil;
|
||||
@ -42,50 +42,50 @@ xp_lisp_obj_t* xp_lisp_eval (xp_lisp_t* lsp, xp_lisp_obj_t* obj)
|
||||
return obj;
|
||||
}
|
||||
|
||||
static xp_lisp_obj_t* make_func (xp_lisp_t* lsp, xp_lisp_obj_t* cdr, int is_macro)
|
||||
static xp_lsp_obj_t* make_func (xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro)
|
||||
{
|
||||
// TODO: lambda expression syntax check.
|
||||
xp_lisp_obj_t* func, * formal, * body;
|
||||
xp_lsp_obj_t* func, * formal, * body;
|
||||
|
||||
printf ("about to create a function or a macro ....\n");
|
||||
xp_printf (XP_TEXT("about to create a function or a macro ....\n"));
|
||||
|
||||
if (cdr == lsp->mem->nil) {
|
||||
lsp->error = XP_LISP_ERR_TOO_FEW_ARGS;
|
||||
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS;
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
if (XP_LISP_TYPE(cdr) != XP_LISP_OBJ_CONS) {
|
||||
lsp->error = XP_LISP_ERR_BAD_ARG;
|
||||
if (XP_LSP_TYPE(cdr) != XP_LSP_OBJ_CONS) {
|
||||
lsp->errnum = XP_LSP_ERR_BAD_ARG;
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
formal = XP_LISP_CAR(cdr);
|
||||
body = XP_LISP_CDR(cdr);
|
||||
formal = XP_LSP_CAR(cdr);
|
||||
body = XP_LSP_CDR(cdr);
|
||||
|
||||
if (body == lsp->mem->nil) {
|
||||
lsp->error = XP_LISP_ERR_EMPTY_BODY;
|
||||
lsp->errnum = XP_LSP_ERR_EMPTY_BODY;
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
func = (is_macro)?
|
||||
xp_lisp_make_macro (lsp->mem, formal, body):
|
||||
xp_lisp_make_func (lsp->mem, formal, body);
|
||||
xp_lsp_make_macro (lsp->mem, formal, body):
|
||||
xp_lsp_make_func (lsp->mem, formal, body);
|
||||
if (func == XP_NULL) {
|
||||
lsp->error = XP_LISP_ERR_MEM;
|
||||
lsp->errnum = XP_LSP_ERR_MEM;
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
return func;
|
||||
}
|
||||
|
||||
static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons)
|
||||
static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
|
||||
{
|
||||
xp_lisp_obj_t* car, * cdr;
|
||||
xp_lsp_obj_t* car, * cdr;
|
||||
|
||||
xp_assert (XP_LISP_TYPE(cons) == XP_LISP_OBJ_CONS);
|
||||
xp_assert (XP_LSP_TYPE(cons) == XP_LSP_OBJ_CONS);
|
||||
|
||||
car = XP_LISP_CAR(cons);
|
||||
cdr = XP_LISP_CDR(cons);
|
||||
car = XP_LSP_CAR(cons);
|
||||
cdr = XP_LSP_CDR(cons);
|
||||
|
||||
if (car == lsp->mem->lambda) {
|
||||
return make_func (lsp, cdr, 0);
|
||||
@ -93,89 +93,89 @@ static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons)
|
||||
else if (car == lsp->mem->macro) {
|
||||
return make_func (lsp, cdr, 1);
|
||||
}
|
||||
else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_SYMBOL) {
|
||||
xp_lisp_assoc_t* assoc;
|
||||
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_SYMBOL) {
|
||||
xp_lsp_assoc_t* assoc;
|
||||
|
||||
if ((assoc = xp_lisp_lookup (lsp->mem, car)) != XP_NULL) {
|
||||
xp_lisp_obj_t* func = assoc->value;
|
||||
if (XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
|
||||
XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) {
|
||||
if ((assoc = xp_lsp_lookup (lsp->mem, car)) != XP_NULL) {
|
||||
xp_lsp_obj_t* func = assoc->value;
|
||||
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_FUNC ||
|
||||
XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
|
||||
return apply (lsp, func, cdr);
|
||||
}
|
||||
else if (XP_LISP_TYPE(func) == XP_LISP_OBJ_PRIM) {
|
||||
else if (XP_LSP_TYPE(func) == XP_LSP_OBJ_PRIM) {
|
||||
// primitive function
|
||||
return XP_LISP_PIMPL(func) (lsp, cdr);
|
||||
return XP_LSP_PIMPL(func) (lsp, cdr);
|
||||
}
|
||||
else {
|
||||
printf ("undefined function: ");
|
||||
xp_lisp_print (lsp, car);
|
||||
xp_lsp_print (lsp, car);
|
||||
printf ("\n");
|
||||
lsp->error = XP_LISP_ERR_UNDEF_FUNC;
|
||||
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
|
||||
return XP_NULL;
|
||||
}
|
||||
}
|
||||
else {
|
||||
//TODO: better error handling.
|
||||
printf ("undefined function: ");
|
||||
xp_lisp_print (lsp, car);
|
||||
xp_lsp_print (lsp, car);
|
||||
printf ("\n");
|
||||
lsp->error = XP_LISP_ERR_UNDEF_FUNC;
|
||||
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
|
||||
return XP_NULL;
|
||||
}
|
||||
}
|
||||
else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_FUNC ||
|
||||
XP_LISP_TYPE(car) == XP_LISP_OBJ_MACRO) {
|
||||
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_FUNC ||
|
||||
XP_LSP_TYPE(car) == XP_LSP_OBJ_MACRO) {
|
||||
return apply (lsp, car, cdr);
|
||||
}
|
||||
else if (XP_LISP_TYPE(car) == XP_LISP_OBJ_CONS) {
|
||||
if (XP_LISP_CAR(car) == lsp->mem->lambda) {
|
||||
xp_lisp_obj_t* func = make_func (lsp, XP_LISP_CDR(car), 0);
|
||||
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_CONS) {
|
||||
if (XP_LSP_CAR(car) == lsp->mem->lambda) {
|
||||
xp_lsp_obj_t* func = make_func (lsp, XP_LSP_CDR(car), 0);
|
||||
if (func == XP_NULL) return XP_NULL;
|
||||
return apply (lsp, func, cdr);
|
||||
}
|
||||
else if (XP_LISP_CAR(car) == lsp->mem->macro) {
|
||||
xp_lisp_obj_t* func = make_func (lsp, XP_LISP_CDR(car), 1);
|
||||
else if (XP_LSP_CAR(car) == lsp->mem->macro) {
|
||||
xp_lsp_obj_t* func = make_func (lsp, XP_LSP_CDR(car), 1);
|
||||
if (func == XP_NULL) return XP_NULL;
|
||||
return apply (lsp, func, cdr);
|
||||
}
|
||||
}
|
||||
|
||||
xp_printf (XP_TEXT("bad function: "));
|
||||
xp_lisp_print (lsp, car);
|
||||
xp_lsp_print (lsp, car);
|
||||
xp_printf (XP_TEXT("\n"));
|
||||
lsp->error = XP_LISP_ERR_BAD_FUNC;
|
||||
lsp->errnum = XP_LSP_ERR_BAD_FUNC;
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t* actual)
|
||||
static xp_lsp_obj_t* apply (xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* actual)
|
||||
{
|
||||
xp_lisp_frame_t* frame;
|
||||
xp_lisp_obj_t* formal;
|
||||
xp_lisp_obj_t* body;
|
||||
xp_lisp_obj_t* value;
|
||||
xp_lisp_mem_t* mem;
|
||||
xp_lsp_frame_t* frame;
|
||||
xp_lsp_obj_t* formal;
|
||||
xp_lsp_obj_t* body;
|
||||
xp_lsp_obj_t* value;
|
||||
xp_lsp_mem_t* mem;
|
||||
|
||||
xp_assert (
|
||||
XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
|
||||
XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO);
|
||||
XP_LSP_TYPE(func) == XP_LSP_OBJ_FUNC ||
|
||||
XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO);
|
||||
|
||||
xp_assert (XP_LISP_TYPE(XP_LISP_CDR(func)) == XP_LISP_OBJ_CONS);
|
||||
xp_assert (XP_LSP_TYPE(XP_LSP_CDR(func)) == XP_LSP_OBJ_CONS);
|
||||
|
||||
mem = lsp->mem;
|
||||
|
||||
if (XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) {
|
||||
formal = XP_LISP_MFORMAL (func);
|
||||
body = XP_LISP_MBODY (func);
|
||||
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
|
||||
formal = XP_LSP_MFORMAL (func);
|
||||
body = XP_LSP_MBODY (func);
|
||||
}
|
||||
else {
|
||||
formal = XP_LISP_FFORMAL (func);
|
||||
body = XP_LISP_FBODY (func);
|
||||
formal = XP_LSP_FFORMAL (func);
|
||||
body = XP_LSP_FBODY (func);
|
||||
}
|
||||
|
||||
// make a new frame.
|
||||
frame = xp_lisp_frame_new ();
|
||||
frame = xp_lsp_frame_new ();
|
||||
if (frame == XP_NULL) {
|
||||
lsp->error = XP_LISP_ERR_MEM;
|
||||
lsp->errnum = XP_LSP_ERR_MEM;
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
@ -187,50 +187,50 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t*
|
||||
// evaluate arguments and push them into the frame.
|
||||
while (formal != mem->nil) {
|
||||
if (actual == mem->nil) {
|
||||
lsp->error = XP_LISP_ERR_TOO_FEW_ARGS;
|
||||
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS;
|
||||
mem->brooding_frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
value = XP_LISP_CAR(actual);
|
||||
if (XP_LISP_TYPE(func) != XP_LISP_OBJ_MACRO) {
|
||||
value = XP_LSP_CAR(actual);
|
||||
if (XP_LSP_TYPE(func) != XP_LSP_OBJ_MACRO) {
|
||||
// macro doesn't evaluate actual arguments.
|
||||
value = xp_lisp_eval (lsp, value);
|
||||
value = xp_lsp_eval (lsp, value);
|
||||
if (value == XP_NULL) {
|
||||
mem->brooding_frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
}
|
||||
|
||||
if (xp_lisp_frame_lookup (frame, XP_LISP_CAR(formal)) != XP_NULL) {
|
||||
lsp->error = XP_LISP_ERR_DUP_FORMAL;
|
||||
if (xp_lsp_frame_lookup (frame, XP_LSP_CAR(formal)) != XP_NULL) {
|
||||
lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
|
||||
mem->brooding_frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
if (xp_lisp_frame_insert (frame, XP_LISP_CAR(formal), value) == XP_NULL) {
|
||||
lsp->error = XP_LISP_ERR_MEM;
|
||||
if (xp_lsp_frame_insert (frame, XP_LSP_CAR(formal), value) == XP_NULL) {
|
||||
lsp->errnum = XP_LSP_ERR_MEM;
|
||||
mem->brooding_frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
actual = XP_LISP_CDR(actual);
|
||||
formal = XP_LISP_CDR(formal);
|
||||
actual = XP_LSP_CDR(actual);
|
||||
formal = XP_LSP_CDR(formal);
|
||||
}
|
||||
|
||||
if (XP_LISP_TYPE(actual) == XP_LISP_OBJ_CONS) {
|
||||
lsp->error = XP_LISP_ERR_TOO_MANY_ARGS;
|
||||
if (XP_LSP_TYPE(actual) == XP_LSP_OBJ_CONS) {
|
||||
lsp->errnum = XP_LSP_ERR_TOO_MANY_ARGS;
|
||||
mem->brooding_frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
else if (actual != mem->nil) {
|
||||
lsp->error = XP_LISP_ERR_BAD_ARG;
|
||||
lsp->errnum = XP_LSP_ERR_BAD_ARG;
|
||||
mem->brooding_frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
@ -242,24 +242,24 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t*
|
||||
// do the evaluation of the body
|
||||
value = mem->nil;
|
||||
while (body != mem->nil) {
|
||||
value = xp_lisp_eval(lsp, XP_LISP_CAR(body));
|
||||
value = xp_lsp_eval(lsp, XP_LSP_CAR(body));
|
||||
if (value == XP_NULL) {
|
||||
mem->frame = frame->link;
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
return XP_NULL;
|
||||
}
|
||||
body = XP_LISP_CDR(body);
|
||||
body = XP_LSP_CDR(body);
|
||||
}
|
||||
|
||||
// pop the frame.
|
||||
mem->frame = frame->link;
|
||||
|
||||
// destroy the frame.
|
||||
xp_lisp_frame_free (frame);
|
||||
xp_lsp_frame_free (frame);
|
||||
|
||||
//if (XP_LISP_CAR(func) == mem->macro) {
|
||||
if (XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO) {
|
||||
value = xp_lisp_eval(lsp, value);
|
||||
//if (XP_LSP_CAR(func) == mem->macro) {
|
||||
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
|
||||
value = xp_lsp_eval(lsp, value);
|
||||
if (value == XP_NULL) return XP_NULL;
|
||||
}
|
||||
|
||||
|
||||
125
ase/lsp/init.c
Normal file
125
ase/lsp/init.c
Normal file
@ -0,0 +1,125 @@
|
||||
/*
|
||||
* $Id: init.c,v 1.1 2005-09-18 10:18:35 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/lsp/lsp.h>
|
||||
#include <xp/bas/memory.h>
|
||||
#include <xp/bas/assert.h>
|
||||
|
||||
xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
|
||||
xp_size_t mem_ubound, xp_size_t mem_ubound_inc)
|
||||
{
|
||||
if (lsp == XP_NULL) {
|
||||
lsp = (xp_lsp_t*)xp_malloc(xp_sizeof(xp_lsp_t));
|
||||
if (lsp == XP_NULL) return lsp;
|
||||
lsp->__malloced = xp_true;
|
||||
}
|
||||
else lsp->__malloced = xp_false;
|
||||
|
||||
if (xp_lsp_token_open(&lsp->token, 0) == XP_NULL) {
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
lsp->errnum = XP_LSP_ERR_NONE;
|
||||
//lsp->opt_undef_symbol = 1;
|
||||
lsp->opt_undef_symbol = 0;
|
||||
|
||||
lsp->curc = XP_CHAR_EOF;
|
||||
lsp->input_func = XP_NULL;
|
||||
lsp->output_func = XP_NULL;
|
||||
|
||||
lsp->mem = xp_lsp_mem_new (mem_ubound, mem_ubound_inc);
|
||||
if (lsp->mem == XP_NULL) {
|
||||
xp_lsp_token_close (&lsp->token);
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
if (xp_lsp_add_prims (lsp->mem) == -1) {
|
||||
xp_lsp_mem_free (lsp->mem);
|
||||
xp_lsp_token_close (&lsp->token);
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
return lsp;
|
||||
}
|
||||
|
||||
void xp_lsp_close (xp_lsp_t* lsp)
|
||||
{
|
||||
xp_assert (lsp != XP_NULL);
|
||||
xp_lsp_mem_free (lsp->mem);
|
||||
xp_lsp_token_close (&lsp->token);
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
}
|
||||
|
||||
int xp_lsp_error (xp_lsp_t* lsp, xp_char_t* buf, xp_size_t size)
|
||||
{
|
||||
if (buf != XP_NULL || size == 0) return lsp->errnum;
|
||||
|
||||
// TODO:...
|
||||
/*
|
||||
switch (lsp->errnum) {
|
||||
|
||||
default:
|
||||
xp_lsp_copy_string (buf, size, "unknown error");
|
||||
}
|
||||
*/
|
||||
|
||||
return lsp->errnum;
|
||||
}
|
||||
|
||||
int xp_lsp_attach_input (xp_lsp_t* lsp, xp_lsp_io_t input)
|
||||
{
|
||||
if (xp_lsp_detach_input(lsp) == -1) return -1;
|
||||
|
||||
xp_assert (lsp->input_func == XP_NULL);
|
||||
|
||||
if (input(XP_LSP_IO_OPEN, lsp, XP_NULL) == -1) {
|
||||
/* TODO: set error number */
|
||||
return -1;
|
||||
}
|
||||
lsp->input_func = input;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int xp_lsp_detach_input (xp_lsp_t* lsp)
|
||||
{
|
||||
if (lsp->input_func != XP_NULL) {
|
||||
if (lsp->input_func(XP_LSP_IO_CLOSE, lsp, XP_NULL) == -1) {
|
||||
/* TODO: set error number */
|
||||
return -1;
|
||||
}
|
||||
lsp->input_func = XP_NULL;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
int xp_lsp_attach_output (xp_lsp_t* lsp, xp_lsp_io_t output)
|
||||
{
|
||||
if (xp_lsp_detach_output(lsp) == -1) return -1;
|
||||
|
||||
xp_assert (lsp->output_func == XP_NULL);
|
||||
|
||||
if (output(XP_LSP_IO_OPEN, lsp, XP_NULL) == -1) {
|
||||
/* TODO: set error number */
|
||||
return -1;
|
||||
}
|
||||
lsp->output_func = output;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int xp_lsp_detach_output (xp_lsp_t* lsp)
|
||||
{
|
||||
if (lsp->output_func != XP_NULL) {
|
||||
if (lsp->output_func(XP_LSP_IO_CLOSE, lsp, XP_NULL) == -1) {
|
||||
/* TODO: set error number */
|
||||
return -1;
|
||||
}
|
||||
lsp->output_func = XP_NULL;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
@ -1,74 +0,0 @@
|
||||
/*
|
||||
* $Id: lsp.c,v 1.3 2005-09-18 03:57:26 bacon Exp $
|
||||
*/
|
||||
|
||||
#include <xp/lsp/lsp.h>
|
||||
#include <xp/bas/memory.h>
|
||||
#include <xp/bas/assert.h>
|
||||
|
||||
xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
|
||||
xp_size_t mem_ubound, xp_size_t mem_ubound_inc)
|
||||
{
|
||||
if (lsp == XP_NULL) {
|
||||
lsp = (xp_lsp_t*)xp_malloc(sizeofxp_lsp_t));
|
||||
if (lsp == XP_NULL) return lsp;
|
||||
lsp->__malloced = xp_true;
|
||||
}
|
||||
else lsp->__malloced = xp_false;
|
||||
|
||||
lsp->token = xp_lsp_token_new (256);
|
||||
if (lsp->token == XP_NULL) {
|
||||
xp_free (lsp);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
lsp->error = XP_LISP_ERR_NONE;
|
||||
//lsp->opt_undef_symbol = 1;
|
||||
lsp->opt_undef_symbol = 0;
|
||||
|
||||
lsp->curc = XP_CHAR_EOF;
|
||||
lsp->creader = XP_NULL;
|
||||
lsp->creader_extra = XP_NULL;
|
||||
lsp->creader_just_set = 0;
|
||||
lsp->outstream = xp_stdout;
|
||||
|
||||
lsp->mem = xp_lsp_mem_new (mem_ubound, mem_ubound_inc);
|
||||
if (lsp->mem == XP_NULL) {
|
||||
xp_lsp_token_free (lsp->token);
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
if (xp_lsp_add_prims (lsp->mem) == -1) {
|
||||
xp_lsp_mem_free (lsp->mem);
|
||||
xp_lsp_token_free (lsp->token);
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
return XP_NULL;
|
||||
}
|
||||
|
||||
return lsp;
|
||||
}
|
||||
|
||||
void xp_lsp_close (xp_lsp_t* lsp)
|
||||
{
|
||||
xp_assert (lsp != XP_NULL);
|
||||
xp_lsp_mem_free (lsp->mem);
|
||||
xp_lsp_token_free (lsp->token);
|
||||
if (lsp->__malloced) xp_free (lsp);
|
||||
}
|
||||
|
||||
intxp_lsp_error xp_lsp_t* lsp, xp_char_t* buf, xp_size_t size)
|
||||
{
|
||||
if (buf != XP_NULL || size == 0) return lsp->error;
|
||||
|
||||
// TODO:...
|
||||
/*
|
||||
switch (lsp->error) {
|
||||
|
||||
default:
|
||||
xp_lsp_copy_string (buf, size, "unknown error");
|
||||
}
|
||||
*/
|
||||
|
||||
return lsp->error;
|
||||
}
|
||||
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* $Id: lsp.h,v 1.4 2005-09-18 08:10:50 bacon Exp $
|
||||
* $Id: lsp.h,v 1.5 2005-09-18 10:18:35 bacon Exp $
|
||||
*/
|
||||
|
||||
#ifndef _XP_LSP_LSP_H_
|
||||
@ -17,21 +17,17 @@
|
||||
#include <xp/lsp/object.h>
|
||||
#include <xp/lsp/memory.h>
|
||||
|
||||
#include <xp/bas/stdio.h> // TODO: may have to remove dependency on stdio?
|
||||
|
||||
// NOTICE: the function of xp_lsp_creader_t must return -1 on error
|
||||
// and 0 on success. the first argument must be set to
|
||||
// XP_LSP_END_CHAR at the end of input.
|
||||
typedef int (*xp_lsp_creader_t) (xp_cint_t*, void*);
|
||||
|
||||
#define XP_LSP_ERR(lsp) ((lsp)->error)
|
||||
#define XP_LSP_ERR(lsp) ((lsp)->errnum)
|
||||
enum
|
||||
{
|
||||
XP_LSP_ERR_NONE = 0,
|
||||
XP_LSP_ERR_ABORT,
|
||||
XP_LSP_ERR_END,
|
||||
XP_LSP_ERR_MEM,
|
||||
XP_LSP_ERR_READ,
|
||||
XP_LSP_ERR_INPUT_NOT_ATTACHED,
|
||||
XP_LSP_ERR_INPUT,
|
||||
XP_LSP_ERR_OUTPUT_NOT_ATTACHED,
|
||||
XP_LSP_ERR_OUTPUT,
|
||||
XP_LSP_ERR_SYNTAX,
|
||||
XP_LSP_ERR_BAD_ARG,
|
||||
XP_LSP_ERR_WRONG_ARG,
|
||||
@ -46,6 +42,15 @@ enum
|
||||
XP_LSP_ERR_BAD_VALUE
|
||||
};
|
||||
|
||||
typedef int (*xp_lsp_io_t) (int cmd, void* owner, void* arg);
|
||||
enum
|
||||
{
|
||||
XP_LSP_IO_OPEN,
|
||||
XP_LSP_IO_CLOSE,
|
||||
XP_LSP_IO_CHAR,
|
||||
XP_LSP_IO_STR
|
||||
};
|
||||
|
||||
/*
|
||||
* STRUCT: xp_lsp_t
|
||||
* Defines the lisp object
|
||||
@ -53,22 +58,20 @@ enum
|
||||
struct xp_lsp_t
|
||||
{
|
||||
/* error number */
|
||||
int error;
|
||||
int errnum;
|
||||
int opt_undef_symbol;
|
||||
|
||||
/* for read */
|
||||
xp_cint_t curc;
|
||||
xp_lsp_creader_t creader;
|
||||
void* creader_extra;
|
||||
int creader_just_set;
|
||||
xp_lsp_token_t* token;
|
||||
xp_lsp_token_t token;
|
||||
|
||||
/* for eval */
|
||||
xp_size_t max_eval_depth; // TODO:....
|
||||
xp_size_t eval_depth;
|
||||
|
||||
/* for print */
|
||||
XP_FILE* outstream;
|
||||
/* io functions */
|
||||
xp_lsp_io_t input_func;
|
||||
xp_lsp_io_t output_func;
|
||||
|
||||
/* memory manager */
|
||||
xp_lsp_mem_t* mem;
|
||||
@ -87,6 +90,7 @@ extern "C" {
|
||||
*/
|
||||
xp_lsp_t* xp_lsp_open (xp_lsp_t* lisp,
|
||||
xp_size_t mem_ubound, xp_size_t mem_ubound_inc);
|
||||
|
||||
/*
|
||||
* FUNCTION: xp_lsp_close
|
||||
* Destroys the lisp object
|
||||
@ -96,18 +100,45 @@ xp_lsp_t* xp_lsp_open (xp_lsp_t* lisp,
|
||||
*/
|
||||
void xp_lsp_close (xp_lsp_t* lsp);
|
||||
|
||||
/*
|
||||
* FUNCTION: xp_lsp_error
|
||||
*/
|
||||
int xp_lsp_error (xp_lsp_t* lsp, xp_char_t* buf, xp_size_t size);
|
||||
|
||||
/* read.c */
|
||||
// TODO: move xp_lsp_set_creader to lsp.c
|
||||
void xp_lsp_set_creader (xp_lsp_t* lsp, xp_lsp_creader_t func, void* extra);
|
||||
/*
|
||||
* FUNCTION: xp_lsp_attach_input
|
||||
*/
|
||||
int xp_lsp_attach_input (xp_lsp_t* lsp, xp_lsp_io_t input);
|
||||
|
||||
/*
|
||||
* FUNCTION: xp_lsp_detach_input
|
||||
*/
|
||||
int xp_lsp_detach_input (xp_lsp_t* lsp);
|
||||
|
||||
/*
|
||||
* FUNCTION: xp_lsp_attach_output
|
||||
*/
|
||||
int xp_lsp_attach_output (xp_lsp_t* lsp, xp_lsp_io_t output);
|
||||
|
||||
/*
|
||||
* FUNCTION: xp_lsp_detach_output
|
||||
*/
|
||||
int xp_lsp_detach_output (xp_lsp_t* lsp);
|
||||
|
||||
/*
|
||||
* FUNCTION: xp_lsp_read
|
||||
*/
|
||||
xp_lsp_obj_t* xp_lsp_read (xp_lsp_t* lsp);
|
||||
|
||||
/* eval.c */
|
||||
/*
|
||||
* FUNCTION: xp_lsp_eval
|
||||
*/
|
||||
xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj);
|
||||
|
||||
/* print.c */
|
||||
void xp_lsp_print (xp_lsp_t* lsp, xp_lsp_obj_t* obj);
|
||||
/*
|
||||
* FUNCTION: xp_lsp_print
|
||||
*/
|
||||
int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user