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/bas/memory.h>
#include <ase/bas/assert.h>
#include <ase/lsp/lsp_i.h>
// TODO: make the frame hash accessible....
@ -48,7 +46,8 @@ void ase_lsp_frame_free (ase_lsp_frame_t* frame)
// destroy the associations
assoc = frame->assoc;
while (assoc != ASE_NULL) {
while (assoc != ASE_NULL)
{
link = assoc->link;
ase_lsp_assoc_free (assoc);
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_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL);
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = frame->assoc;
while (assoc != ASE_NULL) {
while (assoc != ASE_NULL)
{
if (name == assoc->name) return assoc;
assoc = assoc->link;
}
@ -76,7 +76,7 @@ ase_lsp_assoc_t* ase_lsp_frame_insert_value (
{
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);
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_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);
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[] =
{

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>
@ -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)
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;
/*
@ -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)?
ase_lsp_make_macro (lsp->mem, formal, body):
ase_lsp_make_func (lsp->mem, formal, body);
ase_lsp_makemacro (lsp->mem, formal, body):
ase_lsp_makefunc (lsp->mem, formal, body);
if (func == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
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);
cdr = ASE_LSP_CDR(cons);
if (car == lsp->mem->lambda) {
if (car == lsp->mem->lambda)
{
return make_func (lsp, cdr, 0);
}
else if (car == lsp->mem->macro) {
else if (car == lsp->mem->macro)
{
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;
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->func;
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 ||
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) {
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
{
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 */
return ASE_LSP_PRIM(func) (lsp, cdr);
}
else {
else
{
//TODO: emit the name for debugging
lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
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_
#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_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_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);

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>
@ -56,11 +56,11 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->macro = ASE_NULL;
/* initialize common object pointers */
mem->nil = ase_lsp_make_nil (mem);
mem->t = ase_lsp_make_true (mem);
mem->quote = ase_lsp_make_symbol (mem, ASE_T("quote"));
mem->lambda = ase_lsp_make_symbol (mem, ASE_T("lambda"));
mem->macro = ase_lsp_make_symbol (mem, ASE_T("macro"));
mem->nil = ase_lsp_makenil (mem);
mem->t = ase_lsp_maketrue (mem);
mem->quote = ase_lsp_makesymobj (mem, ASE_T("quote"), 5);
mem->lambda = ase_lsp_makesymobj (mem, ASE_T("lambda"), 6);
mem->macro = ase_lsp_makesymobj (mem, ASE_T("macro"), 5);
if (mem->nil == 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;
n = ase_lsp_make_symbolx (mem, name, len);
n = ase_lsp_makesymobj (mem, name, len);
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;
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;
}
@ -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;
}
obj = (ase_lsp_obj_t*) ase_malloc (size);
if (obj == ASE_NULL) {
obj = (ase_lsp_obj_t*) ASE_LSP_MALLOC (mem->lsp, size);
if (obj == ASE_NULL)
{
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;
}
@ -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:....
// 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)
{
__mark_obj (ASE_LSP_CAR(obj));
__mark_obj (ASE_LSP_CDR(obj));
__mark_obj (lsp, ASE_LSP_CAR(obj));
__mark_obj (lsp, ASE_LSP_CDR(obj));
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC)
{
__mark_obj (ASE_LSP_FFORMAL(obj));
__mark_obj (ASE_LSP_FBODY(obj));
__mark_obj (lsp, ASE_LSP_FFORMAL(obj));
__mark_obj (lsp, ASE_LSP_FBODY(obj));
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO)
{
__mark_obj (ASE_LSP_MFORMAL(obj));
__mark_obj (ASE_LSP_MBODY(obj));
__mark_obj (lsp, ASE_LSP_MFORMAL(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_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;
}
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;
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
ase_lsp_unlockallobjs (ASE_LSP_CAR(obj));
ase_lsp_unlockallobjs (ASE_LSP_CDR(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_CAR(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_CDR(obj));
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC)
{
ase_lsp_unlockallobjs (ASE_LSP_FFORMAL(obj));
ase_lsp_unlockallobjs (ASE_LSP_FBODY(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_FFORMAL(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_FBODY(obj));
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO)
{
ase_lsp_unlockallobjs (ASE_LSP_MFORMAL(obj));
ase_lsp_unlockallobjs (ASE_LSP_MBODY(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_MFORMAL(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;
while (assoc != ASE_NULL)
{
__mark_obj (assoc->name);
__mark_obj (mem->lsp, assoc->name);
if (assoc->value != ASE_NULL)
__mark_obj (assoc->value);
__mark_obj (mem->lsp, assoc->value);
if (assoc->func != ASE_NULL)
__mark_obj (assoc->func);
__mark_obj (mem->lsp, assoc->func);
assoc = assoc->link;
}
@ -331,12 +332,12 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
assoc = frame->assoc;
while (assoc != ASE_NULL) {
__mark_obj (assoc->name);
__mark_obj (mem->lsp, assoc->name);
if (assoc->value != ASE_NULL)
__mark_obj (assoc->value);
__mark_obj (mem->lsp, assoc->value);
if (assoc->func != ASE_NULL)
__mark_obj (assoc->func);
__mark_obj (mem->lsp, assoc->func);
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"));
if (mem->locked != ASE_NULL) __mark_obj (mem->locked);
if (mem->locked != ASE_NULL) __mark_obj (mem->lsp, mem->locked);
*/
#if 0
ase_dprint0 (ASE_T("marking termporary objects\n"));
#endif
array = mem->temp_array;
for (i = 0; i < array->size; i++) {
__mark_obj (array->buffer[i]);
for (i = 0; i < array->size; i++)
{
__mark_obj (mem->lsp, array->buffer[i]);
}
#if 0
ase_dprint0 (ASE_T("marking builtin objects\n"));
#endif
// mark common objects
if (mem->t != ASE_NULL) __mark_obj (mem->t);
if (mem->nil != ASE_NULL) __mark_obj (mem->nil);
if (mem->quote != ASE_NULL) __mark_obj (mem->quote);
if (mem->lambda != ASE_NULL) __mark_obj (mem->lambda);
if (mem->macro != ASE_NULL) __mark_obj (mem->macro);
if (mem->t != ASE_NULL) __mark_obj (mem->lsp, mem->t);
if (mem->nil != ASE_NULL) __mark_obj (mem->lsp, mem->nil);
if (mem->quote != ASE_NULL) __mark_obj (mem->lsp, mem->quote);
if (mem->lambda != ASE_NULL) __mark_obj (mem->lsp, mem->lambda);
if (mem->macro != ASE_NULL) __mark_obj (mem->lsp, mem->macro);
}
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_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;
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;
}
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;
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;
}
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;
@ -435,7 +439,7 @@ ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value)
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;
@ -448,57 +452,50 @@ ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value)
return obj;
}
ase_lsp_obj_t* ase_lsp_make_symbol (ase_lsp_mem_t* mem, const ase_char_t* str)
{
return ase_lsp_make_symbolx (mem, str, ase_strlen(str));
}
ase_lsp_obj_t* ase_lsp_make_symbolx (
ase_lsp_obj_t* ase_lsp_makesymobj (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len)
{
ase_lsp_obj_t* obj;
// look for a sysmbol with the given name
obj = mem->used[ASE_LSP_OBJ_SYMBOL];
while (obj != ASE_NULL) {
obj = mem->used[ASE_LSP_OBJ_SYM];
while (obj != ASE_NULL)
{
// 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);
}
// no such symbol found. create a new one
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_SYMBOL,
ase_sizeof(ase_lsp_obj_symbol_t) + (len + 1) * ase_sizeof(ase_char_t));
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_SYM,
ase_sizeof(ase_lsp_obj_sym_t)+(len + 1)*ase_sizeof(ase_char_t));
if (obj == ASE_NULL) return ASE_NULL;
// 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;
}
ase_lsp_obj_t* ase_lsp_make_string (ase_lsp_mem_t* mem, const ase_char_t* str)
{
return ase_lsp_make_stringx (mem, str, ase_strlen(str));
}
ase_lsp_obj_t* ase_lsp_make_stringx (
ase_lsp_obj_t* ase_lsp_makestrobj (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len)
{
ase_lsp_obj_t* obj;
// allocate memory for the string
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_STRING,
ase_sizeof(ase_lsp_obj_string_t) + (len + 1) * ase_sizeof(ase_char_t));
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_STR,
ase_sizeof(ase_lsp_obj_str_t)+(len + 1)*ase_sizeof(ase_char_t));
if (obj == ASE_NULL) return ASE_NULL;
// 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;
}
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_obj_t* obj;
@ -512,7 +509,7 @@ ase_lsp_obj_t* ase_lsp_make_cons (
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_obj_t* obj;
@ -526,7 +523,7 @@ ase_lsp_obj_t* ase_lsp_make_func (
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_obj_t* obj;
@ -540,15 +537,16 @@ ase_lsp_obj_t* ase_lsp_make_macro (
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;
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;
ASE_LSP_PRIM(obj) = impl;
/*ASE_LSP_PRIM(obj) = (ase_lsp_prim_t)impl;*/
((ase_lsp_obj_prim_t*)obj)->impl = impl;
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_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;
while (frame != ASE_NULL) {
while (frame != ASE_NULL)
{
assoc = ase_lsp_frame_lookup (frame, name);
if (assoc != ASE_NULL) return assoc;
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;
}
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_assoc_t* assoc;
assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL) {
if (assoc == ASE_NULL)
{
assoc = ase_lsp_frame_insert_value (
mem->root_frame, name, value);
if (assoc == ASE_NULL) return ASE_NULL;
@ -586,13 +586,14 @@ ase_lsp_assoc_t* ase_lsp_set_value (
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_assoc_t* assoc;
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);
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_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;
//while (obj != mem->nil) {
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) {
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
count++;
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;
}
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;
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) {
while (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
count++;
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;
}
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_
@ -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_collectgarbage (ase_lsp_mem_t* mem);
void ase_lsp_lockobj (ase_lsp_obj_t* obj);
void ase_lsp_unlockobj (ase_lsp_obj_t* obj);
void ase_lsp_unlockallobjs (ase_lsp_obj_t* obj);
void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
// object creation of standard types
ase_lsp_obj_t* ase_lsp_make_nil (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_make_true (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_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value);
ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_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_mem_t* mem, const ase_char_t* str);
ase_lsp_obj_t* ase_lsp_make_symbolx (
ase_lsp_obj_t* ase_lsp_makesymobj (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
ase_lsp_obj_t* ase_lsp_make_string (
ase_lsp_mem_t* mem, const ase_char_t* str);
ase_lsp_obj_t* ase_lsp_make_stringx (
ase_lsp_obj_t* ase_lsp_makestrobj (
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_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_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_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
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_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);
// cons operations
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);
// 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);
int ase_lsp_probeargs (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len);
#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_
@ -14,8 +14,8 @@ enum
ASE_LSP_OBJ_TRUE,
ASE_LSP_OBJ_INT,
ASE_LSP_OBJ_REAL,
ASE_LSP_OBJ_SYMBOL,
ASE_LSP_OBJ_STRING,
ASE_LSP_OBJ_SYM,
ASE_LSP_OBJ_STR,
ASE_LSP_OBJ_CONS,
ASE_LSP_OBJ_FUNC,
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_int_t ase_lsp_obj_int_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_string_t ase_lsp_obj_string_t;
typedef struct ase_lsp_obj_sym_t ase_lsp_obj_sym_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_func_t ase_lsp_obj_func_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
{
ase_lsp_objhdr_t hdr;
ase_lsp_int_t value;
ase_long_t value;
};
struct ase_lsp_obj_real_t
{
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;
#if defined(__BORLANDC__) || defined(_MSC_VER)
@ -82,7 +82,7 @@ struct ase_lsp_obj_symbol_t
#endif
};
struct ase_lsp_obj_string_t
struct ase_lsp_obj_str_t
{
ase_lsp_objhdr_t hdr;
#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_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value)
#ifdef __BORLANDC__
#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_symbol_t*)x) + 1))
#if defined(__BORLANDC__) || defined(_MSC_VER)
#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1))
#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
#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__
#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_string_t*)x) + 1))
#if defined(__BORLANDC__) || defined(_MSC_VER)
#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1))
#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
#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_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>
@ -29,17 +29,17 @@ static int __add_prim (ase_lsp_mem_t* mem,
{
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;
ase_lsp_lock (n);
p = ase_lsp_make_prim (mem, prim);
p = ase_lsp_makeprim (mem, prim);
if (p == ASE_NULL) return -1;
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;
}
@ -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)));
if (cdr == ASE_NULL) return ASE_NULL;
cons = ase_lsp_make_cons (lsp->mem, car, cdr);
if (cons == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
cons = ase_lsp_makecons (lsp->mem, car, cdr);
if (cons == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
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));
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;
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)));
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;
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);
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;
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)));
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;
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);
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;
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)));
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;
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);
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;
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)));
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;
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_
@ -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) \
{ \
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; \
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>
@ -11,7 +11,7 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
int res;
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));
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)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = ase_lsp_comp_symbol2 (
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0;
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
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 {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
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 {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
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;
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));
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)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = ase_lsp_comp_symbol2 (
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0;
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
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;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
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 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;
return ASE_NULL;
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
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;
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));
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)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = ase_lsp_comp_symbol2 (
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0;
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
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;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
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 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;
return ASE_NULL;
}
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
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;
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));
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)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = ase_lsp_comp_symbol2 (
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0;
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
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 {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
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 {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
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;
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));
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)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = ase_lsp_comp_symbol2 (
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0;
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
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 {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
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 {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
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;
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));
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)));
if (p2 == ASE_NULL) return ASE_NULL;
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT)
{
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);
}
else {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = ase_lsp_comp_symbol2 (
p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0;
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYM)
{
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{
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 {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return ASE_NULL;
}
}
else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
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 {
else
{
lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
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>
@ -40,7 +40,7 @@ static ase_lsp_obj_t* __prim_let (
ase_lsp_obj_t* n = ASE_LSP_CAR(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
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
@ -79,7 +79,7 @@ static ase_lsp_obj_t* __prim_let (
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) {
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
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>
@ -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* body, * tmp;
ase_lsp_int_t ivalue = 0;
ase_lsp_real_t rvalue = .0;
ase_long_t ivalue = 0;
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
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 {
if (!realnum) {
realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue;
rvalue = (ase_real_t)ivalue;
}
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);
tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue);
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
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* body, * tmp;
ase_lsp_int_t ivalue = 0;
ase_lsp_real_t rvalue = .0;
ase_long_t ivalue = 0;
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
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 {
if (!realnum) {
realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue;
rvalue = (ase_real_t)ivalue;
}
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);
tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue);
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
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* body, * tmp;
ase_lsp_int_t ivalue = 0;
ase_lsp_real_t rvalue = .0;
ase_long_t ivalue = 0;
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
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 {
if (!realnum) {
realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue;
rvalue = (ase_real_t)ivalue;
}
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);
tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue);
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
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* body, * tmp;
ase_lsp_int_t ivalue = 0;
ase_lsp_real_t rvalue = .0;
ase_long_t ivalue = 0;
ase_real_t rvalue = .0;
ase_bool_t realnum = ase_false;
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 {
if (!realnum) {
realnum = ase_true;
rvalue = (ase_lsp_real_t)ivalue;
rvalue = (ase_real_t)ivalue;
}
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);
tmp = (realnum)?
ase_lsp_make_real (lsp->mem, rvalue):
ase_lsp_make_int (lsp->mem, ivalue);
ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
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* 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_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) {
if (body == args) {
ivalue = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp);
ivalue = (ase_long_t)ASE_LSP_RVALUE(tmp);
}
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) {
lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO;
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);
tmp = ase_lsp_make_int (lsp->mem, ivalue);
if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
tmp = ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
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>
@ -21,10 +21,10 @@ void ase_lsp_print_debug (ase_lsp_obj_t* obj)
case ASE_LSP_OBJ_REAL:
ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj));
break;
case ASE_LSP_OBJ_SYMBOL:
case ASE_LSP_OBJ_SYM:
ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj));
break;
case ASE_LSP_OBJ_STRING:
case ASE_LSP_OBJ_STR:
ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj));
break;
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"));
break;
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));
}
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));
}
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));
}
OUTPUT_STR (lsp, buf);
break;
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"),
(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"),
(long double)ASE_LSP_RVALUE(obj));
}
OUTPUT_STR (lsp, buf);
break;
case ASE_LSP_OBJ_SYMBOL:
case ASE_LSP_OBJ_SYM:
OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj));
break;
case ASE_LSP_OBJ_STRING:
case ASE_LSP_OBJ_STR:
OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj));
break;
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/token.h>
#include <ase/bas/assert.h>
#include <ase/bas/ctype.h>
#include <ase/lsp/lsp_i.h>
#define IS_SPACE(x) ase_isspace(x)
#define IS_DIGIT(x) ase_isdigit(x)
@ -29,7 +26,7 @@
#define TOKEN_ADD_CHAR(lsp,ch) do { \
if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \
lsp->errnum = ASE_LSP_ERR_MEMORY; \
lsp->errnum = ASE_LSP_ENOMEM; \
return -1; \
} \
} 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)
{
if (lsp->curc == ASE_T_EOF &&
if (lsp->curc == ASE_CHAR_EOF &&
read_char(lsp) == -1) return ASE_NULL;
lsp->errnum = ASE_LSP_ERR_NONE;
lsp->errnum = ASE_LSP_ENOERR;
NEXT_TOKEN (lsp);
if (lsp->mem->locked != ASE_NULL) {
ase_lsp_unlockallobjs (lsp->mem->locked);
if (lsp->mem->locked != ASE_NULL)
{
ase_lsp_unlockallobjs (lsp, lsp->mem->locked);
lsp->mem->locked = ASE_NULL;
}
lsp->mem->locked = read_obj (lsp);
@ -95,30 +93,31 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
NEXT_TOKEN (lsp);
return read_quote (lsp);
case TOKEN_INT:
obj = ase_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
ase_lsp_lockobj (obj);
obj = ase_lsp_makeintobj (lsp->mem, TOKEN_IVALUE(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_REAL:
obj = ase_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
ase_lsp_lockobj (obj);
obj = ase_lsp_makerealobj (lsp->mem, TOKEN_RVALUE(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_STRING:
obj = ase_lsp_make_stringx (
obj = ase_lsp_makestrobj (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
ase_lsp_lockobj (obj);
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_IDENT:
ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL);
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 {
obj = ase_lsp_make_symbolx (
else
{
obj = ase_lsp_makesymobj (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
ase_lsp_lockobj (obj);
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (lsp, obj);
}
return obj;
}
@ -165,21 +164,24 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
}
obj = read_obj (lsp);
if (obj == ASE_NULL) {
if (lsp->errnum == ASE_LSP_ERR_END) {
if (obj == ASE_NULL)
{
if (lsp->errnum == ASE_LSP_ERR_END)
{
// unexpected end of input
lsp->errnum = ASE_LSP_ERR_SYNTAX;
}
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);
if (p == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
if (p == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
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 (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;
tmp = read_obj (lsp);
if (tmp == ASE_NULL) {
if (lsp->errnum == ASE_LSP_ERR_END) {
if (tmp == ASE_NULL)
{
if (lsp->errnum == ASE_LSP_ERR_END)
{
// unexpected end of input
lsp->errnum = ASE_LSP_ERR_SYNTAX;
}
return ASE_NULL;
}
cons = ase_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil);
if (cons == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
cons = ase_lsp_makecons (lsp->mem, tmp, lsp->mem->nil);
if (cons == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
ase_lsp_lockobj (cons);
ase_lsp_lockobj (lsp, cons);
cons = ase_lsp_make_cons (lsp->mem, lsp->mem->quote, cons);
if (cons == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY;
cons = ase_lsp_makecons (lsp->mem, lsp->mem->quote, cons);
if (cons == ASE_NULL)
{
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
ase_lsp_lockobj (cons);
ase_lsp_lockobj (lsp, cons);
return cons;
}
@ -227,18 +233,20 @@ static int read_char (ase_lsp_t* lsp)
{
ase_ssize_t n;
if (lsp->input_func == ASE_NULL) {
if (lsp->input_func == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_INPUT_NOT_ATTACHED;
return -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;
return -1;
}
if (n == 0) lsp->curc = ASE_T_EOF;
if (n == 0) lsp->curc = ASE_CHAR_EOF;
return 0;
}
@ -248,68 +256,84 @@ static int read_token (ase_lsp_t* lsp)
TOKEN_CLEAR (lsp);
for (;;) {
while (1)
{
// skip white spaces
while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here
if (lsp->curc == ASE_T(';')) {
do {
if (lsp->curc == ASE_T(';'))
{
do
{
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;
}
if (lsp->curc == ASE_T_EOF) {
if (lsp->curc == ASE_CHAR_EOF)
{
TOKEN_TYPE(lsp) = TOKEN_END;
return 0;
}
else if (lsp->curc == ASE_T('(')) {
else if (lsp->curc == ASE_T('('))
{
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_LPAREN;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == ASE_T(')')) {
else if (lsp->curc == ASE_T(')'))
{
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_RPAREN;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == ASE_T('\'')) {
else if (lsp->curc == ASE_T('\''))
{
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_QUOTE;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == ASE_T('.')) {
else if (lsp->curc == ASE_T('.'))
{
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_DOT;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == ASE_T('-')) {
else if (lsp->curc == ASE_T('-'))
{
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
if (IS_DIGIT(lsp->curc)) {
if (IS_DIGIT(lsp->curc))
{
return read_number (lsp, 1);
}
else if (IS_IDENT(lsp->curc)) {
else if (IS_IDENT(lsp->curc))
{
return read_ident (lsp);
}
else {
else
{
TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0;
}
}
else if (IS_DIGIT(lsp->curc)) {
else if (IS_DIGIT(lsp->curc))
{
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);
}
else if (lsp->curc == ASE_T('\"')) {
else if (lsp->curc == ASE_T('\"'))
{
NEXT_CHAR (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)
{
ase_lsp_int_t ivalue = 0;
ase_lsp_real_t rvalue = 0.;
ase_long_t ivalue = 0;
ase_real_t rvalue = 0.;
do {
do
{
ivalue = ivalue * 10 + (lsp->curc - ASE_T('0'));
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
} while (IS_DIGIT(lsp->curc));
}
while (IS_DIGIT(lsp->curc));
/* TODO: extend parsing floating point number */
if (lsp->curc == ASE_T('.')) {
ase_lsp_real_t fraction = 0.1;
if (lsp->curc == ASE_T('.'))
{
ase_real_t fraction = 0.1;
NEXT_CHAR (lsp);
rvalue = (ase_lsp_real_t)ivalue;
rvalue = (ase_real_t)ivalue;
while (IS_DIGIT(lsp->curc)) {
rvalue += (ase_lsp_real_t)(lsp->curc - ASE_T('0')) * fraction;
while (IS_DIGIT(lsp->curc))
{
rvalue += (ase_real_t)(lsp->curc - ASE_T('0')) * fraction;
fraction *= 0.1;
NEXT_CHAR (lsp);
}
@ -372,7 +400,7 @@ static int read_string (ase_lsp_t* lsp)
ase_cint_t code = 0;
do {
if (lsp->curc == ASE_T_EOF) {
if (lsp->curc == ASE_CHAR_EOF) {
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
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_
@ -17,8 +17,8 @@ struct ase_lsp_token_t
{
int type;
ase_lsp_int_t ivalue;
ase_lsp_real_t rvalue;
ase_long_t ivalue;
ase_real_t rvalue;
ase_lsp_name_t name;
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