From 2eb07c0ad85582e051fbc81228d6eca26194af4d Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 13 Feb 2007 06:00:20 +0000 Subject: [PATCH] *** empty log message *** --- ase/lsp/lsp.c | 42 +++++++++++++++--------------- ase/lsp/mem.c | 12 +++++---- ase/lsp/prim.c | 62 ++++++++++++++++++++++++++++++++++++++++++++- ase/lsp/prim.h | 42 +++++++++++++++--------------- ase/lsp/prim_let.c | 9 ++++++- ase/lsp/prim_math.c | 7 +---- ase/lsp/print.c | 5 +++- 7 files changed, 125 insertions(+), 54 deletions(-) diff --git a/ase/lsp/lsp.c b/ase/lsp/lsp.c index f070657a..4f5da182 100644 --- a/ase/lsp/lsp.c +++ b/ase/lsp/lsp.c @@ -1,5 +1,5 @@ /* - * $Id: lsp.c,v 1.23 2007-02-11 08:30:18 bacon Exp $ + * $Id: lsp.c,v 1.24 2007-02-13 06:00:20 bacon Exp $ * * {License} */ @@ -186,27 +186,29 @@ static int __add_builtin_prims (ase_lsp_t* lsp) if (ase_lsp_addprim(mem,name,name_len,pimpl,min_args,max_args) == -1) return -1; #define MAX_ARGS ASE_TYPE_MAX(ase_size_t) - 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, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("progn"), 5, ase_lsp_prim_progn, 1, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("gc"), 2, ase_lsp_prim_gc, 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, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("progn"), 5, ase_lsp_prim_progn, 1, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("gc"), 2, ase_lsp_prim_gc, 0, 0); - ADD_PRIM (lsp, ASE_T("cond"), 4, ase_lsp_prim_cond, 0, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("if"), 2, ase_lsp_prim_if, 2, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("while"), 5, ase_lsp_prim_while, 1, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("cond"), 4, ase_lsp_prim_cond, 0, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("if"), 2, ase_lsp_prim_if, 2, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("while"), 5, ase_lsp_prim_while, 1, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("car"), 3, ase_lsp_prim_car, 1, 1); - ADD_PRIM (lsp, ASE_T("cdr"), 3, ase_lsp_prim_cdr, 1, 1); - ADD_PRIM (lsp, ASE_T("cons"), 4, ase_lsp_prim_cons, 2, 2); - ADD_PRIM (lsp, ASE_T("set"), 3, ase_lsp_prim_set, 2, 2); - ADD_PRIM (lsp, ASE_T("setq"), 4, ase_lsp_prim_setq, 1, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("quote"), 5, ase_lsp_prim_quote, 1, 1); - ADD_PRIM (lsp, ASE_T("defun"), 5, ase_lsp_prim_defun, 3, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("demac"), 5, ase_lsp_prim_demac, 3, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("let"), 3, ase_lsp_prim_let, 1, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("let*"), 4, ase_lsp_prim_letx, 1, MAX_ARGS); - ADD_PRIM (lsp, ASE_T("or"), 2, ase_lsp_prim_or, 2, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("car"), 3, ase_lsp_prim_car, 1, 1); + ADD_PRIM (lsp, ASE_T("cdr"), 3, ase_lsp_prim_cdr, 1, 1); + ADD_PRIM (lsp, ASE_T("cons"), 4, ase_lsp_prim_cons, 2, 2); + ADD_PRIM (lsp, ASE_T("length"), 6, ase_lsp_prim_length, 1, 1); + + ADD_PRIM (lsp, ASE_T("set"), 3, ase_lsp_prim_set, 2, 2); + ADD_PRIM (lsp, ASE_T("setq"), 4, ase_lsp_prim_setq, 1, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("quote"), 5, ase_lsp_prim_quote, 1, 1); + ADD_PRIM (lsp, ASE_T("defun"), 5, ase_lsp_prim_defun, 3, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("demac"), 5, ase_lsp_prim_demac, 3, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("let"), 3, ase_lsp_prim_let, 1, MAX_ARGS); + ADD_PRIM (lsp, ASE_T("let*"), 4, ase_lsp_prim_letx, 1, MAX_ARGS); + /*ADD_PRIM (lsp, ASE_T("or"), 2, ase_lsp_prim_or, 2, MAX_ARGS);*/ ADD_PRIM (lsp, ASE_T("="), 1, ase_lsp_prim_eq, 2, 2); ADD_PRIM (lsp, ASE_T("/="), 2, ase_lsp_prim_ne, 2, 2); diff --git a/ase/lsp/mem.c b/ase/lsp/mem.c index bc5bdcf5..d1a0bfaa 100644 --- a/ase/lsp/mem.c +++ b/ase/lsp/mem.c @@ -1,5 +1,5 @@ /* - * $Id: mem.c,v 1.29 2007-02-11 07:36:55 bacon Exp $ + * $Id: mem.c,v 1.30 2007-02-13 06:00:20 bacon Exp $ * * {License} */ @@ -350,13 +350,15 @@ static void __sweep_unmarked_objs (ase_lsp_mem_t* mem) { /* dispose of unused objects */ if (i == ASE_LSP_OBJ_INT) -wprintf (ASE_T("disposing....%d [%d]\n"), i, (int)ASE_LSP_IVAL(obj)); +ase_printf (ASE_T("disposing....%d [%d]\n"), i, (int)ASE_LSP_IVAL(obj)); if (i == ASE_LSP_OBJ_REAL) -wprintf (ASE_T("disposing....%d [%Lf]\n"), i, (double)ASE_LSP_RVAL(obj)); +ase_printf (ASE_T("disposing....%d [%Lf]\n"), i, (double)ASE_LSP_RVAL(obj)); else if (i == ASE_LSP_OBJ_SYM) -wprintf (ASE_T("disposing....%d [%s]\n"), i, ASE_LSP_SYMPTR(obj)); +ase_printf (ASE_T("disposing....%d [%s]\n"), i, ASE_LSP_SYMPTR(obj)); +else if (i == ASE_LSP_OBJ_STR) +ase_printf (ASE_T("disposing....%d [%s]\n"), i, ASE_LSP_STRPTR(obj)); else -wprintf (ASE_T("disposing....%d\n"), i); +ase_printf (ASE_T("disposing....%d\n"), i); ase_lsp_dispose (mem, prev, obj); } else diff --git a/ase/lsp/prim.c b/ase/lsp/prim.c index 3530f98b..71617d0e 100644 --- a/ase/lsp/prim.c +++ b/ase/lsp/prim.c @@ -1,5 +1,5 @@ /* - * $Id: prim.c,v 1.22 2007-02-11 07:36:55 bacon Exp $ + * $Id: prim.c,v 1.23 2007-02-13 06:00:20 bacon Exp $ * * {License} */ @@ -365,6 +365,66 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args) return cons; } +ase_lsp_obj_t* ase_lsp_prim_length (ase_lsp_t* lsp, ase_lsp_obj_t* args) +{ + ase_lsp_obj_t* body, * tmp; + ase_long_t len = 0; + + ASE_LSP_ASSERT (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); + + body = args; + 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_NIL) + { + len = 0; + } + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_STR) + { + len = ASE_LSP_STRLEN(tmp); + } + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_SYM) + { + len = ASE_LSP_SYMLEN(tmp); + } + else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS) + { + len = 0; + do + { + len++; + tmp = ASE_LSP_CDR(tmp); + } + while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS); + + /* TODO: more flexible without the check below? + * both of the following expression evalute + * to 3 without it. + * (length '(9 9 9 . 9)) + * (length '(9 9 9)) + */ + if (ASE_LSP_TYPE(tmp) != ASE_LSP_OBJ_NIL) + { + ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); + return ASE_NULL; + } + } + else + { + ase_lsp_seterror (lsp, ASE_LSP_EVALBAD, ASE_NULL, 0); + return ASE_NULL; + } + + body = ASE_LSP_CDR(body); + } + + ASE_LSP_ASSERT (lsp, body == lsp->mem->nil); + return ase_lsp_makeintobj (lsp->mem, len); +} + ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args) { /* diff --git a/ase/lsp/prim.h b/ase/lsp/prim.h index 8ee9fd7b..ac1b5322 100644 --- a/ase/lsp/prim.h +++ b/ase/lsp/prim.h @@ -1,5 +1,5 @@ /* - * $Id: prim.h,v 1.14 2007-02-03 10:51:53 bacon Exp $ + * $Id: prim.h,v 1.15 2007-02-13 06:00:20 bacon Exp $ * * {License} */ @@ -15,26 +15,28 @@ extern "C" { #endif -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); -ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_while (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); +ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_let (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_letx (ase_lsp_t* lsp, ase_lsp_obj_t* args); -ase_lsp_obj_t* ase_lsp_prim_or (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_length (ase_lsp_t* lsp, ase_lsp_obj_t* args); + +ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_let (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_letx (ase_lsp_t* lsp, ase_lsp_obj_t* args); +ase_lsp_obj_t* ase_lsp_prim_or (ase_lsp_t* lsp, ase_lsp_obj_t* args); /*--------------------- prim_compar.c diff --git a/ase/lsp/prim_let.c b/ase/lsp/prim_let.c index 5ddc90b3..024646f2 100644 --- a/ase/lsp/prim_let.c +++ b/ase/lsp/prim_let.c @@ -1,11 +1,18 @@ /* - * $Id: prim_let.c,v 1.12 2007-02-11 07:36:55 bacon Exp $ + * $Id: prim_let.c,v 1.13 2007-02-13 06:00:20 bacon Exp $ * * {License} */ #include +/* + * (let ((variable value) + * (variable value) + * ...) + * body...) + */ + static ase_lsp_obj_t* __prim_let ( ase_lsp_t* lsp, ase_lsp_obj_t* args, int sequential) { diff --git a/ase/lsp/prim_math.c b/ase/lsp/prim_math.c index 0ecad970..06771d63 100644 --- a/ase/lsp/prim_math.c +++ b/ase/lsp/prim_math.c @@ -1,5 +1,5 @@ /* - * $Id: prim_math.c,v 1.18 2007-02-11 07:36:55 bacon Exp $ + * $Id: prim_math.c,v 1.19 2007-02-13 06:00:20 bacon Exp $ * * {License} */ @@ -16,7 +16,6 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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) { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); @@ -85,7 +84,6 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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) { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); @@ -155,7 +153,6 @@ ase_lsp_obj_t* ase_lsp_prim_mul (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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) { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); @@ -224,7 +221,6 @@ ase_lsp_obj_t* ase_lsp_prim_div (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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) { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); @@ -298,7 +294,6 @@ ase_lsp_obj_t* ase_lsp_prim_mod (ase_lsp_t* lsp, ase_lsp_obj_t* args) 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) { tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); diff --git a/ase/lsp/print.c b/ase/lsp/print.c index 82a703a7..9458fd52 100644 --- a/ase/lsp/print.c +++ b/ase/lsp/print.c @@ -1,5 +1,5 @@ /* - * $Id: print.c,v 1.22 2007-02-11 07:36:55 bacon Exp $ + * $Id: print.c,v 1.23 2007-02-13 06:00:20 bacon Exp $ * * {License} */ @@ -71,7 +71,10 @@ static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_con break; case ASE_LSP_OBJ_STR: + OUTPUT_STR (lsp, ASE_T("\"")); + /* TODO: deescaping */ OUTPUT_STRX (lsp, ASE_LSP_STRPTR(obj), ASE_LSP_STRLEN(obj)); + OUTPUT_STR (lsp, ASE_T("\"")); break; case ASE_LSP_OBJ_CONS: