qse/ase/lsp/prim_prog.c

50 lines
988 B
C
Raw Normal View History

2005-09-19 12:04:00 +00:00
/*
2006-10-30 11:26:57 +00:00
* $Id: prim_prog.c,v 1.6 2006-10-30 11:26:57 bacon Exp $
2005-09-19 12:04:00 +00:00
*/
2006-10-26 08:17:38 +00:00
#include <ase/lsp/lsp_i.h>
2005-09-19 12:04:00 +00:00
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-19 12:04:00 +00:00
{
2006-10-30 11:26:57 +00:00
/* (prog1 1 2 3) returns 1 */
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* res = ASE_NULL, * tmp;
2005-09-19 12:04:00 +00:00
2006-10-29 13:40:33 +00:00
/*while (args != lsp->mem->nil) {*/
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-19 12:04:00 +00:00
2006-10-29 13:40:33 +00:00
if (res == ASE_NULL)
{
2005-09-19 12:04:00 +00:00
res = tmp;
2006-10-30 11:26:57 +00:00
ase_lsp_lockobj (lsp, res);
2005-09-19 12:04:00 +00:00
}
2006-10-24 04:22:40 +00:00
args = ASE_LSP_CDR(args);
2005-09-19 12:04:00 +00:00
}
2006-10-30 11:26:57 +00:00
if (res != ASE_NULL) ase_lsp_unlockobj (lsp, res);
2005-09-19 12:04:00 +00:00
return res;
}
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args)
2005-09-19 12:04:00 +00:00
{
2006-10-30 11:26:57 +00:00
/* (progn 1 2 3) returns 3 */
2006-10-24 04:22:40 +00:00
ase_lsp_obj_t* res, * tmp;
2005-09-19 12:04:00 +00:00
res = lsp->mem->nil;
2006-10-29 13:40:33 +00:00
/*while (args != lsp->mem->nil) {*/
while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS)
{
2006-10-24 04:22:40 +00:00
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL;
2005-09-19 12:04:00 +00:00
res = tmp;
2006-10-24 04:22:40 +00:00
args = ASE_LSP_CDR(args);
2005-09-19 12:04:00 +00:00
}
return res;
}