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-25 13:42:31 +00:00
parent acbca7f730
commit 08fe087e11
16 changed files with 589 additions and 542 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
ase/lsp/env.c
View File

@ -1,10 +1,8 @@
/* /*
* $Id: env.c,v 1.10 2006-10-24 04:22:39 bacon Exp $ * $Id: env.c,v 1.11 2006-10-25 13:42:30 bacon Exp $
*/ */
#include <ase/lsp/env.h> #include <ase/lsp/lsp_i.h>
#include <ase/bas/memory.h>
#include <ase/bas/assert.h>
// TODO: make the frame hash accessible.... // TODO: make the frame hash accessible....
@ -48,7 +46,8 @@ void ase_lsp_frame_free (ase_lsp_frame_t* frame)
// destroy the associations // destroy the associations
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != ASE_NULL) { while (assoc != ASE_NULL)
{
link = assoc->link; link = assoc->link;
ase_lsp_assoc_free (assoc); ase_lsp_assoc_free (assoc);
assoc = link; assoc = link;
@ -61,10 +60,11 @@ ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* na
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != ASE_NULL) { while (assoc != ASE_NULL)
{
if (name == assoc->name) return assoc; if (name == assoc->name) return assoc;
assoc = assoc->link; assoc = assoc->link;
} }
@ -76,7 +76,7 @@ ase_lsp_assoc_t* ase_lsp_frame_insert_value (
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = ase_lsp_assoc_new (name, value, ASE_NULL); assoc = ase_lsp_assoc_new (name, value, ASE_NULL);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
@ -90,7 +90,7 @@ ase_lsp_assoc_t* ase_lsp_frame_insert_func (
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = ase_lsp_assoc_new (name, ASE_NULL, func); assoc = ase_lsp_assoc_new (name, ASE_NULL, func);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;

4
ase/lsp/err.c
View File

@ -1,8 +1,8 @@
/* /*
* $Id: err.c,v 1.3 2006-10-24 04:22:39 bacon Exp $ * $Id: err.c,v 1.4 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp_i.h>
static const ase_char_t* __errstr[] = static const ase_char_t* __errstr[] =
{ {

29
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: eval.c,v 1.15 2006-10-24 04:22:39 bacon Exp $ * $Id: eval.c,v 1.16 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp.h>
@ -20,7 +20,7 @@ ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
return eval_cons (lsp, obj); return eval_cons (lsp, obj);
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYM) {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
/* /*
@ -80,8 +80,8 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr
} }
func = (is_macro)? func = (is_macro)?
ase_lsp_make_macro (lsp->mem, formal, body): ase_lsp_makemacro (lsp->mem, formal, body):
ase_lsp_make_func (lsp->mem, formal, body); ase_lsp_makefunc (lsp->mem, formal, body);
if (func == ASE_NULL) { if (func == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
@ -99,16 +99,20 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
car = ASE_LSP_CAR(cons); car = ASE_LSP_CAR(cons);
cdr = ASE_LSP_CDR(cons); cdr = ASE_LSP_CDR(cons);
if (car == lsp->mem->lambda) { if (car == lsp->mem->lambda)
{
return make_func (lsp, cdr, 0); return make_func (lsp, cdr, 0);
} }
else if (car == lsp->mem->macro) { else if (car == lsp->mem->macro)
{
return make_func (lsp, cdr, 1); return make_func (lsp, cdr, 1);
} }
else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYM)
{
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
if ((assoc = ase_lsp_lookup(lsp->mem, car)) != ASE_NULL) { if ((assoc = ase_lsp_lookup(lsp->mem, car)) != ASE_NULL)
{
//ase_lsp_obj_t* func = assoc->value; //ase_lsp_obj_t* func = assoc->value;
ase_lsp_obj_t* func = assoc->func; ase_lsp_obj_t* func = assoc->func;
if (func == ASE_NULL) { if (func == ASE_NULL) {
@ -118,14 +122,17 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
} }
if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC || if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC ||
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) { ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
{
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
} }
else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM) { else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM)
{
/* primitive function */ /* primitive function */
return ASE_LSP_PRIM(func) (lsp, cdr); return ASE_LSP_PRIM(func) (lsp, cdr);
} }
else { else
{
//TODO: emit the name for debugging //TODO: emit the name for debugging
lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC; lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
return ASE_NULL; return ASE_NULL;

31
ase/lsp/lsp.h
View File

@ -1,11 +1,12 @@
/* /*
* $Id: lsp.h,v 1.25 2006-10-24 04:22:39 bacon Exp $ * $Id: lsp.h,v 1.26 2006-10-25 13:42:31 bacon Exp $
*/ */
#ifndef _ASE_LSP_LSP_H_ #ifndef _ASE_LSP_LSP_H_
#define _ASE_LSP_LSP_H_ #define _ASE_LSP_LSP_H_
#include <ase/lsp/types.h> #include <ase/types.h>
#include <ase/macros.h>
typedef struct ase_lsp_t ase_lsp_t; typedef struct ase_lsp_t ase_lsp_t;
typedef struct ase_lsp_obj_t ase_lsp_obj_t; typedef struct ase_lsp_obj_t ase_lsp_obj_t;
@ -117,6 +118,32 @@ int ase_lsp_print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj);
int ase_lsp_add_prim (ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim); int ase_lsp_add_prim (ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim);
int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name); int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name);
/* string functions exported by lsp.h */
ase_char_t* ase_lsp_strdup (ase_lsp_t* lsp, const ase_char_t* str);
ase_char_t* ase_lsp_strxdup (
ase_lsp_t* lsp, const ase_char_t* str, ase_size_t len);
ase_char_t* ase_lsp_strxdup2 (
ase_lsp_t* lsp,
const ase_char_t* str1, ase_size_t len1,
const ase_char_t* str2, ase_size_t len2);
ase_size_t ase_lsp_strlen (const ase_char_t* str);
ase_size_t ase_lsp_strcpy (ase_char_t* buf, const ase_char_t* str);
ase_size_t ase_lsp_strncpy (ase_char_t* buf, const ase_char_t* str, ase_size_t len);
int ase_lsp_strcmp (const ase_char_t* s1, const ase_char_t* s2);
int ase_lsp_strxncmp (
const ase_char_t* s1, ase_size_t len1,
const ase_char_t* s2, ase_size_t len2);
int ase_lsp_strxncasecmp (
ase_lsp_t* lsp,
const ase_char_t* s1, ase_size_t len1,
const ase_char_t* s2, ase_size_t len2);
ase_char_t* ase_lsp_strxnstr (
const ase_char_t* str, ase_size_t strsz,
const ase_char_t* sub, ase_size_t subsz);
const ase_char_t* ase_lsp_geterrstr (int errnum); const ase_char_t* ase_lsp_geterrstr (int errnum);

288
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: mem.c,v 1.13 2006-10-24 15:31:35 bacon Exp $ * $Id: mem.c,v 1.14 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
@ -56,11 +56,11 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->macro = ASE_NULL; mem->macro = ASE_NULL;
/* initialize common object pointers */ /* initialize common object pointers */
mem->nil = ase_lsp_make_nil (mem); mem->nil = ase_lsp_makenil (mem);
mem->t = ase_lsp_make_true (mem); mem->t = ase_lsp_maketrue (mem);
mem->quote = ase_lsp_make_symbol (mem, ASE_T("quote")); mem->quote = ase_lsp_makesymobj (mem, ASE_T("quote"), 5);
mem->lambda = ase_lsp_make_symbol (mem, ASE_T("lambda")); mem->lambda = ase_lsp_makesymobj (mem, ASE_T("lambda"), 6);
mem->macro = ase_lsp_make_symbol (mem, ASE_T("macro")); mem->macro = ase_lsp_makesymobj (mem, ASE_T("macro"), 5);
if (mem->nil == ASE_NULL || if (mem->nil == ASE_NULL ||
mem->t == ASE_NULL || mem->t == ASE_NULL ||
@ -98,17 +98,17 @@ static int __add_prim (ase_lsp_mem_t* mem,
{ {
ase_lsp_obj_t* n, * p; ase_lsp_obj_t* n, * p;
n = ase_lsp_make_symbolx (mem, name, len); n = ase_lsp_makesymobj (mem, name, len);
if (n == ASE_NULL) return -1; if (n == ASE_NULL) return -1;
ase_lsp_lock (n); ase_lsp_lockobj (mem->lsp, n);
p = ase_lsp_make_prim (mem, prim); p = ase_lsp_makeprim (mem, prim);
if (p == ASE_NULL) return -1; if (p == ASE_NULL) return -1;
ase_lsp_unlock (n); ase_lsp_unlockobj (mem->lsp, n);
if (ase_lsp_set_func(mem, n, p) == ASE_NULL) return -1; if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1;
return 0; return 0;
} }
@ -161,11 +161,12 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
if (mem->count >= mem->ubound) return ASE_NULL; if (mem->count >= mem->ubound) return ASE_NULL;
} }
obj = (ase_lsp_obj_t*) ase_malloc (size); obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size);
if (obj == ASE_NULL) { if (obj == ASE_NULL)
{
ase_lsp_collectgarbage (mem); ase_lsp_collectgarbage (mem);
obj = (ase_lsp_obj_t*) ase_malloc (size); obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size);
if (obj == ASE_NULL) return ASE_NULL; if (obj == ASE_NULL) return ASE_NULL;
} }
@ -225,9 +226,9 @@ void ase_lsp_dispose_all (ase_lsp_mem_t* mem)
} }
} }
static void __mark_obj (ase_lsp_obj_t* obj) static void __mark_obj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{ {
ase_assert (obj != ASE_NULL); ase_lsp_assert (lsp, obj != ASE_NULL);
// TODO:.... // TODO:....
// can it be recursive? // can it be recursive?
@ -237,57 +238,57 @@ static void __mark_obj (ase_lsp_obj_t* obj)
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{ {
__mark_obj (ASE_LSP_CAR(obj)); __mark_obj (lsp, ASE_LSP_CAR(obj));
__mark_obj (ASE_LSP_CDR(obj)); __mark_obj (lsp, ASE_LSP_CDR(obj));
} }
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC) else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC)
{ {
__mark_obj (ASE_LSP_FFORMAL(obj)); __mark_obj (lsp, ASE_LSP_FFORMAL(obj));
__mark_obj (ASE_LSP_FBODY(obj)); __mark_obj (lsp, ASE_LSP_FBODY(obj));
} }
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO) else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO)
{ {
__mark_obj (ASE_LSP_MFORMAL(obj)); __mark_obj (lsp, ASE_LSP_MFORMAL(obj));
__mark_obj (ASE_LSP_MBODY(obj)); __mark_obj (lsp, ASE_LSP_MBODY(obj));
} }
} }
/* /*
* ase_lsp_lock and ase_lsp_unlockallobjs are just called by ase_lsp_read. * ase_lsp_lockobj and ase_lsp_unlockallobjs are just called by ase_lsp_read.
*/ */
void ase_lsp_lockobj (ase_lsp_obj_t* obj) void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{ {
ase_assert (obj != ASE_NULL); ase_lsp_assert (lsp, obj != ASE_NULL);
ASE_LSP_LOCK(obj) = 1; ASE_LSP_LOCK(obj) = 1;
//ASE_LSP_MARK(obj) = 1; //ASE_LSP_MARK(obj) = 1;
} }
void ase_lsp_unlockobj (ase_lsp_obj_t* obj) void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{ {
ase_assert (obj != ASE_NULL); ase_lsp_assert (lsp, obj != ASE_NULL);
ASE_LSP_LOCK(obj) = 0; ASE_LSP_LOCK(obj) = 0;
} }
void ase_lsp_unlockallobjs (ase_lsp_obj_t* obj) void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{ {
ase_assert (obj != ASE_NULL); ase_lsp_assert (lsp, obj != ASE_NULL);
ASE_LSP_LOCK(obj) = 0; ASE_LSP_LOCK(obj) = 0;
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{ {
ase_lsp_unlockallobjs (ASE_LSP_CAR(obj)); ase_lsp_unlockallobjs (lsp, ASE_LSP_CAR(obj));
ase_lsp_unlockallobjs (ASE_LSP_CDR(obj)); ase_lsp_unlockallobjs (lsp, ASE_LSP_CDR(obj));
} }
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC) else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC)
{ {
ase_lsp_unlockallobjs (ASE_LSP_FFORMAL(obj)); ase_lsp_unlockallobjs (lsp, ASE_LSP_FFORMAL(obj));
ase_lsp_unlockallobjs (ASE_LSP_FBODY(obj)); ase_lsp_unlockallobjs (lsp, ASE_LSP_FBODY(obj));
} }
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO) else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO)
{ {
ase_lsp_unlockallobjs (ASE_LSP_MFORMAL(obj)); ase_lsp_unlockallobjs (lsp, ASE_LSP_MFORMAL(obj));
ase_lsp_unlockallobjs (ASE_LSP_MBODY(obj)); ase_lsp_unlockallobjs (lsp, ASE_LSP_MBODY(obj));
} }
} }
@ -308,12 +309,12 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != ASE_NULL) while (assoc != ASE_NULL)
{ {
__mark_obj (assoc->name); __mark_obj (mem->lsp, assoc->name);
if (assoc->value != ASE_NULL) if (assoc->value != ASE_NULL)
__mark_obj (assoc->value); __mark_obj (mem->lsp, assoc->value);
if (assoc->func != ASE_NULL) if (assoc->func != ASE_NULL)
__mark_obj (assoc->func); __mark_obj (mem->lsp, assoc->func);
assoc = assoc->link; assoc = assoc->link;
} }
@ -331,12 +332,12 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != ASE_NULL) { while (assoc != ASE_NULL) {
__mark_obj (assoc->name); __mark_obj (mem->lsp, assoc->name);
if (assoc->value != ASE_NULL) if (assoc->value != ASE_NULL)
__mark_obj (assoc->value); __mark_obj (mem->lsp, assoc->value);
if (assoc->func != ASE_NULL) if (assoc->func != ASE_NULL)
__mark_obj (assoc->func); __mark_obj (mem->lsp, assoc->func);
assoc = assoc->link; assoc = assoc->link;
} }
@ -346,26 +347,27 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
/* /*
ase_dprint0 (ASE_T("marking the locked object\n")); ase_dprint0 (ASE_T("marking the locked object\n"));
if (mem->locked != ASE_NULL) __mark_obj (mem->locked); if (mem->locked != ASE_NULL) __mark_obj (mem->lsp, mem->locked);
*/ */
#if 0 #if 0
ase_dprint0 (ASE_T("marking termporary objects\n")); ase_dprint0 (ASE_T("marking termporary objects\n"));
#endif #endif
array = mem->temp_array; array = mem->temp_array;
for (i = 0; i < array->size; i++) { for (i = 0; i < array->size; i++)
__mark_obj (array->buffer[i]); {
__mark_obj (mem->lsp, array->buffer[i]);
} }
#if 0 #if 0
ase_dprint0 (ASE_T("marking builtin objects\n")); ase_dprint0 (ASE_T("marking builtin objects\n"));
#endif #endif
// mark common objects // mark common objects
if (mem->t != ASE_NULL) __mark_obj (mem->t); if (mem->t != ASE_NULL) __mark_obj (mem->lsp, mem->t);
if (mem->nil != ASE_NULL) __mark_obj (mem->nil); if (mem->nil != ASE_NULL) __mark_obj (mem->lsp, mem->nil);
if (mem->quote != ASE_NULL) __mark_obj (mem->quote); if (mem->quote != ASE_NULL) __mark_obj (mem->lsp, mem->quote);
if (mem->lambda != ASE_NULL) __mark_obj (mem->lambda); if (mem->lambda != ASE_NULL) __mark_obj (mem->lsp, mem->lambda);
if (mem->macro != ASE_NULL) __mark_obj (mem->macro); if (mem->macro != ASE_NULL) __mark_obj (mem->lsp, mem->macro);
} }
static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem) static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem)
@ -408,21 +410,23 @@ void ase_lsp_collectgarbage (ase_lsp_mem_t* mem)
ase_lsp_sweepunmarkedobjs (mem); ase_lsp_sweepunmarkedobjs (mem);
} }
ase_lsp_obj_t* ase_lsp_make_nil (ase_lsp_mem_t* mem) ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem)
{ {
if (mem->nil != ASE_NULL) return mem->nil; if (mem->nil != ASE_NULL) return mem->nil;
mem->nil = ase_lsp_alloc (mem, ASE_LSP_OBJ_NIL, ase_sizeof(ase_lsp_obj_nil_t)); mem->nil = ase_lsp_alloc (
mem, ASE_LSP_OBJ_NIL, ase_sizeof(ase_lsp_obj_nil_t));
return mem->nil; return mem->nil;
} }
ase_lsp_obj_t* ase_lsp_make_true (ase_lsp_mem_t* mem) ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem)
{ {
if (mem->t != ASE_NULL) return mem->t; if (mem->t != ASE_NULL) return mem->t;
mem->t = ase_lsp_alloc (mem, ASE_LSP_OBJ_TRUE, ase_sizeof(ase_lsp_obj_true_t)); mem->t = ase_lsp_alloc (
mem, ASE_LSP_OBJ_TRUE, ase_sizeof(ase_lsp_obj_true_t));
return mem->t; return mem->t;
} }
ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value) ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
@ -435,7 +439,7 @@ ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value)
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value) ase_lsp_obj_t* ase_lsp_makerealobj (ase_lsp_mem_t* mem, ase_real_t value)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
@ -448,57 +452,50 @@ ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value)
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_symbol (ase_lsp_mem_t* mem, const ase_char_t* str) ase_lsp_obj_t* ase_lsp_makesymobj (
{
return ase_lsp_make_symbolx (mem, str, ase_strlen(str));
}
ase_lsp_obj_t* ase_lsp_make_symbolx (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len) ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
// look for a sysmbol with the given name // look for a sysmbol with the given name
obj = mem->used[ASE_LSP_OBJ_SYMBOL]; obj = mem->used[ASE_LSP_OBJ_SYM];
while (obj != ASE_NULL) { while (obj != ASE_NULL)
{
// if there is a symbol with the same name, it is just used. // if there is a symbol with the same name, it is just used.
if (ase_lsp_comp_symbol2 (obj, str, len) == 0) return obj; if (ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(obj),
ASE_LSP_SYMLEN(obj), str, len) == 0) return obj;
obj = ASE_LSP_LINK(obj); obj = ASE_LSP_LINK(obj);
} }
// no such symbol found. create a new one // no such symbol found. create a new one
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_SYMBOL, obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_SYM,
ase_sizeof(ase_lsp_obj_symbol_t) + (len + 1) * ase_sizeof(ase_char_t)); ase_sizeof(ase_lsp_obj_sym_t)+(len + 1)*ase_sizeof(ase_char_t));
if (obj == ASE_NULL) return ASE_NULL; if (obj == ASE_NULL) return ASE_NULL;
// fill in the symbol buffer // fill in the symbol buffer
ase_lsp_copy_string2 (ASE_LSP_SYMVALUE(obj), str, len); ase_lsp_strncpy (ASE_LSP_SYMVALUE(obj), str, len);
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_string (ase_lsp_mem_t* mem, const ase_char_t* str) ase_lsp_obj_t* ase_lsp_makestrobj (
{
return ase_lsp_make_stringx (mem, str, ase_strlen(str));
}
ase_lsp_obj_t* ase_lsp_make_stringx (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len) ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
// allocate memory for the string // allocate memory for the string
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_STRING, obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_STR,
ase_sizeof(ase_lsp_obj_string_t) + (len + 1) * ase_sizeof(ase_char_t)); ase_sizeof(ase_lsp_obj_str_t)+(len + 1)*ase_sizeof(ase_char_t));
if (obj == ASE_NULL) return ASE_NULL; if (obj == ASE_NULL) return ASE_NULL;
// fill in the string buffer // fill in the string buffer
ase_lsp_copy_string2 (ASE_LSP_STRVALUE(obj), str, len); ase_lsp_strncpy (ASE_LSP_STRVALUE(obj), str, len);
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_cons ( ase_lsp_obj_t* ase_lsp_makecons (
ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr) ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
@ -512,7 +509,7 @@ ase_lsp_obj_t* ase_lsp_make_cons (
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_func ( ase_lsp_obj_t* ase_lsp_makefunc (
ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body) ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
@ -526,7 +523,7 @@ ase_lsp_obj_t* ase_lsp_make_func (
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_macro ( ase_lsp_obj_t* ase_lsp_makemacro (
ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body) ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
@ -540,15 +537,16 @@ ase_lsp_obj_t* ase_lsp_make_macro (
return obj; return obj;
} }
ase_lsp_obj_t* ase_lsp_make_prim (ase_lsp_mem_t* mem, void* impl) ase_lsp_obj_t* ase_lsp_makeprim (ase_lsp_mem_t* mem, void* impl)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_PRIM, ase_sizeof(ase_lsp_obj_prim_t)); obj = ase_lsp_alloc (
mem, ASE_LSP_OBJ_PRIM, ase_sizeof(ase_lsp_obj_prim_t));
if (obj == ASE_NULL) return ASE_NULL; if (obj == ASE_NULL) return ASE_NULL;
ASE_LSP_PRIM(obj) = impl; /*ASE_LSP_PRIM(obj) = (ase_lsp_prim_t)impl;*/
((ase_lsp_obj_prim_t*)obj)->impl = impl;
return obj; return obj;
} }
@ -557,11 +555,12 @@ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name)
ase_lsp_frame_t* frame; ase_lsp_frame_t* frame;
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL); ase_lsp_assert (mem->lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
frame = mem->frame; frame = mem->frame;
while (frame != ASE_NULL) { while (frame != ASE_NULL)
{
assoc = ase_lsp_frame_lookup (frame, name); assoc = ase_lsp_frame_lookup (frame, name);
if (assoc != ASE_NULL) return assoc; if (assoc != ASE_NULL) return assoc;
frame = frame->link; frame = frame->link;
@ -570,13 +569,14 @@ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name)
return ASE_NULL; return ASE_NULL;
} }
ase_lsp_assoc_t* ase_lsp_set_value ( ase_lsp_assoc_t* ase_lsp_setvalue (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value) ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value)
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
assoc = ase_lsp_lookup (mem, name); assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL) { if (assoc == ASE_NULL)
{
assoc = ase_lsp_frame_insert_value ( assoc = ase_lsp_frame_insert_value (
mem->root_frame, name, value); mem->root_frame, name, value);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
@ -586,13 +586,14 @@ ase_lsp_assoc_t* ase_lsp_set_value (
return assoc; return assoc;
} }
ase_lsp_assoc_t* ase_lsp_set_func ( ase_lsp_assoc_t* ase_lsp_setfunc (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func) ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func)
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
assoc = ase_lsp_lookup (mem, name); assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL) { if (assoc == ASE_NULL)
{
assoc = ase_lsp_frame_insert_func (mem->root_frame, name, func); assoc = ase_lsp_frame_insert_func (mem->root_frame, name, func);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
} }
@ -605,11 +606,13 @@ ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj)
{ {
ase_size_t count; ase_size_t count;
ase_assert (obj == mem->nil || ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS); ase_lsp_assert (mem->lsp,
obj == mem->nil || ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS);
count = 0; count = 0;
//while (obj != mem->nil) { //while (obj != mem->nil) {
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
count++; count++;
obj = ASE_LSP_CDR(obj); obj = ASE_LSP_CDR(obj);
} }
@ -617,11 +620,12 @@ ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj)
return count; return count;
} }
int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len) int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len)
{ {
ase_size_t count = 0; ase_size_t count = 0;
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
count++; count++;
obj = ASE_LSP_CDR(obj); obj = ASE_LSP_CDR(obj);
} }
@ -632,102 +636,4 @@ int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len)
return 0; return 0;
} }
int ase_lsp_comp_symbol (ase_lsp_obj_t* obj, const ase_char_t* str)
{
ase_char_t* p;
ase_size_t index, length;
ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL);
index = 0;
length = ASE_LSP_SYMLEN(obj);
p = ASE_LSP_SYMVALUE(obj);
while (index < length) {
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
return (*str == ASE_T('\0'))? 0: -1;
}
int ase_lsp_comp_symbol2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len)
{
ase_char_t* p;
ase_size_t index, length;
ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL);
index = 0;
length = ASE_LSP_SYMLEN(obj);
p = ASE_LSP_SYMVALUE(obj);
while (index < length && index < len) {
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
return (length < len)? -1:
(length > len)? 1: 0;
}
int ase_lsp_comp_string (ase_lsp_obj_t* obj, const ase_char_t* str)
{
ase_char_t* p;
ase_size_t index, length;
ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_STRING);
index = 0;
length = ASE_LSP_STRLEN(obj);
p = ASE_LSP_STRVALUE(obj);
while (index < length) {
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
return (*str == ASE_T('\0'))? 0: -1;
}
int ase_lsp_comp_string2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len)
{
ase_char_t* p;
ase_size_t index, length;
ase_assert (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_STRING);
index = 0;
length = ASE_LSP_STRLEN(obj);
p = ASE_LSP_STRVALUE(obj);
while (index < length && index < len) {
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
return (length < len)? -1:
(length > len)? 1: 0;
}
void ase_lsp_copy_string (ase_char_t* dst, const ase_char_t* str)
{
// the buffer pointed by dst should be big enough to hold str
while (*str != ASE_T('\0')) *dst++ = *str++;
*dst = ASE_T('\0');
}
void ase_lsp_copy_string2 (ase_char_t* dst, const ase_char_t* str, ase_size_t len)
{
// the buffer pointed by dst should be big enough to hold str
while (len > 0) {
*dst++ = *str++;
len--;
}
*dst = ASE_T('\0');
}

47
ase/lsp/mem.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: mem.h,v 1.10 2006-10-24 15:31:35 bacon Exp $ * $Id: mem.h,v 1.11 2006-10-25 13:42:31 bacon Exp $
*/ */
#ifndef _ASE_LSP_MEM_H_ #ifndef _ASE_LSP_MEM_H_
@ -65,51 +65,40 @@ void ase_lsp_dispose (ase_lsp_mem_t* mem, ase_lsp_obj_t* prev, ase_lsp_obj_t* o
void ase_lsp_dispose_all (ase_lsp_mem_t* mem); void ase_lsp_dispose_all (ase_lsp_mem_t* mem);
void ase_lsp_collectgarbage (ase_lsp_mem_t* mem); void ase_lsp_collectgarbage (ase_lsp_mem_t* mem);
void ase_lsp_lockobj (ase_lsp_obj_t* obj); void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockobj (ase_lsp_obj_t* obj); void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockallobjs (ase_lsp_obj_t* obj); void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
// object creation of standard types // object creation of standard types
ase_lsp_obj_t* ase_lsp_make_nil (ase_lsp_mem_t* mem); ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_make_true (ase_lsp_mem_t* mem); ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value); ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value);
ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value); ase_lsp_obj_t* ase_lsp_makerealobj (ase_lsp_mem_t* mem, ase_real_t value);
ase_lsp_obj_t* ase_lsp_make_symbol ( ase_lsp_obj_t* ase_lsp_makesymobj (
ase_lsp_mem_t* mem, const ase_char_t* str);
ase_lsp_obj_t* ase_lsp_make_symbolx (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len); ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
ase_lsp_obj_t* ase_lsp_make_string ( ase_lsp_obj_t* ase_lsp_makestrobj (
ase_lsp_mem_t* mem, const ase_char_t* str);
ase_lsp_obj_t* ase_lsp_make_stringx (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len); ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
ase_lsp_obj_t* ase_lsp_make_cons (
ase_lsp_obj_t* ase_lsp_makecons (
ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr); ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr);
ase_lsp_obj_t* ase_lsp_make_func ( ase_lsp_obj_t* ase_lsp_makefunc (
ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body); ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body);
ase_lsp_obj_t* ase_lsp_make_macro ( ase_lsp_obj_t* ase_lsp_makemacro (
ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body); ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body);
ase_lsp_obj_t* ase_lsp_make_prim (ase_lsp_mem_t* mem, void* impl); ase_lsp_obj_t* ase_lsp_makeprim (ase_lsp_mem_t* mem, void* impl);
// frame lookup // frame lookup
ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name); ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name);
ase_lsp_assoc_t* ase_lsp_set_value ( ase_lsp_assoc_t* ase_lsp_setvalue (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value); ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value);
ase_lsp_assoc_t* ase_lsp_set_func ( ase_lsp_assoc_t* ase_lsp_setfunc (
ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func); ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func);
// cons operations // cons operations
ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj); ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj);
int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len); int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len);
// symbol and string operations
int ase_lsp_comp_symbol (ase_lsp_obj_t* obj, const ase_char_t* str);
int ase_lsp_comp_symbol2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len);
int ase_lsp_comp_string (ase_lsp_obj_t* obj, const ase_char_t* str);
int ase_lsp_comp_string2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len);
void ase_lsp_copy_string (ase_char_t* dst, const ase_char_t* str);
void ase_lsp_copy_string2 (ase_char_t* dst, const ase_char_t* str, ase_size_t len);
#ifdef __cplusplus #ifdef __cplusplus
} }

34
ase/lsp/obj.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: obj.h,v 1.7 2006-10-24 04:22:39 bacon Exp $ * $Id: obj.h,v 1.8 2006-10-25 13:42:31 bacon Exp $
*/ */
#ifndef _ASE_LSP_OBJ_H_ #ifndef _ASE_LSP_OBJ_H_
@ -14,8 +14,8 @@ enum
ASE_LSP_OBJ_TRUE, ASE_LSP_OBJ_TRUE,
ASE_LSP_OBJ_INT, ASE_LSP_OBJ_INT,
ASE_LSP_OBJ_REAL, ASE_LSP_OBJ_REAL,
ASE_LSP_OBJ_SYMBOL, ASE_LSP_OBJ_SYM,
ASE_LSP_OBJ_STRING, ASE_LSP_OBJ_STR,
ASE_LSP_OBJ_CONS, ASE_LSP_OBJ_CONS,
ASE_LSP_OBJ_FUNC, ASE_LSP_OBJ_FUNC,
ASE_LSP_OBJ_MACRO, ASE_LSP_OBJ_MACRO,
@ -30,8 +30,8 @@ typedef struct ase_lsp_obj_nil_t ase_lsp_obj_nil_t;
typedef struct ase_lsp_obj_true_t ase_lsp_obj_true_t; typedef struct ase_lsp_obj_true_t ase_lsp_obj_true_t;
typedef struct ase_lsp_obj_int_t ase_lsp_obj_int_t; typedef struct ase_lsp_obj_int_t ase_lsp_obj_int_t;
typedef struct ase_lsp_obj_real_t ase_lsp_obj_real_t; typedef struct ase_lsp_obj_real_t ase_lsp_obj_real_t;
typedef struct ase_lsp_obj_symbol_t ase_lsp_obj_symbol_t; typedef struct ase_lsp_obj_sym_t ase_lsp_obj_sym_t;
typedef struct ase_lsp_obj_string_t ase_lsp_obj_string_t; typedef struct ase_lsp_obj_str_t ase_lsp_obj_str_t;
typedef struct ase_lsp_obj_cons_t ase_lsp_obj_cons_t; typedef struct ase_lsp_obj_cons_t ase_lsp_obj_cons_t;
typedef struct ase_lsp_obj_func_t ase_lsp_obj_func_t; typedef struct ase_lsp_obj_func_t ase_lsp_obj_func_t;
typedef struct ase_lsp_obj_macro_t ase_lsp_obj_macro_t; typedef struct ase_lsp_obj_macro_t ase_lsp_obj_macro_t;
@ -64,16 +64,16 @@ struct ase_lsp_obj_true_t
struct ase_lsp_obj_int_t struct ase_lsp_obj_int_t
{ {
ase_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
ase_lsp_int_t value; ase_long_t value;
}; };
struct ase_lsp_obj_real_t struct ase_lsp_obj_real_t
{ {
ase_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
ase_lsp_real_t value; ase_real_t value;
}; };
struct ase_lsp_obj_symbol_t struct ase_lsp_obj_sym_t
{ {
ase_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
#if defined(__BORLANDC__) || defined(_MSC_VER) #if defined(__BORLANDC__) || defined(_MSC_VER)
@ -82,7 +82,7 @@ struct ase_lsp_obj_symbol_t
#endif #endif
}; };
struct ase_lsp_obj_string_t struct ase_lsp_obj_str_t
{ {
ase_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
#if defined(__BORLANDC__) || defined(_MSC_VER) #if defined(__BORLANDC__) || defined(_MSC_VER)
@ -129,19 +129,19 @@ struct ase_lsp_obj_prim_t
#define ASE_LSP_IVALUE(x) (((ase_lsp_obj_int_t*)x)->value) #define ASE_LSP_IVALUE(x) (((ase_lsp_obj_int_t*)x)->value)
#define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value) #define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value)
#ifdef __BORLANDC__ #if defined(__BORLANDC__) || defined(_MSC_VER)
#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_symbol_t*)x) + 1)) #define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1))
#else #else
#define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_symbol_t*)x)->buffer) #define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_sym_t*)x)->buffer)
#endif #endif
#define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_symbol_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) #define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_sym_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1)
#ifdef __BORLANDC__ #if defined(__BORLANDC__) || defined(_MSC_VER)
#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_string_t*)x) + 1)) #define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1))
#else #else
#define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_string_t*)x)->buffer) #define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_str_t*)x)->buffer)
#endif #endif
#define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_string_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) #define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_str_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1)
#define ASE_LSP_CAR(x) (((ase_lsp_obj_cons_t*)x)->car) #define ASE_LSP_CAR(x) (((ase_lsp_obj_cons_t*)x)->car)
#define ASE_LSP_CDR(x) (((ase_lsp_obj_cons_t*)x)->cdr) #define ASE_LSP_CDR(x) (((ase_lsp_obj_cons_t*)x)->cdr)

39
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim.c,v 1.10 2006-10-24 04:22:39 bacon Exp $ * $Id: prim.c,v 1.11 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp.h>
@ -29,17 +29,17 @@ static int __add_prim (ase_lsp_mem_t* mem,
{ {
ase_lsp_obj_t* n, * p; ase_lsp_obj_t* n, * p;
n = ase_lsp_make_symbolx (mem, name, len); n = ase_lsp_makesymobj (mem, name, len);
if (n == ASE_NULL) return -1; if (n == ASE_NULL) return -1;
ase_lsp_lock (n); ase_lsp_lock (n);
p = ase_lsp_make_prim (mem, prim); p = ase_lsp_makeprim (mem, prim);
if (p == ASE_NULL) return -1; if (p == ASE_NULL) return -1;
ase_lsp_unlock (n); ase_lsp_unlock (n);
if (ase_lsp_set_func(mem, n, p) == ASE_NULL) return -1; if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1;
return 0; return 0;
} }
@ -249,9 +249,10 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args)
cdr = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); cdr = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (cdr == ASE_NULL) return ASE_NULL; if (cdr == ASE_NULL) return ASE_NULL;
cons = ase_lsp_make_cons (lsp->mem, car, cdr); cons = ase_lsp_makecons (lsp->mem, car, cdr);
if (cons == ASE_NULL) { if (cons == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -274,7 +275,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) {
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return ASE_NULL; return ASE_NULL;
} }
@ -282,7 +283,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ase_lsp_set_value (lsp->mem, p1, p2) == ASE_NULL) { if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
} }
@ -303,7 +304,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_assert (ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
p1 = ASE_LSP_CAR(p); p1 = ASE_LSP_CAR(p);
if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) {
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return ASE_NULL; return ASE_NULL;
} }
@ -316,7 +317,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(p))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(p)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ase_lsp_set_value (lsp->mem, p1, p2) == ASE_NULL) { if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
} }
@ -354,16 +355,18 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = ASE_LSP_CAR(args); name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return ASE_NULL; return ASE_NULL;
} }
fun = ase_lsp_make_func (lsp->mem, fun = ase_lsp_makefunc (lsp->mem,
ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args))); ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args)));
if (fun == ASE_NULL) return ASE_NULL; if (fun == ASE_NULL) return ASE_NULL;
if (ase_lsp_set_func (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL) { if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
} }
@ -382,16 +385,18 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = ASE_LSP_CAR(args); name = ASE_LSP_CAR(args);
if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return ASE_NULL; return ASE_NULL;
} }
mac = ase_lsp_make_macro (lsp->mem, mac = ase_lsp_makemacro (lsp->mem,
ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args))); ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args)));
if (mac == ASE_NULL) return ASE_NULL; if (mac == ASE_NULL) return ASE_NULL;
if (ase_lsp_set_func (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL) { if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
} }

4
ase/lsp/prim.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim.h,v 1.8 2006-10-24 04:22:39 bacon Exp $ * $Id: prim.h,v 1.9 2006-10-25 13:42:31 bacon Exp $
*/ */
#ifndef _ASE_LSP_PRIM_H_ #ifndef _ASE_LSP_PRIM_H_
@ -57,7 +57,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args);
#define ASE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \ #define ASE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \
{ \ { \
ase_size_t count; \ ase_size_t count; \
if (ase_lsp_probe_args(lsp->mem, args, &count) == -1) { \ if (ase_lsp_probeargs(lsp->mem, args, &count) == -1) { \
lsp->errnum = ASE_LSP_ERR_BAD_ARG; \ lsp->errnum = ASE_LSP_ERR_BAD_ARG; \
return ASE_NULL; \ return ASE_NULL; \
} \ } \

372
ase/lsp/prim_compar.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim_compar.c,v 1.4 2006-10-24 04:22:39 bacon Exp $ * $Id: prim_compar.c,v 1.5 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/prim.h>
@ -11,7 +11,7 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -20,51 +20,67 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVALUE(p1) == ASE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) == ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVALUE(p1) == ASE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) == ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVALUE(p1) == ASE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) == ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVALUE(p1) == ASE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) == ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { {
res = ase_lsp_comp_symbol2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0; {
res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) == 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { else
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { {
res = ase_lsp_comp_string2 (
p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) == 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
@ -78,7 +94,7 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -87,51 +103,68 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVALUE(p1) != ASE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) != ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVALUE(p1) != ASE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) != ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVALUE(p1) != ASE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) != ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVALUE(p1) != ASE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) != ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { {
res = ase_lsp_comp_symbol2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0; {
res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0;
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { {
res = ase_lsp_comp_string2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) != 0; {
res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) != 0;
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
@ -145,7 +178,7 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -154,51 +187,68 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVALUE(p1) > ASE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) > ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVALUE(p1) > ASE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) > ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVALUE(p1) > ASE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) > ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVALUE(p1) > ASE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) > ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { {
res = ase_lsp_comp_symbol2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0; {
res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0;
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { {
res = ase_lsp_comp_string2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) > 0; {
res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) > 0;
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
@ -212,7 +262,7 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -221,51 +271,67 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVALUE(p1) < ASE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) < ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVALUE(p1) < ASE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) < ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVALUE(p1) < ASE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) < ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVALUE(p1) < ASE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) < ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { {
res = ase_lsp_comp_symbol2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0; {
res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) < 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { else
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { {
res = ase_lsp_comp_string2 (
p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) < 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
@ -279,7 +345,7 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -288,51 +354,67 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVALUE(p1) >= ASE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) >= ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVALUE(p1) >= ASE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) >= ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVALUE(p1) >= ASE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) >= ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVALUE(p1) >= ASE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) >= ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { {
res = ase_lsp_comp_symbol2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0; {
res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) >= 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { else
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { {
res = ase_lsp_comp_string2 (
p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) >= 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
@ -346,7 +428,7 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res; int res;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -355,51 +437,67 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_IVALUE(p1) <= ASE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) <= ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_IVALUE(p1) <= ASE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) <= ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) { {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
res = ASE_LSP_RVALUE(p1) <= ASE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) <= ASE_LSP_IVALUE(p2);
} }
else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL)
{
res = ASE_LSP_RVALUE(p1) <= ASE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) <= ASE_LSP_RVALUE(p2);
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) { {
res = ase_lsp_comp_symbol2 ( if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0; {
res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0;
}
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STR)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{
res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) <= 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) { else
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) { {
res = ase_lsp_comp_string2 (
p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) <= 0;
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL; return ASE_NULL;
} }

6
ase/lsp/prim_let.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim_let.c,v 1.5 2006-10-24 04:22:39 bacon Exp $ * $Id: prim_let.c,v 1.6 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/prim.h>
@ -40,7 +40,7 @@ static ase_lsp_obj_t* __prim_let (
ase_lsp_obj_t* n = ASE_LSP_CAR(ass); ase_lsp_obj_t* n = ASE_LSP_CAR(ass);
ase_lsp_obj_t* v = ASE_LSP_CDR(ass); ase_lsp_obj_t* v = ASE_LSP_CDR(ass);
if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYM) {
lsp->errnum = ASE_LSP_ERR_BAD_ARG; // must be a symbol lsp->errnum = ASE_LSP_ERR_BAD_ARG; // must be a symbol
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
@ -79,7 +79,7 @@ static ase_lsp_obj_t* __prim_let (
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYM) {
if (ase_lsp_frame_lookup(frame, ass) != ASE_NULL) { if (ase_lsp_frame_lookup(frame, ass) != ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;

55
ase/lsp/prim_math.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim_math.c,v 1.8 2006-10-24 04:22:39 bacon Exp $ * $Id: prim_math.c,v 1.9 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/prim.h>
@ -8,8 +8,8 @@
ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
ase_lsp_int_t ivalue = 0; ase_long_t ivalue = 0;
ase_lsp_real_t rvalue = .0; ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
@ -45,7 +45,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
else { else {
if (!realnum) { if (!realnum) {
realnum = ase_true; realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue + ASE_LSP_RVALUE(tmp); rvalue = rvalue + ASE_LSP_RVALUE(tmp);
} }
@ -62,8 +62,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
@ -75,8 +75,8 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
ase_lsp_int_t ivalue = 0; ase_long_t ivalue = 0;
ase_lsp_real_t rvalue = .0; ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
@ -110,7 +110,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
else { else {
if (!realnum) { if (!realnum) {
realnum = ase_true; realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue - ASE_LSP_RVALUE(tmp); rvalue = rvalue - ASE_LSP_RVALUE(tmp);
} }
@ -127,8 +127,8 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
@ -140,8 +140,8 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
ase_lsp_int_t ivalue = 0; ase_long_t ivalue = 0;
ase_lsp_real_t rvalue = .0; ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
@ -175,7 +175,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
else { else {
if (!realnum) { if (!realnum) {
realnum = ase_true; realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue * ASE_LSP_RVALUE(tmp); rvalue = rvalue * ASE_LSP_RVALUE(tmp);
} }
@ -192,8 +192,8 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
@ -205,8 +205,8 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
ase_lsp_int_t ivalue = 0; ase_long_t ivalue = 0;
ase_lsp_real_t rvalue = .0; ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
@ -245,7 +245,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
else { else {
if (!realnum) { if (!realnum) {
realnum = ase_true; realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue; rvalue = (ase_real_t)ivalue;
} }
rvalue = rvalue / ASE_LSP_RVALUE(tmp); rvalue = rvalue / ASE_LSP_RVALUE(tmp);
} }
@ -262,8 +262,8 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return ASE_NULL; return ASE_NULL;
@ -275,7 +275,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ase_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
ase_lsp_int_t ivalue = 0; ase_long_t ivalue = 0;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
@ -300,10 +300,10 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
ivalue = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp); ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp);
} }
else { else {
ase_lsp_int_t tmpi = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp); ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp);
if (tmpi == 0) { if (tmpi == 0) {
lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO;
return ASE_NULL; return ASE_NULL;
@ -322,9 +322,10 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = ase_lsp_make_int (lsp->mem, ivalue); tmp = ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }

20
ase/lsp/print.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: print.c,v 1.14 2006-10-24 04:22:39 bacon Exp $ * $Id: print.c,v 1.15 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp.h>
@ -21,10 +21,10 @@ void ase_lsp_print_debug (ase_lsp_obj_t* obj)
case ASE_LSP_OBJ_REAL: case ASE_LSP_OBJ_REAL:
ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj)); ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj));
break; break;
case ASE_LSP_OBJ_SYMBOL: case ASE_LSP_OBJ_SYM:
ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj)); ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj));
break; break;
case ASE_LSP_OBJ_STRING: case ASE_LSP_OBJ_STR:
ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj)); ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj));
break; break;
case ASE_LSP_OBJ_CONS: case ASE_LSP_OBJ_CONS:
@ -92,34 +92,34 @@ static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_con
OUTPUT_STR (lsp, ASE_TEXT("t")); OUTPUT_STR (lsp, ASE_TEXT("t"));
break; break;
case ASE_LSP_OBJ_INT: case ASE_LSP_OBJ_INT:
if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(int)) { if (ase_sizeof(ase_long_t) == ase_sizeof(int)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%d"), ASE_LSP_IVALUE(obj)); ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%d"), ASE_LSP_IVALUE(obj));
} }
else if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(long)) { else if (ase_sizeof(ase_long_t) == ase_sizeof(long)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%ld"), ASE_LSP_IVALUE(obj)); ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%ld"), ASE_LSP_IVALUE(obj));
} }
else if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(long long)) { else if (ase_sizeof(ase_long_t) == ase_sizeof(long long)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%lld"), ASE_LSP_IVALUE(obj)); ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%lld"), ASE_LSP_IVALUE(obj));
} }
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
break; break;
case ASE_LSP_OBJ_REAL: case ASE_LSP_OBJ_REAL:
if (ase_sizeof(ase_lsp_real_t) == ase_sizeof(double)) { if (ase_sizeof(ase_real_t) == ase_sizeof(double)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%f"), ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%f"),
(double)ASE_LSP_RVALUE(obj)); (double)ASE_LSP_RVALUE(obj));
} }
else if (ase_sizeof(ase_lsp_real_t) == ase_sizeof(long double)) { else if (ase_sizeof(ase_real_t) == ase_sizeof(long double)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%Lf"), ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%Lf"),
(long double)ASE_LSP_RVALUE(obj)); (long double)ASE_LSP_RVALUE(obj));
} }
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
break; break;
case ASE_LSP_OBJ_SYMBOL: case ASE_LSP_OBJ_SYM:
OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj)); OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj));
break; break;
case ASE_LSP_OBJ_STRING: case ASE_LSP_OBJ_STR:
OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj)); OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj));
break; break;
case ASE_LSP_OBJ_CONS: case ASE_LSP_OBJ_CONS:

164
ase/lsp/read.c
View File

@ -1,11 +1,8 @@
/* /*
* $Id: read.c,v 1.21 2006-10-24 15:31:35 bacon Exp $ * $Id: read.c,v 1.22 2006-10-25 13:42:31 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp_i.h>
#include <ase/lsp/token.h>
#include <ase/bas/assert.h>
#include <ase/bas/ctype.h>
#define IS_SPACE(x) ase_isspace(x) #define IS_SPACE(x) ase_isspace(x)
#define IS_DIGIT(x) ase_isdigit(x) #define IS_DIGIT(x) ase_isdigit(x)
@ -29,7 +26,7 @@
#define TOKEN_ADD_CHAR(lsp,ch) do { \ #define TOKEN_ADD_CHAR(lsp,ch) do { \
if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \ if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \
lsp->errnum = ASE_LSP_ERR_MEMORY; \ lsp->errnum = ASE_LSP_ENOMEM; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
@ -66,14 +63,15 @@ static int read_string (ase_lsp_t* lsp);
ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp) ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp)
{ {
if (lsp->curc == ASE_T_EOF && if (lsp->curc == ASE_CHAR_EOF &&
read_char(lsp) == -1) return ASE_NULL; read_char(lsp) == -1) return ASE_NULL;
lsp->errnum = ASE_LSP_ERR_NONE; lsp->errnum = ASE_LSP_ENOERR;
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
if (lsp->mem->locked != ASE_NULL) { if (lsp->mem->locked != ASE_NULL)
ase_lsp_unlockallobjs (lsp->mem->locked); {
ase_lsp_unlockallobjs (lsp, lsp->mem->locked);
lsp->mem->locked = ASE_NULL; lsp->mem->locked = ASE_NULL;
} }
lsp->mem->locked = read_obj (lsp); lsp->mem->locked = read_obj (lsp);
@ -95,30 +93,31 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
return read_quote (lsp); return read_quote (lsp);
case TOKEN_INT: case TOKEN_INT:
obj = ase_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp)); obj = ase_lsp_makeintobj (lsp->mem, TOKEN_IVALUE(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (obj); ase_lsp_lockobj (lsp, obj);
return obj; return obj;
case TOKEN_REAL: case TOKEN_REAL:
obj = ase_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp)); obj = ase_lsp_makerealobj (lsp->mem, TOKEN_RVALUE(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (obj); ase_lsp_lockobj (lsp, obj);
return obj; return obj;
case TOKEN_STRING: case TOKEN_STRING:
obj = ase_lsp_make_stringx ( obj = ase_lsp_makestrobj (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (obj); ase_lsp_lockobj (lsp, obj);
return obj; return obj;
case TOKEN_IDENT: case TOKEN_IDENT:
ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL); ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL);
if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0) obj = lsp->mem->nil; if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0) obj = lsp->mem->t; else if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0) obj = lsp->mem->t;
else { else
obj = ase_lsp_make_symbolx ( {
obj = ase_lsp_makesymobj (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (obj); ase_lsp_lockobj (lsp, obj);
} }
return obj; return obj;
} }
@ -165,21 +164,24 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
} }
obj = read_obj (lsp); obj = read_obj (lsp);
if (obj == ASE_NULL) { if (obj == ASE_NULL)
if (lsp->errnum == ASE_LSP_ERR_END) { {
if (lsp->errnum == ASE_LSP_ERR_END)
{
// unexpected end of input // unexpected end of input
lsp->errnum = ASE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
} }
return ASE_NULL; return ASE_NULL;
} }
p = (ase_lsp_obj_cons_t*)ase_lsp_make_cons ( p = (ase_lsp_obj_cons_t*)ase_lsp_makecons (
lsp->mem, lsp->mem->nil, lsp->mem->nil); lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == ASE_NULL) { if (p == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
ase_lsp_lockobj ((ase_lsp_obj_t*)p); ase_lsp_lockobj (lsp, (ase_lsp_obj_t*)p);
if (first == ASE_NULL) first = p; if (first == ASE_NULL) first = p;
if (prev != ASE_NULL) prev->cdr = (ase_lsp_obj_t*)p; if (prev != ASE_NULL) prev->cdr = (ase_lsp_obj_t*)p;
@ -198,27 +200,31 @@ static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp)
ase_lsp_obj_t* cons, * tmp; ase_lsp_obj_t* cons, * tmp;
tmp = read_obj (lsp); tmp = read_obj (lsp);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL)
if (lsp->errnum == ASE_LSP_ERR_END) { {
if (lsp->errnum == ASE_LSP_ERR_END)
{
// unexpected end of input // unexpected end of input
lsp->errnum = ASE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
} }
return ASE_NULL; return ASE_NULL;
} }
cons = ase_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil); cons = ase_lsp_makecons (lsp->mem, tmp, lsp->mem->nil);
if (cons == ASE_NULL) { if (cons == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
ase_lsp_lockobj (cons); ase_lsp_lockobj (lsp, cons);
cons = ase_lsp_make_cons (lsp->mem, lsp->mem->quote, cons); cons = ase_lsp_makecons (lsp->mem, lsp->mem->quote, cons);
if (cons == ASE_NULL) { if (cons == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
ase_lsp_lockobj (cons); ase_lsp_lockobj (lsp, cons);
return cons; return cons;
} }
@ -227,18 +233,20 @@ static int read_char (ase_lsp_t* lsp)
{ {
ase_ssize_t n; ase_ssize_t n;
if (lsp->input_func == ASE_NULL) { if (lsp->input_func == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_INPUT_NOT_ATTACHED; lsp->errnum = ASE_LSP_ERR_INPUT_NOT_ATTACHED;
return -1; return -1;
} }
n = lsp->input_func(ASE_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1); n = lsp->input_func(ASE_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1);
if (n == -1) { if (n == -1)
{
lsp->errnum = ASE_LSP_ERR_INPUT; lsp->errnum = ASE_LSP_ERR_INPUT;
return -1; return -1;
} }
if (n == 0) lsp->curc = ASE_T_EOF; if (n == 0) lsp->curc = ASE_CHAR_EOF;
return 0; return 0;
} }
@ -248,68 +256,84 @@ static int read_token (ase_lsp_t* lsp)
TOKEN_CLEAR (lsp); TOKEN_CLEAR (lsp);
for (;;) { while (1)
{
// skip white spaces // skip white spaces
while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp); while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here // skip the comments here
if (lsp->curc == ASE_T(';')) { if (lsp->curc == ASE_T(';'))
do { {
do
{
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_T_EOF); }
while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_CHAR_EOF);
} }
else break; else break;
} }
if (lsp->curc == ASE_T_EOF) { if (lsp->curc == ASE_CHAR_EOF)
{
TOKEN_TYPE(lsp) = TOKEN_END; TOKEN_TYPE(lsp) = TOKEN_END;
return 0; return 0;
} }
else if (lsp->curc == ASE_T('(')) { else if (lsp->curc == ASE_T('('))
{
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_LPAREN; TOKEN_TYPE(lsp) = TOKEN_LPAREN;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == ASE_T(')')) { else if (lsp->curc == ASE_T(')'))
{
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_RPAREN; TOKEN_TYPE(lsp) = TOKEN_RPAREN;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == ASE_T('\'')) { else if (lsp->curc == ASE_T('\''))
{
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_QUOTE; TOKEN_TYPE(lsp) = TOKEN_QUOTE;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == ASE_T('.')) { else if (lsp->curc == ASE_T('.'))
{
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_DOT; TOKEN_TYPE(lsp) = TOKEN_DOT;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return 0; return 0;
} }
else if (lsp->curc == ASE_T('-')) { else if (lsp->curc == ASE_T('-'))
{
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
if (IS_DIGIT(lsp->curc)) { if (IS_DIGIT(lsp->curc))
{
return read_number (lsp, 1); return read_number (lsp, 1);
} }
else if (IS_IDENT(lsp->curc)) { else if (IS_IDENT(lsp->curc))
{
return read_ident (lsp); return read_ident (lsp);
} }
else { else
{
TOKEN_TYPE(lsp) = TOKEN_IDENT; TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0; return 0;
} }
} }
else if (IS_DIGIT(lsp->curc)) { else if (IS_DIGIT(lsp->curc))
{
return read_number (lsp, 0); return read_number (lsp, 0);
} }
else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) { else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc))
{
return read_ident (lsp); return read_ident (lsp);
} }
else if (lsp->curc == ASE_T('\"')) { else if (lsp->curc == ASE_T('\"'))
{
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return read_string (lsp); return read_string (lsp);
} }
@ -321,24 +345,28 @@ static int read_token (ase_lsp_t* lsp)
static int read_number (ase_lsp_t* lsp, int negative) static int read_number (ase_lsp_t* lsp, int negative)
{ {
ase_lsp_int_t ivalue = 0; ase_long_t ivalue = 0;
ase_lsp_real_t rvalue = 0.; ase_real_t rvalue = 0.;
do { do
{
ivalue = ivalue * 10 + (lsp->curc - ASE_T('0')); ivalue = ivalue * 10 + (lsp->curc - ASE_T('0'));
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (IS_DIGIT(lsp->curc)); }
while (IS_DIGIT(lsp->curc));
/* TODO: extend parsing floating point number */ /* TODO: extend parsing floating point number */
if (lsp->curc == ASE_T('.')) { if (lsp->curc == ASE_T('.'))
ase_lsp_real_t fraction = 0.1; {
ase_real_t fraction = 0.1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
rvalue = (ase_lsp_real_t)ivalue; rvalue = (ase_real_t)ivalue;
while (IS_DIGIT(lsp->curc)) { while (IS_DIGIT(lsp->curc))
rvalue += (ase_lsp_real_t)(lsp->curc - ASE_T('0')) * fraction; {
rvalue += (ase_real_t)(lsp->curc - ASE_T('0')) * fraction;
fraction *= 0.1; fraction *= 0.1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} }
@ -372,7 +400,7 @@ static int read_string (ase_lsp_t* lsp)
ase_cint_t code = 0; ase_cint_t code = 0;
do { do {
if (lsp->curc == ASE_T_EOF) { if (lsp->curc == ASE_CHAR_EOF) {
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0; return 0;
} }

6
ase/lsp/token.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: token.h,v 1.13 2006-10-24 04:22:40 bacon Exp $ * $Id: token.h,v 1.14 2006-10-25 13:42:31 bacon Exp $
*/ */
#ifndef _ASE_LSP_TOKEN_H_ #ifndef _ASE_LSP_TOKEN_H_
@ -17,8 +17,8 @@ struct ase_lsp_token_t
{ {
int type; int type;
ase_lsp_int_t ivalue; ase_long_t ivalue;
ase_lsp_real_t rvalue; ase_real_t rvalue;
ase_lsp_name_t name; ase_lsp_name_t name;
ase_bool_t __dynamic; ase_bool_t __dynamic;

14
ase/lsp/types.h
View File

@ -1,14 +0,0 @@
/*
* $Id: types.h,v 1.9 2006-10-24 04:22:40 bacon Exp $
*/
#ifndef _ASE_LSP_TYPES_H_
#define _ASE_LSP_TYPES_H_
#include <ase/types.h>
#include <ase/macros.h>
typedef ase_long_t ase_lsp_int_t;
typedef ase_real_t ase_lsp_real_t;
#endif