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

initial import

Browse Source
This commit is contained in:
hyung-hwan
2008-12-21 21:35:07 +00:00
parent 4c01ea1604
commit 4803bd861a
384 changed files with 24572 additions and 53621 deletions
Download Patch File Download Diff File Expand all files Collapse all files

314
qse/lib/lsp/eval.c
View File

@ -6,53 +6,53 @@
#include "lsp.h"
static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
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);
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);
static qse_lsp_obj_t* __eval (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
static qse_lsp_obj_t* makefn (
qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro);
static qse_lsp_obj_t* eval_cons (
qse_lsp_t* lsp, qse_lsp_obj_t* cons);
static qse_lsp_obj_t* apply (
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual);
static qse_lsp_obj_t* apply_to_prim (
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual);
ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
qse_lsp_obj_t* qse_lsp_eval (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
{
return eval_cons (lsp, obj);
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYM)
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_SYM)
{
ase_lsp_assoc_t* assoc;
qse_lsp_assoc_t* assoc;
/*
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
ase_char_t* arg[1];
qse_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(obj);
arg[0] = QSE_LSP_SYMPTR(obj);
printf ("lambda or macro can't be used as a normal symbol\n");
ase_lsp_seterror (
lsp, ASE_LSP_EBADSYM,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
qse_lsp_seterror (
lsp, QSE_LSP_EBADSYM,
arg, QSE_COUNTOF(arg));
return QSE_NULL;
}
*/
assoc = ase_lsp_lookup(lsp->mem, obj);
if (assoc == ASE_NULL || assoc->value == ASE_NULL)
assoc = qse_lsp_lookup(lsp->mem, obj);
if (assoc == QSE_NULL || assoc->value == QSE_NULL)
{
if (lsp->opt_undef_symbol)
{
const ase_char_t* arg[1];
const qse_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(obj);
arg[0] = QSE_LSP_SYMPTR(obj);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFSYM,
arg, ASE_COUNTOF(arg));
return ASE_NULL;
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFSYM,
arg, QSE_COUNTOF(arg));
return QSE_NULL;
}
return lsp->mem->nil;
}
@ -63,59 +63,59 @@ ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
return obj;
}
static ase_lsp_obj_t* makefn (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro)
static qse_lsp_obj_t* makefn (qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro)
{
ase_lsp_obj_t* func, * formal, * body, * p;
qse_lsp_obj_t* func, * formal, * body, * p;
if (cdr == lsp->mem->nil)
{
ase_lsp_seterror (lsp, ASE_LSP_EARGFEW, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, 0);
return QSE_NULL;
}
if (ASE_LSP_TYPE(cdr) != ASE_LSP_OBJ_CONS)
if (QSE_LSP_TYPE(cdr) != QSE_LSP_OBJ_CONS)
{
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
return QSE_NULL;
}
formal = ASE_LSP_CAR(cdr);
body = ASE_LSP_CDR(cdr);
formal = QSE_LSP_CAR(cdr);
body = QSE_LSP_CDR(cdr);
if (body == lsp->mem->nil)
{
ase_lsp_seterror (lsp, ASE_LSP_EEMPBDY, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EEMPBDY, QSE_NULL, 0);
return QSE_NULL;
}
/* TODO: more lambda expression syntax checks required???. */
/* check if the lambda express has non-nil value
* at the terminating cdr */
for (p = body; ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS; p = ASE_LSP_CDR(p));
for (p = body; QSE_LSP_TYPE(p) == QSE_LSP_OBJ_CONS; p = QSE_LSP_CDR(p));
if (p != lsp->mem->nil)
{
/* like in (lambda (x) (+ x 10) . 4) */
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
return QSE_NULL;
}
func = (is_macro)?
ase_lsp_makemacro (lsp->mem, formal, body):
ase_lsp_makefunc (lsp->mem, formal, body);
if (func == ASE_NULL) return ASE_NULL;
qse_lsp_makemacro (lsp->mem, formal, body):
qse_lsp_makefunc (lsp->mem, formal, body);
if (func == QSE_NULL) return QSE_NULL;
return func;
}
static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
static qse_lsp_obj_t* eval_cons (qse_lsp_t* lsp, qse_lsp_obj_t* cons)
{
ase_lsp_obj_t* car, * cdr;
qse_lsp_obj_t* car, * cdr;
ASE_ASSERT (ASE_LSP_TYPE(cons) == ASE_LSP_OBJ_CONS);
QSE_ASSERT (QSE_LSP_TYPE(cons) == QSE_LSP_OBJ_CONS);
car = ASE_LSP_CAR(cons);
cdr = ASE_LSP_CDR(cons);
car = QSE_LSP_CAR(cons);
cdr = QSE_LSP_CDR(cons);
if (car == lsp->mem->lambda)
{
@ -127,118 +127,118 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
/* (macro (x) (+ x 20)) */
return makefn (lsp, cdr, 1);
}
else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYM)
else if (QSE_LSP_TYPE(car) == QSE_LSP_OBJ_SYM)
{
ase_lsp_assoc_t* assoc;
qse_lsp_assoc_t* assoc;
if ((assoc = ase_lsp_lookup(lsp->mem, car)) != ASE_NULL)
if ((assoc = qse_lsp_lookup(lsp->mem, car)) != QSE_NULL)
{
/*ase_lsp_obj_t* func = assoc->value;*/
ase_lsp_obj_t* func = assoc->func;
if (func == ASE_NULL)
/*qse_lsp_obj_t* func = assoc->value;*/
qse_lsp_obj_t* func = assoc->func;
if (func == QSE_NULL)
{
/* the symbol's function definition is void */
const ase_char_t* arg[1];
const qse_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(car);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFFN,
arg, ASE_COUNTOF(arg));
arg[0] = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFFN,
arg, QSE_COUNTOF(arg));
return ASE_NULL;
return QSE_NULL;
}
if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC ||
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_FUNC ||
QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO)
{
return apply (lsp, func, cdr);
}
else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM)
else if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_PRIM)
{
/* primitive function */
return apply_to_prim (lsp, func, cdr);
}
else
{
const ase_char_t* arg[1];
const qse_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(car);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFFN,
arg, ASE_COUNTOF(arg));
arg[0] = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFFN,
arg, QSE_COUNTOF(arg));
return ASE_NULL;
return QSE_NULL;
}
}
else
{
const ase_char_t* arg[1];
const qse_char_t* arg[1];
arg[0] = ASE_LSP_SYMPTR(car);
ase_lsp_seterror (
lsp, ASE_LSP_EUNDEFFN,
arg, ASE_COUNTOF(arg));
arg[0] = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFFN,
arg, QSE_COUNTOF(arg));
return ASE_NULL;
return QSE_NULL;
}
}
else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_FUNC ||
ASE_LSP_TYPE(car) == ASE_LSP_OBJ_MACRO)
else if (QSE_LSP_TYPE(car) == QSE_LSP_OBJ_FUNC ||
QSE_LSP_TYPE(car) == QSE_LSP_OBJ_MACRO)
{
return apply (lsp, car, cdr);
}
else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_CONS)
else if (QSE_LSP_TYPE(car) == QSE_LSP_OBJ_CONS)
{
/* anonymous function or macros
* ((lambda (x) (+ x 10)) 50) */
if (ASE_LSP_CAR(car) == lsp->mem->lambda)
if (QSE_LSP_CAR(car) == lsp->mem->lambda)
{
ase_lsp_obj_t* func = makefn (lsp, ASE_LSP_CDR(car), 0);
if (func == ASE_NULL) return ASE_NULL;
qse_lsp_obj_t* func = makefn (lsp, QSE_LSP_CDR(car), 0);
if (func == QSE_NULL) return QSE_NULL;
return apply (lsp, func, cdr);
}
else if (ASE_LSP_CAR(car) == lsp->mem->macro)
else if (QSE_LSP_CAR(car) == lsp->mem->macro)
{
ase_lsp_obj_t* func = makefn (lsp, ASE_LSP_CDR(car), 1);
if (func == ASE_NULL) return ASE_NULL;
qse_lsp_obj_t* func = makefn (lsp, QSE_LSP_CDR(car), 1);
if (func == QSE_NULL) return QSE_NULL;
return apply (lsp, func, cdr);
}
}
ase_lsp_seterror (lsp, ASE_LSP_EBADFN, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EBADFN, QSE_NULL, 0);
return QSE_NULL;
}
static ase_lsp_obj_t* apply (
ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual)
static qse_lsp_obj_t* apply (
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual)
{
ase_lsp_frame_t* frame;
ase_lsp_obj_t* formal;
ase_lsp_obj_t* body;
ase_lsp_obj_t* value;
ase_lsp_mem_t* mem;
qse_lsp_frame_t* frame;
qse_lsp_obj_t* formal;
qse_lsp_obj_t* body;
qse_lsp_obj_t* value;
qse_lsp_mem_t* mem;
ASE_ASSERT (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC ||
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO);
QSE_ASSERT (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_FUNC ||
QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO);
ASE_ASSERT (ASE_LSP_TYPE(ASE_LSP_CDR(func)) == ASE_LSP_OBJ_CONS);
QSE_ASSERT (QSE_LSP_TYPE(QSE_LSP_CDR(func)) == QSE_LSP_OBJ_CONS);
mem = lsp->mem;
if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO)
{
formal = ASE_LSP_MFORMAL (func);
body = ASE_LSP_MBODY (func);
formal = QSE_LSP_MFORMAL (func);
body = QSE_LSP_MBODY (func);
}
else
{
formal = ASE_LSP_FFORMAL (func);
body = ASE_LSP_FBODY (func);
formal = QSE_LSP_FFORMAL (func);
body = QSE_LSP_FBODY (func);
}
/* make a new frame. */
frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL) return ASE_NULL;
frame = qse_lsp_newframe (lsp);
if (frame == QSE_NULL) return QSE_NULL;
/* attach it to the brooding frame list to
* prevent them from being garbage-collected. */
@ -251,62 +251,62 @@ static ase_lsp_obj_t* apply (
if (actual == mem->nil)
{
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
qse_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGFEW, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, 0);
return QSE_NULL;
}
value = ASE_LSP_CAR(actual);
if (ASE_LSP_TYPE(func) != ASE_LSP_OBJ_MACRO)
value = QSE_LSP_CAR(actual);
if (QSE_LSP_TYPE(func) != QSE_LSP_OBJ_MACRO)
{
/* macro doesn't evaluate actual arguments. */
value = ase_lsp_eval (lsp, value);
if (value == ASE_NULL)
value = qse_lsp_eval (lsp, value);
if (value == QSE_NULL)
{
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
qse_lsp_freeframe (lsp, frame);
return QSE_NULL;
}
}
if (ase_lsp_lookupinframe (
lsp, frame, ASE_LSP_CAR(formal)) != ASE_NULL)
if (qse_lsp_lookupinframe (
lsp, frame, QSE_LSP_CAR(formal)) != QSE_NULL)
{
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
qse_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EDUPFML, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EDUPFML, QSE_NULL, 0);
return QSE_NULL;
}
if (ase_lsp_insvalueintoframe (
lsp, frame, ASE_LSP_CAR(formal), value) == ASE_NULL)
if (qse_lsp_insvalueintoframe (
lsp, frame, QSE_LSP_CAR(formal), value) == QSE_NULL)
{
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
qse_lsp_freeframe (lsp, frame);
return QSE_NULL;
}
actual = ASE_LSP_CDR(actual);
formal = ASE_LSP_CDR(formal);
actual = QSE_LSP_CDR(actual);
formal = QSE_LSP_CDR(formal);
}
if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS)
if (QSE_LSP_TYPE(actual) == QSE_LSP_OBJ_CONS)
{
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
qse_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGMANY, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, 0);
return QSE_NULL;
}
else if (actual != mem->nil)
{
mem->brooding_frame = frame->link;
ase_lsp_freeframe (lsp, frame);
qse_lsp_freeframe (lsp, frame);
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
return QSE_NULL;
}
/* push the frame */
@ -318,63 +318,63 @@ static ase_lsp_obj_t* apply (
value = mem->nil;
while (body != mem->nil)
{
value = ase_lsp_eval(lsp, ASE_LSP_CAR(body));
if (value == ASE_NULL)
value = qse_lsp_eval(lsp, QSE_LSP_CAR(body));
if (value == QSE_NULL)
{
mem->frame = frame->link;
ase_lsp_freeframe (lsp, frame);
return ASE_NULL;
qse_lsp_freeframe (lsp, frame);
return QSE_NULL;
}
body = ASE_LSP_CDR(body);
body = QSE_LSP_CDR(body);
}
/* pop the frame. */
mem->frame = frame->link;
/* destroy the frame. */
ase_lsp_freeframe (lsp, frame);
qse_lsp_freeframe (lsp, frame);
/*if (ASE_LSP_CAR(func) == mem->macro) {*/
if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
/*if (QSE_LSP_CAR(func) == mem->macro) {*/
if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO)
{
value = ase_lsp_eval (lsp, value);
if (value == ASE_NULL) return ASE_NULL;
value = qse_lsp_eval (lsp, value);
if (value == QSE_NULL) return QSE_NULL;
}
return value;
}
static ase_lsp_obj_t* apply_to_prim (
ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual)
static qse_lsp_obj_t* apply_to_prim (
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual)
{
ase_lsp_obj_t* obj;
ase_size_t count = 0;
qse_lsp_obj_t* obj;
qse_size_t count = 0;
ASE_ASSERT (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM);
QSE_ASSERT (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_PRIM);
obj = actual;
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
while (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
{
count++;
obj = ASE_LSP_CDR(obj);
obj = QSE_LSP_CDR(obj);
}
if (obj != lsp->mem->nil)
{
ase_lsp_seterror (lsp, ASE_LSP_EARGBAD, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
return QSE_NULL;
}
if (count < ASE_LSP_PMINARGS(func))
if (count < QSE_LSP_PMINARGS(func))
{
ase_lsp_seterror (lsp, ASE_LSP_EARGFEW, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, 0);
return QSE_NULL;
}
if (count > ASE_LSP_PMAXARGS(func))
if (count > QSE_LSP_PMAXARGS(func))
{
ase_lsp_seterror (lsp, ASE_LSP_EARGMANY, ASE_NULL, 0);
return ASE_NULL;
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, 0);
return QSE_NULL;
}
return ASE_LSP_PIMPL(func) (lsp, actual);
return QSE_LSP_PIMPL(func) (lsp, actual);
}