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 2007-02-11 07:36:55 +00:00
parent bda1b097bd
commit 72f5e87732
13 changed files with 260 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
ase/lsp/env.c
View File

@ -1,12 +1,12 @@
/*
* $Id: env.c,v 1.15 2007-02-10 13:52:22 bacon Exp $
* $Id: env.c,v 1.16 2007-02-11 07:36:54 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
// TODO: make the frame hash accessible....
/* TODO: make the frame hash accessible */
static ase_lsp_assoc_t* __new_assoc (
ase_lsp_t* lsp, ase_lsp_obj_t* name,
@ -18,7 +18,7 @@ static ase_lsp_assoc_t* __new_assoc (
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_assoc_t));
if (assoc == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_seterror (lsp, ASE_LSP_ENOMEM, ASE_NULL, 0);
return ASE_NULL;
}
@ -38,7 +38,7 @@ ase_lsp_frame_t* ase_lsp_newframe (ase_lsp_t* lsp)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_frame_t));
if (frame == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_seterror (lsp, ASE_LSP_ENOMEM, ASE_NULL, 0);
return ASE_NULL;
}
@ -52,7 +52,7 @@ void ase_lsp_freeframe (ase_lsp_t* lsp, ase_lsp_frame_t* frame)
{
ase_lsp_assoc_t* assoc, * link;
// destroy the associations
/* destroy the associations */
assoc = frame->assoc;
while (assoc != ASE_NULL)
{
@ -120,7 +120,7 @@ ase_lsp_tlink_t* ase_lsp_pushtmp (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_tlink_t));
if (tlink == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_seterror (lsp, ASE_LSP_ENOMEM, ASE_NULL, 0);
return ASE_NULL;
}

95
ase/lsp/err.c
View File

@ -1,17 +1,12 @@
/*
* $Id: err.c,v 1.10 2007-02-10 13:52:23 bacon Exp $
* $Id: err.c,v 1.11 2007-02-11 07:36:54 bacon Exp $
*
* {License}
*/
#include <ase/lsp/lsp_i.h>
int ase_lsp_geterrnum (ase_lsp_t* lsp)
{
return lsp->errnum;
}
const ase_char_t* ase_lsp_geterrstr (int errnum)
static const ase_char_t* __geterrstr (int errnum)
{
static const ase_char_t* __errstr[] =
{
@ -25,14 +20,15 @@ const ase_char_t* ase_lsp_geterrstr (int errnum)
ASE_T("output not attached"),
ASE_T("output"),
ASE_T("syntax"),
ASE_T("right parenthesis expected"),
ASE_T("bad arguments"),
ASE_T("too few arguments"),
ASE_T("too many arguments"),
ASE_T("undefined function"),
ASE_T("undefined function '%s'"),
ASE_T("bad function"),
ASE_T("duplicate formal"),
ASE_T("bad symbol"),
ASE_T("undefined symbol"),
ASE_T("undefined symbol '%s'"),
ASE_T("empty body"),
ASE_T("bad value"),
ASE_T("divide by zero")
@ -45,3 +41,84 @@ const ase_char_t* ase_lsp_geterrstr (int errnum)
return ASE_T("unknown error");
}
void ase_lsp_geterror (
ase_lsp_t* lsp, int* errnum, const ase_char_t** errmsg)
{
if (errnum != ASE_NULL) *errnum = lsp->errnum;
if (errmsg != ASE_NULL) *errmsg = lsp->errmsg;
}
void ase_lsp_seterror (
ase_lsp_t* lsp, int errnum,
const ase_char_t** errarg, ase_size_t argcnt)
{
const ase_char_t* errfmt;
ASE_LSP_ASSERT (lsp, argcnt <= 5);
lsp->errnum = errnum;
errfmt = __geterrstr (errnum);
switch (argcnt)
{
case 0:
lsp->prmfns.sprintf (
lsp->errmsg,
ASE_COUNTOF(lsp->errmsg),
errfmt);
return;
case 1:
lsp->prmfns.sprintf (
lsp->errmsg,
ASE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0]);
return;
case 2:
lsp->prmfns.sprintf (
lsp->errmsg,
ASE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1]);
return;
case 3:
lsp->prmfns.sprintf (
lsp->errmsg,
ASE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1],
errarg[2]);
return;
case 4:
lsp->prmfns.sprintf (
lsp->errmsg,
ASE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1],
errarg[2],
errarg[3]);
return;
case 5:
lsp->prmfns.sprintf (
lsp->errmsg,
ASE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1],
errarg[2],
errarg[3],
errarg[4]);
return;
}
}

103
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/*
* $Id: eval.c,v 1.25 2007-02-10 13:52:23 bacon Exp $
* $Id: eval.c,v 1.26 2007-02-11 07:36:54 bacon Exp $
*
* {License}
*/
@ -7,7 +7,7 @@
#include <ase/lsp/lsp_i.h>
static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
static ase_lsp_obj_t* make_func (
static ase_lsp_obj_t* makefn (
ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro);
static ase_lsp_obj_t* eval_cons (
ase_lsp_t* lsp, ase_lsp_obj_t* cons);
@ -18,20 +18,6 @@ static ase_lsp_obj_t* apply_to_prim (
ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
ase_lsp_obj_t* ret;
//push_to_eval_stack (obj);
ret = __eval (lsp, obj);
//pop ();
return ret;
}
static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
lsp->errnum = ASE_LSP_ENOERR;
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
return eval_cons (lsp, obj);
@ -42,8 +28,14 @@ static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
/*
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
ase_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(obj);
printf ("lambda or macro can't be used as a normal symbol\n");
lsp->errnum = ASE_LSP_EBADSYM;
ase_lsp_seterror (
lsp, ASE_LSP_EBADSYM,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
}
*/
@ -53,7 +45,13 @@ static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
if (lsp->opt_undef_symbol)
{
lsp->errnum = ASE_LSP_ERR_UNDEF_SYMBOL;
ase_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(obj);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFSYM,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
}
return lsp->mem->nil;
@ -65,19 +63,19 @@ static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
return obj;
}
static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro)
static ase_lsp_obj_t* makefn (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro)
{
ase_lsp_obj_t* func, * formal, * body, * p;
if (cdr == lsp->mem->nil)
{
lsp->errnum = ASE_LSP_EARGFEW;
ase_lsp_seterror (lsp, ASE_LSP_EARGFEW, ASE_NULL, 0);
return ASE_NULL;
}
if (ASE_LSP_TYPE(cdr) != ASE_LSP_OBJ_CONS)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -86,7 +84,7 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr
if (body == lsp->mem->nil)
{
lsp->errnum = ASE_LSP_EEMPBDY;
ase_lsp_seterror (lsp, ASE_LSP_EEMPBDY, ASE_NULL, 0);
return ASE_NULL;
}
@ -98,7 +96,7 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr
if (p != lsp->mem->nil)
{
/* like in (lambda (x) (+ x 10) . 4) */
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -122,12 +120,12 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
if (car == lsp->mem->lambda)
{
/* (lambda (x) (+ x 20)) */
return make_func (lsp, cdr, 0);
return makefn (lsp, cdr, 0);
}
else if (car == lsp->mem->macro)
{
/* (macro (x) (+ x 20)) */
return make_func (lsp, cdr, 1);
return makefn (lsp, cdr, 1);
}
else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYM)
{
@ -140,7 +138,13 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
if (func == ASE_NULL)
{
/* the symbol's function definition is void */
lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
ase_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(car);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFFN,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
}
@ -156,15 +160,25 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
}
else
{
//TODO: emit the name for debugging
lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
ase_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(car);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFFN,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
}
}
else {
//TODO: better error handling.
//TODO: emit the name for debugging
lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
else
{
ase_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(car);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFFN,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
}
}
@ -179,20 +193,19 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
* ((lambda (x) (+ x 10)) 50) */
if (ASE_LSP_CAR(car) == lsp->mem->lambda)
{
ase_lsp_obj_t* func = make_func (lsp, ASE_LSP_CDR(car), 0);
ase_lsp_obj_t* func = makefn (lsp, ASE_LSP_CDR(car), 0);
if (func == ASE_NULL) return ASE_NULL;
return apply (lsp, func, cdr);
}
else if (ASE_LSP_CAR(car) == lsp->mem->macro)
{
ase_lsp_obj_t* func = make_func (lsp, ASE_LSP_CDR(car), 1);
ase_lsp_obj_t* func = makefn (lsp, ASE_LSP_CDR(car), 1);
if (func == ASE_NULL) return ASE_NULL;
return apply (lsp, func, cdr);
}
}
//TODO: emit the name for debugging
lsp->errnum = ASE_LSP_ERR_BAD_FUNC;
ase_lsp_seterror (lsp, ASE_LSP_EBADFN, ASE_NULL, 0);
return ASE_NULL;
}
@ -239,9 +252,10 @@ static ase_lsp_obj_t* apply (
{
if (actual == mem->nil)
{
lsp->errnum = ASE_LSP_EARGFEW;
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGFEW, ASE_NULL, 0);
return ASE_NULL;
}
@ -261,9 +275,10 @@ static ase_lsp_obj_t* apply (
if (ase_lsp_lookupinframe (
lsp, frame, ASE_LSP_CAR(formal)) != ASE_NULL)
{
lsp->errnum = ASE_LSP_EDUPFML;
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EDUPFML, ASE_NULL, 0);
return ASE_NULL;
}
@ -281,16 +296,18 @@ static ase_lsp_obj_t* apply (
if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS)
{
lsp->errnum = ASE_LSP_EARGMANY;
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGMANY, ASE_NULL, 0);
return ASE_NULL;
}
else if (actual != mem->nil)
{
lsp->errnum = ASE_LSP_EARGBAD;
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -345,19 +362,19 @@ static ase_lsp_obj_t* apply_to_prim (
}
if (obj != lsp->mem->nil)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
if (count < ASE_LSP_PMINARGS(func))
{
lsp->errnum = ASE_LSP_EARGFEW;
ase_lsp_seterror (lsp, ASE_LSP_EARGFEW, ASE_NULL, 0);
return ASE_NULL;
}
if (count > ASE_LSP_PMAXARGS(func))
{
lsp->errnum = ASE_LSP_EARGMANY;
ase_lsp_seterror (lsp, ASE_LSP_EARGMANY, ASE_NULL, 0);
return ASE_NULL;
}

3
ase/lsp/lsp.c
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.c,v 1.21 2007-02-03 10:51:52 bacon Exp $
* $Id: lsp.c,v 1.22 2007-02-11 07:36:54 bacon Exp $
*
* {License}
*/
@ -71,6 +71,7 @@ ase_lsp_t* ase_lsp_open (
}
lsp->errnum = ASE_LSP_ENOERR;
lsp->errmsg[0] = ASE_T('\0');
lsp->opt_undef_symbol = 1;
/*lsp->opt_undef_symbol = 0;*/

27
ase/lsp/lsp.h
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.h,v 1.36 2007-02-10 13:52:23 bacon Exp $
* $Id: lsp.h,v 1.37 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -91,22 +91,23 @@ enum
ASE_LSP_EEXIT,
ASE_LSP_EEND,
ASE_LSP_EENDSTR,
ASE_LSP_ERR_INPUT_NOT_ATTACHED,
ASE_LSP_ERR_INPUT,
ASE_LSP_ERR_OUTPUT_NOT_ATTACHED,
ASE_LSP_ERR_OUTPUT,
ASE_LSP_ENOINP,
ASE_LSP_EINPUT,
ASE_LSP_ENOOUTP,
ASE_LSP_EOUTPUT,
ASE_LSP_ESYNTAX,
ASE_LSP_ERPAREN,
ASE_LSP_EARGBAD,
ASE_LSP_EARGFEW,
ASE_LSP_EARGMANY,
ASE_LSP_ERR_UNDEF_FUNC,
ASE_LSP_ERR_BAD_FUNC,
ASE_LSP_EUNDEFFN,
ASE_LSP_EBADFN,
ASE_LSP_EDUPFML,
ASE_LSP_EBADSYM,
ASE_LSP_ERR_UNDEF_SYMBOL,
ASE_LSP_EUNDEFSYM,
ASE_LSP_EEMPBDY,
ASE_LSP_EVALBAD,
ASE_LSP_EDIVBY0
};
@ -133,7 +134,12 @@ ase_lsp_t* ase_lsp_open (
void ase_lsp_close (ase_lsp_t* lsp);
int ase_lsp_geterrnum (ase_lsp_t* lsp);
void ase_lsp_geterror (
ase_lsp_t* lsp, int* errnum, const ase_char_t** errmsg);
void ase_lsp_seterror (
ase_lsp_t* lsp, int errnum,
const ase_char_t** errarg, ase_size_t argcnt);
int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg);
int ase_lsp_detach_input (ase_lsp_t* lsp);
@ -183,7 +189,6 @@ int ase_lsp_assertfail (ase_lsp_t* lsp,
const ase_char_t* expr, const ase_char_t* desc,
const ase_char_t* file, int line);
const ase_char_t* ase_lsp_geterrstr (int errnum);
#ifdef __cplusplus
}

7
ase/lsp/lsp_i.h
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp_i.h,v 1.7 2007-02-03 10:51:52 bacon Exp $
* $Id: lsp_i.h,v 1.8 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -56,8 +56,11 @@ struct ase_lsp_t
{
ase_lsp_prmfns_t prmfns;
/* error number */
/* error */
int errnum;
ase_char_t errmsg[256];
/* options */
int opt_undef_symbol;
/* for read */

4
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.c,v 1.28 2007-02-10 13:52:23 bacon Exp $
* $Id: mem.c,v 1.29 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -111,7 +111,7 @@ ase_lsp_gc (mem);
obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size);
if (obj == ASE_NULL)
{
mem->lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_seterror (mem->lsp, ASE_LSP_ENOMEM, ASE_NULL, 0);
return ASE_NULL;
}
}

24
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim.c,v 1.21 2007-02-10 13:52:23 bacon Exp $
* $Id: prim.c,v 1.22 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -109,7 +109,7 @@ ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
if (ASE_LSP_TYPE(ASE_LSP_CAR(args)) != ASE_LSP_OBJ_CONS)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -150,7 +150,7 @@ ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -222,7 +222,7 @@ ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (!f) ase_lsp_poptmp (lsp); /* ret */
ase_lsp_poptmp (lsp); /* tmp */
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -266,7 +266,8 @@ ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (tmp != lsp->mem->nil)
{
ase_lsp_poptmp (lsp); /* tmp */
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -292,7 +293,7 @@ ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(tmp) != ASE_LSP_OBJ_CONS)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -315,7 +316,7 @@ ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(tmp) != ASE_LSP_OBJ_CONS)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -384,7 +385,8 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM)
{
ase_lsp_poptmp (lsp); /* p1 */
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -429,7 +431,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p1 = ASE_LSP_CAR(p);
if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -483,7 +485,7 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args)
name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -515,7 +517,7 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_EARGBAD;
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}

12
ase/lsp/prim_compar.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_compar.c,v 1.12 2007-02-10 13:52:23 bacon Exp $
* $Id: prim_compar.c,v 1.13 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -43,7 +43,7 @@
{ \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
return ASE_NULL; \
} \
} \
@ -61,7 +61,7 @@
{ \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
return ASE_NULL; \
} \
} \
@ -77,7 +77,7 @@
{ \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
return ASE_NULL; \
} \
} \
@ -93,7 +93,7 @@
{ \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
return ASE_NULL; \
} \
} \
@ -101,7 +101,7 @@
{ \
ase_lsp_poptmp (lsp); \
ase_lsp_poptmp (lsp); \
lsp->errnum = ASE_LSP_EVALBAD; \
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); \
return ASE_NULL; \
} \
\

20
ase/lsp/prim_let.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_let.c,v 1.11 2007-02-10 13:52:23 bacon Exp $
* $Id: prim_let.c,v 1.12 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -43,10 +43,11 @@ static ase_lsp_obj_t* __prim_let (
if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_EARGBAD;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -54,10 +55,11 @@ static ase_lsp_obj_t* __prim_let (
{
if (ASE_LSP_CDR(v) != lsp->mem->nil)
{
lsp->errnum = ASE_LSP_EARGMANY;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGMANY, ASE_NULL, 0);
return ASE_NULL;
}
if ((v = ase_lsp_eval(lsp, ASE_LSP_CAR(v))) == ASE_NULL)
@ -71,10 +73,11 @@ static ase_lsp_obj_t* __prim_let (
if (ase_lsp_lookupinframe (lsp, frame, n) != ASE_NULL)
{
lsp->errnum = ASE_LSP_EDUPFML;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EDUPFML, ASE_NULL, 0);
return ASE_NULL;
}
if (ase_lsp_insvalueintoframe (lsp, frame, n, v) == ASE_NULL)
@ -89,10 +92,11 @@ static ase_lsp_obj_t* __prim_let (
{
if (ase_lsp_lookupinframe (lsp, frame, ass) != ASE_NULL)
{
lsp->errnum = ASE_LSP_EDUPFML;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EDUPFML, ASE_NULL, 0);
return ASE_NULL;
}
if (ase_lsp_insvalueintoframe (lsp, frame, ass, lsp->mem->nil) == ASE_NULL)
@ -105,10 +109,11 @@ static ase_lsp_obj_t* __prim_let (
}
else
{
lsp->errnum = ASE_LSP_EARGBAD;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -117,10 +122,11 @@ static ase_lsp_obj_t* __prim_let (
if (assoc != lsp->mem->nil)
{
lsp->errnum = ASE_LSP_EARGBAD;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
}

18
ase/lsp/prim_math.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim_math.c,v 1.17 2007-02-10 13:52:23 bacon Exp $
* $Id: prim_math.c,v 1.18 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -57,7 +57,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
}
else
{
lsp->errnum = ASE_LSP_EVALBAD;
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -127,7 +127,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
}
else
{
lsp->errnum = ASE_LSP_EVALBAD;
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -196,7 +196,7 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args)
}
else
{
lsp->errnum = ASE_LSP_EVALBAD;
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -243,7 +243,7 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
if (ASE_LSP_IVAL(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBY0;
ase_lsp_seterror (lsp, ASE_LSP_EDIVBY0, ASE_NULL, 0);
return ASE_NULL;
}
ival = ival / ASE_LSP_IVAL(tmp);
@ -272,7 +272,7 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args)
}
else
{
lsp->errnum = ASE_LSP_EVALBAD;
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
return ASE_NULL;
}
@ -314,7 +314,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{
if (ASE_LSP_IVAL(tmp) == 0)
{
lsp->errnum = ASE_LSP_EDIVBY0;
ase_lsp_seterror (lsp, ASE_LSP_EDIVBY0, ASE_NULL, 0);
return ASE_NULL;
}
ival = ival % ASE_LSP_IVAL(tmp);
@ -331,7 +331,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVAL(tmp);
if (tmpi == 0)
{
lsp->errnum = ASE_LSP_EDIVBY0;
ase_lsp_seterror (lsp, ASE_LSP_EDIVBY0, ASE_NULL, 0);
return ASE_NULL;
}
ival = ival % tmpi;
@ -339,7 +339,7 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args)
}
else
{
lsp->errnum = ASE_LSP_EVALBAD;
ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0);
return ASE_NULL;
}

8
ase/lsp/print.c
View File

@ -1,5 +1,5 @@
/*
* $Id: print.c,v 1.21 2007-02-03 10:51:53 bacon Exp $
* $Id: print.c,v 1.22 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -9,7 +9,7 @@
#define OUTPUT_STR(lsp,str) \
do { \
if (lsp->output_func(ASE_LSP_IO_WRITE, lsp->output_arg, (ase_char_t*)str, ase_lsp_strlen(str)) == -1) { \
lsp->errnum = ASE_LSP_ERR_OUTPUT; \
ase_lsp_seterror (lsp, ASE_LSP_EOUTPUT, ASE_NULL, 0); \
return -1; \
} \
} while (0)
@ -17,7 +17,7 @@
#define OUTPUT_STRX(lsp,str,len) \
do { \
if (lsp->output_func(ASE_LSP_IO_WRITE, lsp->output_arg, (ase_char_t*)str, len) == -1) { \
lsp->errnum = ASE_LSP_ERR_OUTPUT; \
ase_lsp_seterror (lsp, ASE_LSP_EOUTPUT, ASE_NULL, 0); \
return -1; \
} \
} while (0)
@ -28,7 +28,7 @@ static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_con
if (lsp->output_func == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_OUTPUT_NOT_ATTACHED;
ase_lsp_seterror (lsp, ASE_LSP_ENOOUTP, ASE_NULL, 0);
return -1;
}

79
ase/lsp/read.c
View File

@ -1,5 +1,5 @@
/*
* $Id: read.c,v 1.31 2007-02-10 13:52:23 bacon Exp $
* $Id: read.c,v 1.32 2007-02-11 07:36:55 bacon Exp $
*
* {License}
*/
@ -18,17 +18,19 @@
#define TOKEN_TYPE(lsp) (lsp)->token.type
#define TOKEN_IVAL(lsp) (lsp)->token.ival
#define TOKEN_RVAL(lsp) (lsp)->token.rval
#define TOKEN_SVAL(lsp) (lsp)->token.name.buf
#define TOKEN_SPTR(lsp) (lsp)->token.name.buf
#define TOKEN_SLEN(lsp) (lsp)->token.name.size
#define TOKEN_ADD_CHAR(lsp,ch) do { \
#define TOKEN_ADD_CHAR(lsp,ch) \
do { \
if (ase_lsp_name_addc(&(lsp)->token.name, ch) == -1) { \
lsp->errnum = ASE_LSP_ENOMEM; \
ase_lsp_seterror (lsp, ASE_LSP_ENOMEM, ASE_NULL, 0); \
return -1; \
} \
} while (0)
} while (0)
#define TOKEN_COMPARE(lsp,str) ase_lsp_name_compare (&(lsp)->token.name, str)
#define TOKEN_COMPARE(lsp,str) \
ase_lsp_name_compare (&(lsp)->token.name, str)
#define TOKEN_END 0
#define TOKEN_INT 1
@ -69,7 +71,6 @@ ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp)
if (lsp->curc == ASE_CHAR_EOF &&
read_char(lsp) == -1) return ASE_NULL;
lsp->errnum = ASE_LSP_ENOERR;
NEXT_TOKEN (lsp);
lsp->mem->read = read_obj (lsp);
@ -85,7 +86,7 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
switch (TOKEN_TYPE(lsp))
{
case TOKEN_END:
lsp->errnum = ASE_LSP_EEND;
ase_lsp_seterror (lsp, ASE_LSP_EEND, ASE_NULL, 0);
return ASE_NULL;
case TOKEN_LPAREN:
@ -98,26 +99,28 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
case TOKEN_INT:
obj = ase_lsp_makeintobj (lsp->mem, TOKEN_IVAL(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
if (obj == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_REAL:
obj = ase_lsp_makerealobj (lsp->mem, TOKEN_RVAL(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
if (obj == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_STRING:
obj = ase_lsp_makestr (
lsp->mem, TOKEN_SVAL(lsp), TOKEN_SLEN(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
lsp->mem, TOKEN_SPTR(lsp), TOKEN_SLEN(lsp));
if (obj == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_IDENT:
ASE_LSP_ASSERT (lsp,
lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL);
lsp->mem->nil != ASE_NULL &&
lsp->mem->t != ASE_NULL);
if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0)
{
obj = lsp->mem->nil;
@ -129,14 +132,17 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
else
{
obj = ase_lsp_makesym (
lsp->mem, TOKEN_SVAL(lsp), TOKEN_SLEN(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
}
lsp->mem,
TOKEN_SPTR(lsp),
TOKEN_SLEN(lsp));
if (obj == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, obj);
}
return obj;
}
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ESYNTAX, ASE_NULL, 0);
return ASE_NULL;
}
@ -150,7 +156,7 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
if (TOKEN_TYPE(lsp) == TOKEN_END)
{
/* unexpected end of input */
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ESYNTAX, ASE_NULL, 0);
return ASE_NULL;
}
@ -159,7 +165,7 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
if (prev == ASE_NULL)
{
/* unexpected dot */
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ESYNTAX, ASE_NULL, 0);
return ASE_NULL;
}
@ -170,7 +176,7 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
if (lsp->errnum == ASE_LSP_EEND)
{
/* unexpected end of input */
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ESYNTAX, ASE_NULL, 0);
}
return ASE_NULL;
}
@ -180,7 +186,7 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN)
{
/* ) expected */
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ERPAREN, ASE_NULL, 0);
return ASE_NULL;
}
@ -193,18 +199,14 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
if (lsp->errnum == ASE_LSP_EEND)
{
/* unexpected end of input */
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ESYNTAX, ASE_NULL, 0);
}
return ASE_NULL;
}
p = (ase_lsp_obj_cons_t*)ase_lsp_makecons (
lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (p == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, (ase_lsp_obj_t*)p);
if (first == ASE_NULL) first = p;
@ -229,25 +231,17 @@ static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp)
if (lsp->errnum == ASE_LSP_EEND)
{
/* unexpected end of input */
lsp->errnum = ASE_LSP_ESYNTAX;
ase_lsp_seterror (lsp, ASE_LSP_ESYNTAX, ASE_NULL, 0);
}
return ASE_NULL;
}
cons = ase_lsp_makecons (lsp->mem, tmp, lsp->mem->nil);
if (cons == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (cons == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, cons);
cons = ase_lsp_makecons (lsp->mem, lsp->mem->quote, cons);
if (cons == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
if (cons == ASE_NULL) return ASE_NULL;
ase_lsp_lockobj (lsp, cons);
return cons;
@ -260,14 +254,14 @@ static int read_char (ase_lsp_t* lsp)
if (lsp->input_func == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_INPUT_NOT_ATTACHED;
ase_lsp_seterror (lsp, ASE_LSP_ENOINP, ASE_NULL, 0);
return -1;
}
n = lsp->input_func(ASE_LSP_IO_READ, lsp->input_arg, &c, 1);
if (n == -1)
{
lsp->errnum = ASE_LSP_ERR_INPUT;
ase_lsp_seterror (lsp, ASE_LSP_EINPUT, ASE_NULL, 0);
return -1;
}
@ -436,10 +430,7 @@ static int read_string (ase_lsp_t* lsp)
if (c == ASE_CHAR_EOF)
{
/*ase_lsp_seterror (
lsp, ASE_LSP_EENDSTR, lsp->token.line,
ASE_T("string not closed with a quote"));*/
lsp->errnum = ASE_LSP_EENDSTR;
ase_lsp_seterror (lsp, ASE_LSP_EENDSTR, ASE_NULL, 0);
return -1;
}