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-13 06:00:20 +00:00
parent c61933deb2
commit 2eb07c0ad8
7 changed files with 125 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
ase/lsp/lsp.c
View File

@ -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);

12
ase/lsp/mem.c
View File

@ -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

62
ase/lsp/prim.c
View File

@ -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)
{
/*

42
ase/lsp/prim.h
View File

@ -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

9
ase/lsp/prim_let.c
View File

@ -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 <ase/lsp/lsp_i.h>
/*
* (let ((variable value)
* (variable value)
* ...)
* body...)
*/
static ase_lsp_obj_t* __prim_let (
ase_lsp_t* lsp, ase_lsp_obj_t* args, int sequential)
{

7
ase/lsp/prim_math.c
View File

@ -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));

5
ase/lsp/print.c
View File

@ -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: