diff --git a/ase/lsp/aselsp.bdsproj b/ase/lsp/aselsp.bdsproj index 34c69033..198718b4 100644 --- a/ase/lsp/aselsp.bdsproj +++ b/ase/lsp/aselsp.bdsproj @@ -19,15 +19,17 @@ - + - + - + - + + + @@ -38,11 +40,18 @@ + + + + + + + @@ -67,6 +76,9 @@ + + + @@ -85,7 +97,7 @@ - + @@ -204,6 +216,6 @@ - - + + diff --git a/ase/lsp/err.c b/ase/lsp/err.c index 73d39357..132d715e 100644 --- a/ase/lsp/err.c +++ b/ase/lsp/err.c @@ -1,5 +1,5 @@ /* - * $Id: err.c,v 1.5 2006-10-29 13:00:39 bacon Exp $ + * $Id: err.c,v 1.6 2006-10-29 13:40:30 bacon Exp $ */ #include @@ -15,7 +15,7 @@ const ase_char_t* ase_lsp_geterrstr (int errnum) { ASE_T("no error"), ASE_T("out of memory"), - ASE_T("abort"), + ASE_T("exit"), ASE_T("end"), ASE_T("input not attached"), ASE_T("input"), diff --git a/ase/lsp/eval.c b/ase/lsp/eval.c index b99e590e..51c97b6b 100644 --- a/ase/lsp/eval.c +++ b/ase/lsp/eval.c @@ -1,5 +1,5 @@ /* - * $Id: eval.c,v 1.19 2006-10-29 13:00:39 bacon Exp $ + * $Id: eval.c,v 1.20 2006-10-29 13:40:30 bacon Exp $ */ #include @@ -10,6 +10,8 @@ static ase_lsp_obj_t* eval_cons ( ase_lsp_t* lsp, ase_lsp_obj_t* cons); static ase_lsp_obj_t* apply ( ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual); +static ase_lsp_obj_t* apply_to_prim ( + ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual); ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj) { @@ -139,7 +141,7 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons) else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM) { /* primitive function */ - return ASE_LSP_PIMPL(func) (lsp, cdr); + return apply_to_prim (lsp, func, cdr); } else { @@ -321,3 +323,37 @@ static ase_lsp_obj_t* apply ( return value; } +static ase_lsp_obj_t* apply_to_prim ( + ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual) +{ + ase_lsp_obj_t* obj; + ase_size_t count = 0; + + ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM); + + obj = actual; + while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) + { + count++; + obj = ASE_LSP_CDR(obj); + } + if (obj != lsp->mem->nil) + { + lsp->errnum = ASE_LSP_ERR_BAD_ARG; + return ASE_NULL; + } + + if (count < ASE_LSP_PMINARGS(func)) + { + lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS; + return ASE_NULL; + } + + if (count > ASE_LSP_PMAXARGS(func)) + { + lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; + return ASE_NULL; + } + + return ASE_LSP_PIMPL(func) (lsp, actual); +} diff --git a/ase/lsp/lsp.c b/ase/lsp/lsp.c index 19c1e87b..bc33e02b 100644 --- a/ase/lsp/lsp.c +++ b/ase/lsp/lsp.c @@ -1,5 +1,5 @@ /* - * $Id: lsp.c,v 1.13 2006-10-29 13:00:39 bacon Exp $ + * $Id: lsp.c,v 1.14 2006-10-29 13:40:31 bacon Exp $ */ #if defined(__BORLANDC__) @@ -174,7 +174,7 @@ static int __add_builtin_prims (ase_lsp_t* lsp) #define ADD_PRIM(mem,name,name_len,pimpl,min_args,max_args) \ if (ase_lsp_addprim(mem,name,name_len,pimpl,min_args,max_args) == -1) return -1; - ADD_PRIM (lsp, ASE_T("abort"), 5, ase_lsp_prim_abort, 0, 0); + ADD_PRIM (lsp, ASE_T("exit"), 4, ase_lsp_prim_exit, 0, 0); ADD_PRIM (lsp, ASE_T("eval"), 4, ase_lsp_prim_eval, 1, 1); ADD_PRIM (lsp, ASE_T("prog1"), 5, ase_lsp_prim_prog1, 1, ASE_TYPE_MAX(ase_size_t)); ADD_PRIM (lsp, ASE_T("progn"), 5, ase_lsp_prim_progn, 1, ASE_TYPE_MAX(ase_size_t)); @@ -202,7 +202,7 @@ static int __add_builtin_prims (ase_lsp_t* lsp) ADD_PRIM (lsp, ASE_T(">="), 2, ase_lsp_prim_ge, 2, 2); ADD_PRIM (lsp, ASE_T("<="), 2, ase_lsp_prim_le, 2, 2); - ADD_PRIM (lsp, ASE_T("+"), 1, ase_lsp_prim_plus,, 1, ASE_TYPE_MAX(ase_size_t)); + ADD_PRIM (lsp, ASE_T("+"), 1, ase_lsp_prim_plus, 1, ASE_TYPE_MAX(ase_size_t)); ADD_PRIM (lsp, ASE_T("-"), 1, ase_lsp_prim_minus, 1, ASE_TYPE_MAX(ase_size_t)); ADD_PRIM (lsp, ASE_T("*"), 1, ase_lsp_prim_mul, 1, ASE_TYPE_MAX(ase_size_t)); ADD_PRIM (lsp, ASE_T("/"), 1, ase_lsp_prim_div, 1, ASE_TYPE_MAX(ase_size_t)); diff --git a/ase/lsp/lsp.dsp b/ase/lsp/lsp.dsp index b33f3330..9f74839d 100644 --- a/ase/lsp/lsp.dsp +++ b/ase/lsp/lsp.dsp @@ -155,6 +155,10 @@ SOURCE=.\lsp.h # End Source File # Begin Source File +SOURCE=.\lsp_i.h +# End Source File +# Begin Source File + SOURCE=.\mem.h # End Source File # Begin Source File @@ -173,10 +177,6 @@ SOURCE=.\obj.h SOURCE=.\prim.h # End Source File -# Begin Source File - -SOURCE=.\types.h -# End Source File # End Group # End Target # End Project diff --git a/ase/lsp/lsp.h b/ase/lsp/lsp.h index 87a6104a..e5461e2b 100644 --- a/ase/lsp/lsp.h +++ b/ase/lsp/lsp.h @@ -1,5 +1,5 @@ /* - * $Id: lsp.h,v 1.29 2006-10-29 13:00:39 bacon Exp $ + * $Id: lsp.h,v 1.30 2006-10-29 13:40:32 bacon Exp $ */ #ifndef _ASE_LSP_LSP_H_ @@ -70,7 +70,7 @@ enum ASE_LSP_ENOERR, ASE_LSP_ENOMEM, - ASE_LSP_ERR_ABORT, + ASE_LSP_ERR_EXIT, ASE_LSP_ERR_END, ASE_LSP_ERR_INPUT_NOT_ATTACHED, ASE_LSP_ERR_INPUT, diff --git a/ase/lsp/mem.c b/ase/lsp/mem.c index ece9ec4d..ebf03259 100644 --- a/ase/lsp/mem.c +++ b/ase/lsp/mem.c @@ -1,5 +1,5 @@ /* - * $Id: mem.c,v 1.17 2006-10-29 13:00:39 bacon Exp $ + * $Id: mem.c,v 1.18 2006-10-29 13:40:33 bacon Exp $ */ #include @@ -590,20 +590,5 @@ ase_size_t ase_lsp_conslen (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj) return count; } -int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len) -{ - ase_size_t count = 0; - - while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) - { - count++; - obj = ASE_LSP_CDR(obj); - } - - if (obj != mem->nil) return -1; - - *len = count; - return 0; -} diff --git a/ase/lsp/mem.h b/ase/lsp/mem.h index c579f503..6243105e 100644 --- a/ase/lsp/mem.h +++ b/ase/lsp/mem.h @@ -1,5 +1,5 @@ /* - * $Id: mem.h,v 1.13 2006-10-29 13:00:39 bacon Exp $ + * $Id: mem.h,v 1.14 2006-10-29 13:40:33 bacon Exp $ */ #ifndef _ASE_LSP_MEM_H_ @@ -67,7 +67,7 @@ void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj); void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj); void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj); -// object creation of standard types +/* object creation of standard types */ ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem); ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem); ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value); @@ -88,16 +88,15 @@ ase_lsp_obj_t* ase_lsp_makemacro ( ase_lsp_obj_t* ase_lsp_makeprim (ase_lsp_mem_t* mem, ase_lsp_prim_t impl, ase_size_t min_args, ase_size_t max_args); -// frame lookup +/* frame lookup */ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name); ase_lsp_assoc_t* ase_lsp_setvalue ( ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value); ase_lsp_assoc_t* ase_lsp_setfunc ( ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func); -// cons operations +/* cons operations */ ase_size_t ase_lsp_conslen (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj); -int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len); #ifdef __cplusplus } diff --git a/ase/lsp/prim.c b/ase/lsp/prim.c index 866babc9..82d50ba0 100644 --- a/ase/lsp/prim.c +++ b/ase/lsp/prim.c @@ -1,5 +1,5 @@ /* - * $Id: prim.c,v 1.14 2006-10-29 13:00:39 bacon Exp $ + * $Id: prim.c,v 1.15 2006-10-29 13:40:33 bacon Exp $ */ #include @@ -42,10 +42,9 @@ static int __add_prim (ase_lsp_mem_t* mem, return 0; } -ase_lsp_obj_t* ase_lsp_prim_abort (ase_lsp_t* lsp, ase_lsp_obj_t* args) +ase_lsp_obj_t* ase_lsp_prim_exit (ase_lsp_t* lsp, ase_lsp_obj_t* args) { - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); - lsp->errnum = ASE_LSP_ERR_ABORT; + lsp->errnum = ASE_LSP_ERR_EXIT; return ASE_NULL; } @@ -53,7 +52,6 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -67,7 +65,6 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args) { - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); ase_lsp_collectgarbage (lsp->mem); return lsp->mem->nil; } @@ -84,8 +81,6 @@ ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp, * ret; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, ASE_LSP_PRIM_MAX_ARG_COUNT); - while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(ASE_LSP_CAR(args)) != ASE_LSP_OBJ_CONS) @@ -125,7 +120,6 @@ ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -168,10 +162,10 @@ ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); - for (;;) { + while (1) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; if (tmp == lsp->mem->nil) break; @@ -202,7 +196,6 @@ ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -226,7 +219,6 @@ ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -251,7 +243,6 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* car, * cdr, * cons; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); car = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -280,7 +271,6 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -351,7 +341,6 @@ ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args) * (quote (10 20 30 50)) */ - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); return ASE_LSP_CAR(args); } @@ -369,8 +358,6 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* name, * fun; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT); - name = ASE_LSP_CAR(args); if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM) { @@ -399,8 +386,6 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* name, * mac; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT); - name = ASE_LSP_CAR(args); if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM) { diff --git a/ase/lsp/prim.h b/ase/lsp/prim.h index f6dd1ece..7a5e4c2f 100644 --- a/ase/lsp/prim.h +++ b/ase/lsp/prim.h @@ -1,17 +1,19 @@ /* - * $Id: prim.h,v 1.10 2006-10-29 13:00:39 bacon Exp $ + * $Id: prim.h,v 1.11 2006-10-29 13:40:33 bacon Exp $ */ #ifndef _ASE_LSP_PRIM_H_ #define _ASE_LSP_PRIM_H_ -#include +#ifndef _ASE_LSP_LSP_H_ +#error Never include this file directly. Include instead +#endif #ifdef __cplusplus extern "C" { #endif -ase_lsp_obj_t* ase_lsp_prim_abort (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_exit (ase_lsp_t* lsp, ase_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args); @@ -54,23 +56,4 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args); } #endif -#define ASE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \ -{ \ - ase_size_t count; \ - if (ase_lsp_probeargs(lsp->mem, args, &count) == -1) { \ - lsp->errnum = ASE_LSP_ERR_BAD_ARG; \ - return ASE_NULL; \ - } \ - if (count < min) { \ - lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS; \ - return ASE_NULL; \ - } \ - if (count > max) { \ - lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; \ - return ASE_NULL; \ - } \ -} - -#define ASE_LSP_PRIM_MAX_ARG_COUNT ((ase_size_t)~(ase_size_t)0) - #endif diff --git a/ase/lsp/prim_compar.c b/ase/lsp/prim_compar.c index 5001be86..bcf627cc 100644 --- a/ase/lsp/prim_compar.c +++ b/ase/lsp/prim_compar.c @@ -1,5 +1,5 @@ /* - * $Id: prim_compar.c,v 1.7 2006-10-26 09:31:28 bacon Exp $ + * $Id: prim_compar.c,v 1.8 2006-10-29 13:40:33 bacon Exp $ */ #include @@ -9,7 +9,6 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; int res; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -92,7 +91,6 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; int res; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -176,7 +174,6 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; int res; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -260,7 +257,6 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; int res; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -343,7 +339,6 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; int res; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -426,7 +421,6 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* p1, * p2; int res; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); @@ -490,7 +484,8 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args) ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0; } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } diff --git a/ase/lsp/prim_let.c b/ase/lsp/prim_let.c index e230fe5c..b95b591a 100644 --- a/ase/lsp/prim_let.c +++ b/ase/lsp/prim_let.c @@ -1,5 +1,5 @@ /* - * $Id: prim_let.c,v 1.7 2006-10-26 08:17:37 bacon Exp $ + * $Id: prim_let.c,v 1.8 2006-10-29 13:40:33 bacon Exp $ */ #include @@ -12,8 +12,6 @@ static ase_lsp_obj_t* __prim_let ( ase_lsp_obj_t* body; ase_lsp_obj_t* value; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); - // create a new frame frame = ase_lsp_newframe (lsp); if (frame == ASE_NULL) @@ -129,19 +127,22 @@ static ase_lsp_obj_t* __prim_let ( return ASE_NULL; } - // push the frame - if (!sequential) { + /* push the frame */ + if (!sequential) + { lsp->mem->brooding_frame = frame->link; frame->link = lsp->mem->frame; lsp->mem->frame = frame; } - // evaluate forms in the body + /* evaluate forms in the body */ value = lsp->mem->nil; body = ASE_LSP_CDR(args); - while (body != lsp->mem->nil) { + while (body != lsp->mem->nil) + { value = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); - if (value == ASE_NULL) { + if (value == ASE_NULL) + { lsp->mem->frame = frame->link; ase_lsp_freeframe (lsp, frame); return ASE_NULL; @@ -149,10 +150,10 @@ static ase_lsp_obj_t* __prim_let ( body = ASE_LSP_CDR(body); } - // pop the frame + /* pop the frame */ lsp->mem->frame = frame->link; - // destroy the frame + /* destroy the frame */ ase_lsp_freeframe (lsp, frame); return value; } diff --git a/ase/lsp/prim_math.c b/ase/lsp/prim_math.c index 6dbee6d0..0d4999b1 100644 --- a/ase/lsp/prim_math.c +++ b/ase/lsp/prim_math.c @@ -1,5 +1,5 @@ /* - * $Id: prim_math.c,v 1.12 2006-10-29 13:00:39 bacon Exp $ + * $Id: prim_math.c,v 1.13 2006-10-29 13:40:33 bacon Exp $ */ #include @@ -11,45 +11,54 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; - //while (body != lsp->mem->nil) { - while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) { + /*while (body != lsp->mem->nil) */ + while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); - if (tmp == ASE_NULL) { + if (tmp == ASE_NULL) + { /*lsp->errnum = ASE_LSP_ERR_BAD_VALUE; */ return ASE_NULL; } - if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { - if (body == args) { + if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } - else { + else + { if (!realnum) ivalue = ivalue + ASE_LSP_IVALUE(tmp); else rvalue = rvalue + ASE_LSP_IVALUE(tmp); } } - else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { - if (body == args) { + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } - else { - if (!realnum) { + else + { + if (!realnum) + { realnum = ase_true; rvalue = (ase_real_t)ivalue; } rvalue = rvalue + ASE_LSP_RVALUE(tmp); } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -63,7 +72,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); - if (tmp == ASE_NULL) { + if (tmp == ASE_NULL) + { lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -78,43 +88,51 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; - //while (body != lsp->mem->nil) { - while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) { + /*while (body != lsp->mem->nil) */ + while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); if (tmp == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { - if (body == args) { + if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } - else { + else + { if (!realnum) ivalue = ivalue - ASE_LSP_IVALUE(tmp); else rvalue = rvalue - ASE_LSP_IVALUE(tmp); } } - else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { - if (body == args) { + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } - else { - if (!realnum) { + else + { + if (!realnum) + { realnum = ase_true; rvalue = (ase_real_t)ivalue; } rvalue = rvalue - ASE_LSP_RVALUE(tmp); } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -128,7 +146,8 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); - if (tmp == ASE_NULL) { + if (tmp == ASE_NULL) + { lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -143,43 +162,50 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; - //while (body != lsp->mem->nil) { - while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) { + /*while (body != lsp->mem->nil) */ + while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); if (tmp == ASE_NULL) return ASE_NULL; - - if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { - if (body == args) { + if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } - else { + else + { if (!realnum) ivalue = ivalue * ASE_LSP_IVALUE(tmp); else rvalue = rvalue * ASE_LSP_IVALUE(tmp); } } - else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { - if (body == args) { + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } - else { - if (!realnum) { + else + { + if (!realnum) + { realnum = ase_true; rvalue = (ase_real_t)ivalue; } rvalue = rvalue * ASE_LSP_RVALUE(tmp); } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -193,7 +219,8 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args) tmp = (realnum)? ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makeintobj (lsp->mem, ivalue); - if (tmp == ASE_NULL) { + if (tmp == ASE_NULL) + { lsp->errnum = ASE_LSP_ENOMEM; return ASE_NULL; } @@ -208,24 +235,28 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_real_t rvalue = .0; ase_bool_t realnum = ase_false; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; - //while (body != lsp->mem->nil) { - while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) { + /*while (body != lsp->mem->nil)*/ + while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); if (tmp == ASE_NULL) return ASE_NULL; - - if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { - if (body == args) { + if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); ivalue = ASE_LSP_IVALUE(tmp); } - else { - if (!realnum) { - if (ASE_LSP_IVALUE(tmp) == 0) { + else + { + if (!realnum) + { + if (ASE_LSP_IVALUE(tmp) == 0) + { lsp->errnum = ASE_LSP_EDIVBYZERO; return ASE_NULL; } @@ -235,21 +266,26 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args) rvalue = rvalue / ASE_LSP_IVALUE(tmp); } } - else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { - if (body == args) { + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) + { + if (body == args) + { ASE_LSP_ASSERT (lsp, realnum == ase_false); realnum = ase_true; rvalue = ASE_LSP_RVALUE(tmp); } - else { - if (!realnum) { + else + { + if (!realnum) + { realnum = ase_true; rvalue = (ase_real_t)ivalue; } rvalue = rvalue / ASE_LSP_RVALUE(tmp); } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } @@ -277,41 +313,50 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* body, * tmp; ase_long_t ivalue = 0; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); body = args; //while (body != lsp->mem->nil) { - while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) { + while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); if (tmp == ASE_NULL) return ASE_NULL; - if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { - if (body == args) { + if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) + { + if (body == args) + { ivalue = ASE_LSP_IVALUE(tmp); } - else { - if (ASE_LSP_IVALUE(tmp) == 0) { + else + { + if (ASE_LSP_IVALUE(tmp) == 0) + { lsp->errnum = ASE_LSP_EDIVBYZERO; return ASE_NULL; } ivalue = ivalue % ASE_LSP_IVALUE(tmp); } } - else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { - if (body == args) { + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) + { + if (body == args) + { ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp); } - else { + else + { ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp); - if (tmpi == 0) { + if (tmpi == 0) + { lsp->errnum = ASE_LSP_EDIVBYZERO; return ASE_NULL; } ivalue = ivalue % tmpi; } } - else { + else + { lsp->errnum = ASE_LSP_ERR_BAD_VALUE; return ASE_NULL; } diff --git a/ase/lsp/prim_prog.c b/ase/lsp/prim_prog.c index 1b8f442e..97d5b107 100644 --- a/ase/lsp/prim_prog.c +++ b/ase/lsp/prim_prog.c @@ -1,5 +1,5 @@ /* - * $Id: prim_prog.c,v 1.4 2006-10-26 08:17:38 bacon Exp $ + * $Id: prim_prog.c,v 1.5 2006-10-29 13:40:33 bacon Exp $ */ #include @@ -8,15 +8,14 @@ ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* res = ASE_NULL, * tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); - - //while (args != lsp->mem->nil) { - while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) { - + /*while (args != lsp->mem->nil) {*/ + while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; - if (res == ASE_NULL) { + if (res == ASE_NULL) + { /* ase_lsp_arr_t* ta = lsp->mem->temp_arr; ase_lsp_arr_insert (ta, ta->size, tmp); @@ -33,11 +32,10 @@ ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args) { ase_lsp_obj_t* res, * tmp; - ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); - res = lsp->mem->nil; - //while (args != lsp->mem->nil) { - while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) { + /*while (args != lsp->mem->nil) {*/ + while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) + { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); if (tmp == ASE_NULL) return ASE_NULL; diff --git a/ase/test/lsp/lsp.c b/ase/test/lsp/lsp.c index 3cbcef95..875d8e14 100644 --- a/ase/test/lsp/lsp.c +++ b/ase/test/lsp/lsp.c @@ -324,7 +324,7 @@ int __main (int argc, xp_char_t* argv[]) const xp_char_t* errstr; if (errnum != ASE_LSP_ERR_END && - errnum != ASE_LSP_ERR_ABORT) + errnum != ASE_LSP_ERR_EXIT) { errstr = ase_lsp_geterrstr(errnum); xp_fprintf (xp_stderr, @@ -346,7 +346,7 @@ int __main (int argc, xp_char_t* argv[]) const xp_char_t* errstr; errnum = ase_lsp_geterrnum(lsp); - if (errnum == ASE_LSP_ERR_ABORT) break; + if (errnum == ASE_LSP_ERR_EXIT) break; errstr = ase_lsp_geterrstr(errnum); xp_fprintf (xp_stderr,