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
2006-10-22 13:10:46 +00:00
parent b44656b9b6
commit 97392088fd
28 changed files with 1976 additions and 1972 deletions
Download Patch File Download Diff File Expand all files Collapse all files

126
ase/lsp/prim_let.c
View File

@@ -1,24 +1,24 @@
/*
* $Id: prim_let.c,v 1.3 2005-09-24 08:16:02 bacon Exp $
* $Id: prim_let.c,v 1.4 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/prim.h>
#include <sse/lsp/prim.h>
static xp_lsp_obj_t* __prim_let (
xp_lsp_t* lsp, xp_lsp_obj_t* args, int sequential)
static sse_lsp_obj_t* __prim_let (
sse_lsp_t* lsp, sse_lsp_obj_t* args, int sequential)
{
xp_lsp_frame_t* frame;
xp_lsp_obj_t* assoc;
xp_lsp_obj_t* body;
xp_lsp_obj_t* value;
sse_lsp_frame_t* frame;
sse_lsp_obj_t* assoc;
sse_lsp_obj_t* body;
sse_lsp_obj_t* value;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
// create a new frame
frame = xp_lsp_frame_new ();
if (frame == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
frame = sse_lsp_frame_new ();
if (frame == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
//frame->link = lsp->mem->frame;
@@ -31,87 +31,87 @@ static xp_lsp_obj_t* __prim_let (
lsp->mem->brooding_frame = frame;
}
assoc = XP_LSP_CAR(args);
assoc = SSE_LSP_CAR(args);
//while (assoc != lsp->mem->nil) {
while (XP_LSP_TYPE(assoc) == XP_LSP_OBJ_CONS) {
xp_lsp_obj_t* ass = XP_LSP_CAR(assoc);
if (XP_LSP_TYPE(ass) == XP_LSP_OBJ_CONS) {
xp_lsp_obj_t* n = XP_LSP_CAR(ass);
xp_lsp_obj_t* v = XP_LSP_CDR(ass);
while (SSE_LSP_TYPE(assoc) == SSE_LSP_OBJ_CONS) {
sse_lsp_obj_t* ass = SSE_LSP_CAR(assoc);
if (SSE_LSP_TYPE(ass) == SSE_LSP_OBJ_CONS) {
sse_lsp_obj_t* n = SSE_LSP_CAR(ass);
sse_lsp_obj_t* v = SSE_LSP_CDR(ass);
if (XP_LSP_TYPE(n) != XP_LSP_OBJ_SYMBOL) {
lsp->errnum = XP_LSP_ERR_BAD_ARG; // must be a symbol
if (SSE_LSP_TYPE(n) != SSE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; // must be a symbol
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (v != lsp->mem->nil) {
if (XP_LSP_CDR(v) != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_TOO_MANY_ARGS; // must be a symbol
if (SSE_LSP_CDR(v) != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS; // must be a symbol
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if ((v = xp_lsp_eval(lsp, XP_LSP_CAR(v))) == XP_NULL) {
if ((v = sse_lsp_eval(lsp, SSE_LSP_CAR(v))) == SSE_NULL) {
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
if (xp_lsp_frame_lookup (frame, n) != XP_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
if (sse_lsp_frame_lookup (frame, n) != SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (xp_lsp_frame_insert_value(frame, n, v) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
if (sse_lsp_frame_insert_value(frame, n, v) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(ass) == XP_LSP_OBJ_SYMBOL) {
if (xp_lsp_frame_lookup(frame, ass) != XP_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
else if (SSE_LSP_TYPE(ass) == SSE_LSP_OBJ_SYMBOL) {
if (sse_lsp_frame_lookup(frame, ass) != SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (xp_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
if (sse_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
assoc = XP_LSP_CDR(assoc);
assoc = SSE_LSP_CDR(assoc);
}
if (assoc != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
// push the frame
@@ -123,26 +123,26 @@ static xp_lsp_obj_t* __prim_let (
// evaluate forms in the body
value = lsp->mem->nil;
body = XP_LSP_CDR(args);
body = SSE_LSP_CDR(args);
while (body != lsp->mem->nil) {
value = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (value == XP_NULL) {
value = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (value == SSE_NULL) {
lsp->mem->frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
// pop the frame
lsp->mem->frame = frame->link;
// destroy the frame
xp_lsp_frame_free (frame);
sse_lsp_frame_free (frame);
return value;
}
xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_let (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (defun x (x y)
@@ -154,7 +154,7 @@ xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t* lsp, xp_lsp_obj_t* args)
return __prim_let (lsp, args, 0);
}
xp_lsp_obj_t* xp_lsp_prim_letx (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_letx (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
return __prim_let (lsp, args, 1);
}