hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan 2005-09-20 08:05:32 +00:00
parent c17cf9d838
commit f50849c274
11 changed files with 170 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/*
* $Id: eval.c,v 1.9 2005-09-19 16:13:18 bacon Exp $
* $Id: eval.c,v 1.10 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/lsp.h>
@ -7,9 +7,12 @@
#include <xp/lsp/prim.h>
#include <xp/bas/assert.h>
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);
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_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj)
{
@ -46,8 +49,6 @@ static xp_lsp_obj_t* make_func (xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro)
{
xp_lsp_obj_t* func, * formal, * body, * p;
xp_printf (XP_TEXT("about to create a function or a macro ....\n"));
if (cdr == lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS;
return XP_NULL;
@ -66,10 +67,13 @@ xp_printf (XP_TEXT("about to create a function or a macro ....\n"));
return XP_NULL;
}
// TODO: more lambda expression syntax checks required???.
// TODO: more lambda expression syntax checks required???.
/* check if the lambda express has non-nil value
* at the terminating cdr */
for (p = body; XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS; p = XP_LSP_CDR(p));
if (p != lsp->mem->nil) {
/* (lambda (x) (+ x 10) . 4) */
/* like in (lambda (x) (+ x 10) . 4) */
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
}
@ -114,18 +118,14 @@ static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
return XP_LSP_PIMPL(func) (lsp, cdr);
}
else {
printf ("undefined function: ");
xp_lsp_print (lsp, car);
printf ("\n");
//TODO: emit the name for debugging
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
return XP_NULL;
}
}
else {
//TODO: better error handling.
printf ("undefined function: ");
xp_lsp_print (lsp, car);
printf ("\n");
//TODO: emit the name for debugging
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
return XP_NULL;
}
@ -147,9 +147,7 @@ static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
}
}
xp_printf (XP_TEXT("bad function: "));
xp_lsp_print (lsp, car);
xp_printf (XP_TEXT("\n"));
//TODO: emit the name for debugging
lsp->errnum = XP_LSP_ERR_BAD_FUNC;
return XP_NULL;
}
@ -211,13 +209,14 @@ static xp_lsp_obj_t* apply (xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* act
}
}
if (xp_lsp_frame_lookup (frame, XP_LSP_CAR(formal)) != XP_NULL) {
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_lsp_frame_free (frame);
return XP_NULL;
}
if (xp_lsp_frame_insert (frame, XP_LSP_CAR(formal), value) == XP_NULL) {
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_lsp_frame_free (frame);

8
ase/lsp/init.c
View File

@ -1,5 +1,5 @@
/*
* $Id: init.c,v 1.5 2005-09-19 12:04:00 bacon Exp $
* $Id: init.c,v 1.6 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/lsp.h>
@ -45,6 +45,9 @@ xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
return XP_NULL;
}
lsp->max_eval_depth = 0; // TODO: put restriction here....
lsp->cur_eval_depth = 0;
return lsp;
}
@ -66,8 +69,10 @@ int xp_lsp_attach_input (xp_lsp_t* lsp, xp_lsp_io_t input, void* arg)
/* TODO: set error number */
return -1;
}
lsp->input_func = input;
lsp->input_arg = arg;
lsp->curc = XP_CHAR_EOF;
return 0;
}
@ -80,6 +85,7 @@ int xp_lsp_detach_input (xp_lsp_t* lsp)
}
lsp->input_func = XP_NULL;
lsp->input_arg = XP_NULL;
lsp->curc = XP_CHAR_EOF;
}
return 0;

11
ase/lsp/lsp.h
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.h,v 1.14 2005-09-19 14:57:09 bacon Exp $
* $Id: lsp.h,v 1.15 2005-09-20 08:05:32 bacon Exp $
*/
#ifndef _XP_LSP_LSP_H_
@ -68,7 +68,6 @@ enum
*/
typedef xp_lsp_obj_t* (*xp_lsp_prim_t) (xp_lsp_t* lsp, xp_lsp_obj_t* obj);
struct xp_lsp_t
{
/* error number */
@ -79,16 +78,16 @@ struct xp_lsp_t
xp_cint_t curc;
xp_lsp_token_t token;
/* for eval */
xp_size_t max_eval_depth; // TODO:....
xp_size_t eval_depth;
/* io functions */
xp_lsp_io_t input_func;
xp_lsp_io_t output_func;
void* input_arg;
void* output_arg;
/* security options */
xp_size_t max_eval_depth;
xp_size_t cur_eval_depth;
/* memory manager */
xp_lsp_mem_t* mem;
xp_bool_t __malloced;

2
ase/lsp/makefile.in
View File

@ -1,6 +1,6 @@
SRCS = name.c token.c array.c mem.c env.c error.c \
init.c read.c eval.c print.c \
prim.c prim_prog.c prim_let.c
prim.c prim_prog.c prim_let.c prim_math.c
OBJS = $(SRCS:.c=.o)
OUT = libxplsp.a

41
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.c,v 1.3 2005-09-19 12:04:00 bacon Exp $
* $Id: mem.c,v 1.4 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/mem.h>
@ -15,7 +15,7 @@ xp_lsp_mem_t* xp_lsp_mem_new (xp_size_t ubound, xp_size_t ubound_inc)
xp_size_t i;
// allocate memory
mem = (xp_lsp_mem_t*)xp_malloc (sizeof(xp_lsp_mem_t));
mem = (xp_lsp_mem_t*)xp_malloc (xp_sizeof(xp_lsp_mem_t));
if (mem == XP_NULL) return XP_NULL;
// create a new root environment frame
@ -92,8 +92,8 @@ void xp_lsp_mem_free (xp_lsp_mem_t* mem)
xp_free (mem);
}
static int __add_prim (
xp_lsp_mem_t* mem, const xp_char_t* name, xp_size_t len, xp_lsp_pimpl_t prim)
static int __add_prim (xp_lsp_mem_t* mem,
const xp_char_t* name, xp_size_t len, xp_lsp_pimpl_t prim)
{
xp_lsp_obj_t* n, * p;
@ -140,15 +140,17 @@ int xp_lsp_add_builtin_prims (xp_lsp_mem_t* mem)
ADD_PRIM (mem, XP_TEXT("let"), 3, xp_lsp_prim_let);
ADD_PRIM (mem, XP_TEXT("let*"), 4, xp_lsp_prim_letx);
ADD_PRIM (mem, XP_TEXT("+"), 1, xp_lsp_prim_plus);
ADD_PRIM (mem, XP_TEXT(">"), 1, xp_lsp_prim_gt);
ADD_PRIM (mem, XP_TEXT("<"), 1, xp_lsp_prim_lt);
ADD_PRIM (mem, XP_TEXT("+"), 1, xp_lsp_prim_plus);
ADD_PRIM (mem, XP_TEXT("-"), 1, xp_lsp_prim_minus);
return 0;
}
xp_lsp_obj_t* xp_lsp_allocate (xp_lsp_mem_t* mem, int type, xp_size_t size)
xp_lsp_obj_t* xp_lsp_alloc (xp_lsp_mem_t* mem, int type, xp_size_t size)
{
xp_lsp_obj_t* obj;
@ -376,14 +378,14 @@ void xp_lsp_garbage_collect (xp_lsp_mem_t* mem)
xp_lsp_obj_t* xp_lsp_make_nil (xp_lsp_mem_t* mem)
{
if (mem->nil != XP_NULL) return mem->nil;
mem->nil = xp_lsp_allocate (mem, XP_LSP_OBJ_NIL, sizeof(xp_lsp_obj_nil_t));
mem->nil = xp_lsp_alloc (mem, XP_LSP_OBJ_NIL, xp_sizeof(xp_lsp_obj_nil_t));
return mem->nil;
}
xp_lsp_obj_t* xp_lsp_make_true (xp_lsp_mem_t* mem)
{
if (mem->t != XP_NULL) return mem->t;
mem->t = xp_lsp_allocate (mem, XP_LSP_OBJ_TRUE, sizeof(xp_lsp_obj_true_t));
mem->t = xp_lsp_alloc (mem, XP_LSP_OBJ_TRUE, xp_sizeof(xp_lsp_obj_true_t));
return mem->t;
}
@ -391,7 +393,7 @@ xp_lsp_obj_t* xp_lsp_make_int (xp_lsp_mem_t* mem, xp_lsp_int_t value)
{
xp_lsp_obj_t* obj;
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_INT, sizeof(xp_lsp_obj_int_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_INT, xp_sizeof(xp_lsp_obj_int_t));
if (obj == XP_NULL) return XP_NULL;
XP_LSP_IVALUE(obj) = value;
@ -403,7 +405,7 @@ xp_lsp_obj_t* xp_lsp_make_float (xp_lsp_mem_t* mem, xp_lsp_real_t value)
{
xp_lsp_obj_t* obj;
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_FLOAT, sizeof(xp_lsp_obj_float_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_FLOAT, xp_sizeof(xp_lsp_obj_float_t));
if (obj == XP_NULL) return XP_NULL;
XP_LSP_FVALUE(obj) = value;
@ -425,8 +427,8 @@ xp_lsp_obj_t* xp_lsp_make_symbol (
}
// no such symbol found. create a new one
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_SYMBOL,
sizeof(xp_lsp_obj_symbol_t) + (len + 1) * sizeof(xp_char_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_SYMBOL,
xp_sizeof(xp_lsp_obj_symbol_t) + (len + 1) * xp_sizeof(xp_char_t));
if (obj == XP_NULL) return XP_NULL;
// fill in the symbol buffer
@ -440,8 +442,8 @@ xp_lsp_obj_t* xp_lsp_make_string (xp_lsp_mem_t* mem, const xp_char_t* str, xp_si
xp_lsp_obj_t* obj;
// allocate memory for the string
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_STRING,
sizeof(xp_lsp_obj_string_t) + (len + 1) * sizeof(xp_char_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_STRING,
xp_sizeof(xp_lsp_obj_string_t) + (len + 1) * xp_sizeof(xp_char_t));
if (obj == XP_NULL) return XP_NULL;
// fill in the string buffer
@ -454,7 +456,7 @@ xp_lsp_obj_t* xp_lsp_make_cons (xp_lsp_mem_t* mem, xp_lsp_obj_t* car, xp_lsp_obj
{
xp_lsp_obj_t* obj;
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_CONS, sizeof(xp_lsp_obj_cons_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_CONS, xp_sizeof(xp_lsp_obj_cons_t));
if (obj == XP_NULL) return XP_NULL;
XP_LSP_CAR(obj) = car;
@ -467,7 +469,7 @@ xp_lsp_obj_t* xp_lsp_make_func (xp_lsp_mem_t* mem, xp_lsp_obj_t* formal, xp_lsp_
{
xp_lsp_obj_t* obj;
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_FUNC, sizeof(xp_lsp_obj_func_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_FUNC, xp_sizeof(xp_lsp_obj_func_t));
if (obj == XP_NULL) return XP_NULL;
XP_LSP_FFORMAL(obj) = formal;
@ -480,7 +482,7 @@ xp_lsp_obj_t* xp_lsp_make_macro (xp_lsp_mem_t* mem, xp_lsp_obj_t* formal, xp_lsp
{
xp_lsp_obj_t* obj;
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_MACRO, sizeof(xp_lsp_obj_macro_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_MACRO, xp_sizeof(xp_lsp_obj_macro_t));
if (obj == XP_NULL) return XP_NULL;
XP_LSP_MFORMAL(obj) = formal;
@ -493,7 +495,7 @@ xp_lsp_obj_t* xp_lsp_make_prim (xp_lsp_mem_t* mem, void* impl)
{
xp_lsp_obj_t* obj;
obj = xp_lsp_allocate (mem, XP_LSP_OBJ_PRIM, sizeof(xp_lsp_obj_prim_t));
obj = xp_lsp_alloc (mem, XP_LSP_OBJ_PRIM, xp_sizeof(xp_lsp_obj_prim_t));
if (obj == XP_NULL) return XP_NULL;
XP_LSP_PIMPL(obj) = impl;
@ -519,7 +521,8 @@ xp_lsp_assoc_t* xp_lsp_lookup (xp_lsp_mem_t* mem, xp_lsp_obj_t* name)
return XP_NULL;
}
xp_lsp_assoc_t* xp_lsp_set (xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* value)
xp_lsp_assoc_t* xp_lsp_set (
xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* value)
{
xp_lsp_assoc_t* assoc;

4
ase/lsp/mem.h
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.h,v 1.3 2005-09-19 03:05:37 bacon Exp $
* $Id: mem.h,v 1.4 2005-09-20 08:05:32 bacon Exp $
*/
#ifndef _XP_LSP_MEM_H_
@ -56,7 +56,7 @@ void xp_lsp_mem_free (xp_lsp_mem_t* mem);
int xp_lsp_add_builtin_prims (xp_lsp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_allocate (xp_lsp_mem_t* mem, int type, xp_size_t size);
xp_lsp_obj_t* xp_lsp_alloc (xp_lsp_mem_t* mem, int type, xp_size_t size);
void xp_lsp_dispose (xp_lsp_mem_t* mem, xp_lsp_obj_t* prev, xp_lsp_obj_t* obj);
void xp_lsp_dispose_all (xp_lsp_mem_t* mem);
void xp_lsp_garbage_collect (xp_lsp_mem_t* mem);

34
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim.c,v 1.3 2005-09-19 12:04:00 bacon Exp $
* $Id: prim.c,v 1.4 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/lsp.h>
@ -359,38 +359,6 @@ xp_lsp_obj_t* xp_lsp_prim_demac (xp_lsp_t* lsp, xp_lsp_obj_t* args)
return mac;
}
xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t value = 0;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
if (XP_LSP_TYPE(tmp) != XP_LSP_OBJ_INT) {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
}
value = value + XP_LSP_IVALUE(tmp);
body = XP_LSP_CDR(body);
}
tmp = xp_lsp_make_int (lsp->mem, value);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL;
}
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_gt (xp_lsp_t* lsp, xp_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;

46
ase/lsp/prim.h
View File

@ -1,5 +1,5 @@
/*
* $Id: prim.h,v 1.1 2005-09-18 10:18:35 bacon Exp $
* $Id: prim.h,v 1.2 2005-09-20 08:05:32 bacon Exp $
*/
#ifndef _XP_LSP_PRIM_H_
@ -14,29 +14,31 @@ typedef xp_lsp_obj_t* (*xp_lsp_pimpl_t) (xp_lsp_t*, xp_lsp_obj_t*);
extern "C" {
#endif
xp_lsp_obj_t* xp_lsp_prim_abort (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_eval (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_prog1 (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_progn (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_gc (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cond (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_if (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_while (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_abort (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_eval (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_prog1 (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_progn (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_gc (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cond (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_if (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_while (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_car (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cdr (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cons (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_set (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_setq (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_quote (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_defun (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_demac (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_letx (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_car (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cdr (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cons (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_set (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_setq (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_quote (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_defun (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_demac (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_letx (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_gt (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_lt (xp_lsp_t*, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_gt (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_lt (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_minus (xp_lsp_t* lsp, xp_lsp_obj_t* args);
#ifdef __cplusplus
}

70
ase/lsp/prim_math.c Normal file
View File

@ -0,0 +1,70 @@
/*
* $Id: prim_math.c,v 1.1 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/prim.h>
#include <xp/bas/assert.h>
xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t value = 0;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
if (XP_LSP_TYPE(tmp) != XP_LSP_OBJ_INT) {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
}
value = value + XP_LSP_IVALUE(tmp);
body = XP_LSP_CDR(body);
}
tmp = xp_lsp_make_int (lsp->mem, value);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL;
}
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_minus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t value = 0;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
if (XP_LSP_TYPE(tmp) != XP_LSP_OBJ_INT) {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
}
value = value - XP_LSP_IVALUE(tmp);
body = XP_LSP_CDR(body);
}
tmp = xp_lsp_make_int (lsp->mem, value);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL;
}
return tmp;
}

9
ase/lsp/print.c
View File

@ -1,5 +1,5 @@
/*
* $Id: print.c,v 1.10 2005-09-19 16:13:18 bacon Exp $
* $Id: print.c,v 1.11 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/lsp.h>
@ -141,7 +141,12 @@ static int __print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj, xp_bool_t prt_cons_p
OUTPUT_STR (lsp, XP_TEXT(")"));
break;
case XP_LSP_OBJ_MACRO:
OUTPUT_STR (lsp, XP_TEXT("macro"));
/*OUTPUT_STR (lsp, XP_TEXT("macro"));*/
OUTPUT_STR (lsp, XP_TEXT("(macro "));
if (__print (lsp, XP_LSP_FFORMAL(obj), xp_true) == -1) return -1;
OUTPUT_STR (lsp, XP_TEXT(" "));
if (__print (lsp, XP_LSP_FBODY(obj), xp_false) == -1) return -1;
OUTPUT_STR (lsp, XP_TEXT(")"));
break;
case XP_LSP_OBJ_PRIM:
OUTPUT_STR (lsp, XP_TEXT("prim"));

17
ase/lsp/read.c
View File

@ -1,5 +1,5 @@
/*
* $Id: read.c,v 1.13 2005-09-18 13:06:43 bacon Exp $
* $Id: read.c,v 1.14 2005-09-20 08:05:32 bacon Exp $
*/
#include <xp/lsp/lsp.h>
@ -65,7 +65,8 @@ static int read_string (xp_lsp_t* lsp);
xp_lsp_obj_t* xp_lsp_read (xp_lsp_t* lsp)
{
if (read_char(lsp) == -1) return XP_NULL;
if (lsp->curc == XP_CHAR_EOF &&
read_char(lsp) == -1) return XP_NULL;
lsp->errnum = XP_LSP_ERR_NONE;
NEXT_TOKEN (lsp);
@ -290,8 +291,16 @@ static int read_token (xp_lsp_t* lsp)
else if (lsp->curc == XP_CHAR('-')) {
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
return (IS_DIGIT(lsp->curc))?
read_number (lsp, 1): read_ident (lsp);
if (IS_DIGIT(lsp->curc)) {
return read_number (lsp, 1);
}
else if (IS_IDENT(lsp->curc)) {
return read_ident (lsp);
}
else {
TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0;
}
}
else if (IS_DIGIT(lsp->curc)) {
return read_number (lsp, 0);