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-24 04:22:40 +00:00
parent 2b04c6af3e
commit 16f5c251c5
26 changed files with 2153 additions and 2153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
ase/lsp/array.c
View File

@ -1,62 +1,62 @@
/* /*
* $Id: array.c,v 1.10 2006-10-23 14:49:16 bacon Exp $ * $Id: array.c,v 1.11 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
sse_lsp_array_t* sse_lsp_array_new (sse_size_t capacity) ase_lsp_array_t* ase_lsp_array_new (ase_size_t capacity)
{ {
sse_lsp_array_t* array; ase_lsp_array_t* array;
sse_assert (capacity > 0); ase_assert (capacity > 0);
array = (sse_lsp_array_t*) sse_malloc (sizeof(sse_lsp_array_t)); array = (ase_lsp_array_t*) ase_malloc (sizeof(ase_lsp_array_t));
if (array == SSE_NULL) return SSE_NULL; if (array == ASE_NULL) return ASE_NULL;
array->buffer = (void**) sse_malloc (capacity + 1); array->buffer = (void**) ase_malloc (capacity + 1);
if (array->buffer == SSE_NULL) { if (array->buffer == ASE_NULL) {
free (array); free (array);
return SSE_NULL; return ASE_NULL;
} }
array->size = 0; array->size = 0;
array->capacity = capacity; array->capacity = capacity;
array->buffer[0] = SSE_NULL; array->buffer[0] = ASE_NULL;
return array; return array;
} }
void sse_lsp_array_free (sse_lsp_array_t* array) void ase_lsp_array_free (ase_lsp_array_t* array)
{ {
while (array->size > 0) while (array->size > 0)
free (array->buffer[--array->size]); free (array->buffer[--array->size]);
sse_assert (array->size == 0); ase_assert (array->size == 0);
free (array->buffer); free (array->buffer);
free (array); free (array);
} }
int sse_lsp_array_add_item (sse_lsp_array_t* array, void* item) int ase_lsp_array_add_item (ase_lsp_array_t* array, void* item)
{ {
if (array->size >= array->capacity) { if (array->size >= array->capacity) {
void* new_buffer = (void**)realloc ( void* new_buffer = (void**)realloc (
array->buffer, array->capacity * 2 + 1); array->buffer, array->capacity * 2 + 1);
if (new_buffer == SSE_NULL) return -1; if (new_buffer == ASE_NULL) return -1;
array->buffer = new_buffer; array->buffer = new_buffer;
array->capacity = array->capacity * 2; array->capacity = array->capacity * 2;
} }
array->buffer[array->size++] = item; array->buffer[array->size++] = item;
array->buffer[array->size] = SSE_NULL; array->buffer[array->size] = ASE_NULL;
return 0; return 0;
} }
int sse_lsp_array_insert (sse_lsp_array_t* array, sse_size_t index, void* value) int ase_lsp_array_insert (ase_lsp_array_t* array, ase_size_t index, void* value)
{ {
sse_size_t i; ase_size_t i;
if (index >= array->capacity) { if (index >= array->capacity) {
void* new_buffer = (void**)realloc ( void* new_buffer = (void**)realloc (
array->buffer, array->capacity * 2 + 1); array->buffer, array->capacity * 2 + 1);
if (new_buffer == SSE_NULL) return -1; if (new_buffer == ASE_NULL) return -1;
array->buffer = new_buffer; array->buffer = new_buffer;
array->capacity = array->capacity * 2; array->capacity = array->capacity * 2;
} }
@ -70,32 +70,32 @@ int sse_lsp_array_insert (sse_lsp_array_t* array, sse_size_t index, void* value)
return 0; return 0;
} }
void sse_lsp_array_delete (sse_lsp_array_t* array, sse_size_t index) void ase_lsp_array_delete (ase_lsp_array_t* array, ase_size_t index)
{ {
sse_assert (index < array->size); ase_assert (index < array->size);
} }
void sse_lsp_array_clear (sse_lsp_array_t* array) void ase_lsp_array_clear (ase_lsp_array_t* array)
{ {
while (array->size > 0) while (array->size > 0)
free (array->buffer[--array->size]); free (array->buffer[--array->size]);
sse_assert (array->size == 0); ase_assert (array->size == 0);
array->buffer[0] = SSE_NULL; array->buffer[0] = ASE_NULL;
} }
void** sse_lsp_array_yield (sse_lsp_array_t* array, sse_size_t capacity) void** ase_lsp_array_yield (ase_lsp_array_t* array, ase_size_t capacity)
{ {
void** old_buffer, ** new_buffer; void** old_buffer, ** new_buffer;
new_buffer = (void**) sse_malloc (capacity + 1); new_buffer = (void**) ase_malloc (capacity + 1);
if (new_buffer == SSE_NULL) return SSE_NULL; if (new_buffer == ASE_NULL) return ASE_NULL;
old_buffer = array->buffer; old_buffer = array->buffer;
array->buffer = new_buffer; array->buffer = new_buffer;
array->size = 0; array->size = 0;
array->capacity = capacity; array->capacity = capacity;
array->buffer[0] = SSE_NULL; array->buffer[0] = ASE_NULL;
return old_buffer; return old_buffer;
} }

30
ase/lsp/array.h
View File

@ -1,32 +1,32 @@
/* /*
* $Id: array.h,v 1.6 2006-10-22 13:10:45 bacon Exp $ * $Id: array.h,v 1.7 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_ARRAY_H_ #ifndef _ASE_LSP_ARRAY_H_
#define _SSE_LSP_ARRAY_H_ #define _ASE_LSP_ARRAY_H_
#include <sse/types.h> #include <ase/types.h>
struct sse_lsp_array_t struct ase_lsp_array_t
{ {
void** buffer; void** buffer;
sse_size_t size; ase_size_t size;
sse_size_t capacity; ase_size_t capacity;
}; };
typedef struct sse_lsp_array_t sse_lsp_array_t; typedef struct ase_lsp_array_t ase_lsp_array_t;
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_array_t* sse_lsp_array_new (sse_size_t capacity); ase_lsp_array_t* ase_lsp_array_new (ase_size_t capacity);
void sse_lsp_array_free (sse_lsp_array_t* array); void ase_lsp_array_free (ase_lsp_array_t* array);
int sse_lsp_array_add_item (sse_lsp_array_t* array, void* item); int ase_lsp_array_add_item (ase_lsp_array_t* array, void* item);
int sse_lsp_array_insert (sse_lsp_array_t* array, sse_size_t index, void* value); int ase_lsp_array_insert (ase_lsp_array_t* array, ase_size_t index, void* value);
void sse_lsp_array_delete (sse_lsp_array_t* array, sse_size_t index); void ase_lsp_array_delete (ase_lsp_array_t* array, ase_size_t index);
void sse_lsp_array_clear (sse_lsp_array_t* array); void ase_lsp_array_clear (ase_lsp_array_t* array);
void** sse_lsp_array_yield (sse_lsp_array_t* array, sse_size_t capacity); void** ase_lsp_array_yield (ase_lsp_array_t* array, ase_size_t capacity);
#ifdef __cplusplus #ifdef __cplusplus
} }

80
ase/lsp/env.c
View File

@ -1,99 +1,99 @@
/* /*
* $Id: env.c,v 1.9 2006-10-22 13:10:45 bacon Exp $ * $Id: env.c,v 1.10 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/env.h> #include <ase/lsp/env.h>
#include <sse/bas/memory.h> #include <ase/bas/memory.h>
#include <sse/bas/assert.h> #include <ase/bas/assert.h>
// TODO: make the frame hash accessible.... // TODO: make the frame hash accessible....
sse_lsp_assoc_t* sse_lsp_assoc_new ( ase_lsp_assoc_t* ase_lsp_assoc_new (
sse_lsp_obj_t* name, sse_lsp_obj_t* value, sse_lsp_obj_t* func) ase_lsp_obj_t* name, ase_lsp_obj_t* value, ase_lsp_obj_t* func)
{ {
sse_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
assoc = (sse_lsp_assoc_t*) sse_malloc (sizeof(sse_lsp_assoc_t)); assoc = (ase_lsp_assoc_t*) ase_malloc (sizeof(ase_lsp_assoc_t));
if (assoc == SSE_NULL) return SSE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
assoc->name = name; assoc->name = name;
assoc->value = value; assoc->value = value;
assoc->func = func; assoc->func = func;
assoc->link = SSE_NULL; assoc->link = ASE_NULL;
return assoc; return assoc;
} }
void sse_lsp_assoc_free (sse_lsp_assoc_t* assoc) void ase_lsp_assoc_free (ase_lsp_assoc_t* assoc)
{ {
sse_free (assoc); ase_free (assoc);
} }
sse_lsp_frame_t* sse_lsp_frame_new (void) ase_lsp_frame_t* ase_lsp_frame_new (void)
{ {
sse_lsp_frame_t* frame; ase_lsp_frame_t* frame;
frame = (sse_lsp_frame_t*) sse_malloc (sizeof(sse_lsp_frame_t)); frame = (ase_lsp_frame_t*) ase_malloc (sizeof(ase_lsp_frame_t));
if (frame == SSE_NULL) return SSE_NULL; if (frame == ASE_NULL) return ASE_NULL;
frame->assoc = SSE_NULL; frame->assoc = ASE_NULL;
frame->link = SSE_NULL; frame->link = ASE_NULL;
return frame; return frame;
} }
void sse_lsp_frame_free (sse_lsp_frame_t* frame) void ase_lsp_frame_free (ase_lsp_frame_t* frame)
{ {
sse_lsp_assoc_t* assoc, * link; ase_lsp_assoc_t* assoc, * link;
// destroy the associations // destroy the associations
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != SSE_NULL) { while (assoc != ASE_NULL) {
link = assoc->link; link = assoc->link;
sse_lsp_assoc_free (assoc); ase_lsp_assoc_free (assoc);
assoc = link; assoc = link;
} }
sse_free (frame); ase_free (frame);
} }
sse_lsp_assoc_t* sse_lsp_frame_lookup (sse_lsp_frame_t* frame, sse_lsp_obj_t* name) ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* name)
{ {
sse_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
sse_assert (SSE_LSP_TYPE(name) == SSE_LSP_OBJ_SYMBOL); ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL);
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != SSE_NULL) { while (assoc != ASE_NULL) {
if (name == assoc->name) return assoc; if (name == assoc->name) return assoc;
assoc = assoc->link; assoc = assoc->link;
} }
return SSE_NULL; return ASE_NULL;
} }
sse_lsp_assoc_t* sse_lsp_frame_insert_value ( ase_lsp_assoc_t* ase_lsp_frame_insert_value (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* value) ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* value)
{ {
sse_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
sse_assert (SSE_LSP_TYPE(name) == SSE_LSP_OBJ_SYMBOL); ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL);
assoc = sse_lsp_assoc_new (name, value, SSE_NULL); assoc = ase_lsp_assoc_new (name, value, ASE_NULL);
if (assoc == SSE_NULL) return SSE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
assoc->link = frame->assoc; assoc->link = frame->assoc;
frame->assoc = assoc; frame->assoc = assoc;
return assoc; return assoc;
} }
sse_lsp_assoc_t* sse_lsp_frame_insert_func ( ase_lsp_assoc_t* ase_lsp_frame_insert_func (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* func) ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* func)
{ {
sse_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
sse_assert (SSE_LSP_TYPE(name) == SSE_LSP_OBJ_SYMBOL); ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYMBOL);
assoc = sse_lsp_assoc_new (name, SSE_NULL, func); assoc = ase_lsp_assoc_new (name, ASE_NULL, func);
if (assoc == SSE_NULL) return SSE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
assoc->link = frame->assoc; assoc->link = frame->assoc;
frame->assoc = assoc; frame->assoc = assoc;
return assoc; return assoc;

50
ase/lsp/env.h
View File

@ -1,46 +1,46 @@
/* /*
* $Id: env.h,v 1.8 2006-10-22 13:10:45 bacon Exp $ * $Id: env.h,v 1.9 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_ENV_H_ #ifndef _ASE_LSP_ENV_H_
#define _SSE_LSP_ENV_H_ #define _ASE_LSP_ENV_H_
#include <sse/lsp/obj.h> #include <ase/lsp/obj.h>
struct sse_lsp_assoc_t struct ase_lsp_assoc_t
{ {
sse_lsp_obj_t* name; // sse_lsp_obj_symbol_t ase_lsp_obj_t* name; // ase_lsp_obj_symbol_t
/*sse_lsp_obj_t* value;*/ /*ase_lsp_obj_t* value;*/
sse_lsp_obj_t* value; /* value as a variable */ ase_lsp_obj_t* value; /* value as a variable */
sse_lsp_obj_t* func; /* function definition */ ase_lsp_obj_t* func; /* function definition */
struct sse_lsp_assoc_t* link; struct ase_lsp_assoc_t* link;
}; };
struct sse_lsp_frame_t struct ase_lsp_frame_t
{ {
struct sse_lsp_assoc_t* assoc; struct ase_lsp_assoc_t* assoc;
struct sse_lsp_frame_t* link; struct ase_lsp_frame_t* link;
}; };
typedef struct sse_lsp_assoc_t sse_lsp_assoc_t; typedef struct ase_lsp_assoc_t ase_lsp_assoc_t;
typedef struct sse_lsp_frame_t sse_lsp_frame_t; typedef struct ase_lsp_frame_t ase_lsp_frame_t;
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_assoc_t* sse_lsp_assoc_new ( ase_lsp_assoc_t* ase_lsp_assoc_new (
sse_lsp_obj_t* name, sse_lsp_obj_t* value, sse_lsp_obj_t* func); ase_lsp_obj_t* name, ase_lsp_obj_t* value, ase_lsp_obj_t* func);
void sse_lsp_assoc_free (sse_lsp_assoc_t* assoc); void ase_lsp_assoc_free (ase_lsp_assoc_t* assoc);
sse_lsp_frame_t* sse_lsp_frame_new (void); ase_lsp_frame_t* ase_lsp_frame_new (void);
void sse_lsp_frame_free (sse_lsp_frame_t* frame); void ase_lsp_frame_free (ase_lsp_frame_t* frame);
sse_lsp_assoc_t* sse_lsp_frame_lookup (sse_lsp_frame_t* frame, sse_lsp_obj_t* name); ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* name);
sse_lsp_assoc_t* sse_lsp_frame_insert_value ( ase_lsp_assoc_t* ase_lsp_frame_insert_value (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* value); ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* value);
sse_lsp_assoc_t* sse_lsp_frame_insert_func ( ase_lsp_assoc_t* ase_lsp_frame_insert_func (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* func); ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* func);
#ifdef __cplusplus #ifdef __cplusplus
} }

56
ase/lsp/err.c
View File

@ -1,45 +1,45 @@
/* /*
* $Id: err.c,v 1.2 2006-10-23 14:42:38 bacon Exp $ * $Id: err.c,v 1.3 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp.h> #include <ase/lsp/lsp.h>
static const sse_char_t* __errstr[] = static const ase_char_t* __errstr[] =
{ {
SSE_T("no error"), ASE_T("no error"),
SSE_T("out of memory"), ASE_T("out of memory"),
SSE_T("abort"), ASE_T("abort"),
SSE_T("end"), ASE_T("end"),
SSE_T("input not attached"), ASE_T("input not attached"),
SSE_T("input"), ASE_T("input"),
SSE_T("output not attached"), ASE_T("output not attached"),
SSE_T("output"), ASE_T("output"),
SSE_T("syntax"), ASE_T("syntax"),
SSE_T("bad arguments"), ASE_T("bad arguments"),
SSE_T("wrong arguments"), ASE_T("wrong arguments"),
SSE_T("too few arguments"), ASE_T("too few arguments"),
SSE_T("too many arguments"), ASE_T("too many arguments"),
SSE_T("undefined function"), ASE_T("undefined function"),
SSE_T("bad function"), ASE_T("bad function"),
SSE_T("duplicate formal"), ASE_T("duplicate formal"),
SSE_T("bad symbol"), ASE_T("bad symbol"),
SSE_T("undefined symbol"), ASE_T("undefined symbol"),
SSE_T("empty body"), ASE_T("empty body"),
SSE_T("bad value"), ASE_T("bad value"),
SSE_T("divide by zero") ASE_T("divide by zero")
}; };
int sse_lsp_geterrnum (sse_lsp_t* lsp) int ase_lsp_geterrnum (ase_lsp_t* lsp)
{ {
return lsp->errnum; return lsp->errnum;
} }
const sse_char_t* sse_lsp_geterrstr (int errnum) const ase_char_t* ase_lsp_geterrstr (int errnum)
{ {
if (errnum >= 0 && errnum < sse_countof(__errstr)) if (errnum >= 0 && errnum < ase_countof(__errstr))
{ {
return __errstr[errnum]; return __errstr[errnum];
} }
return SSE_T("unknown error"); return ASE_T("unknown error");
} }

262
ase/lsp/eval.c
View File

@ -1,41 +1,41 @@
/* /*
* $Id: eval.c,v 1.14 2006-10-22 13:10:45 bacon Exp $ * $Id: eval.c,v 1.15 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp.h> #include <ase/lsp/lsp.h>
#include <sse/lsp/env.h> #include <ase/lsp/env.h>
#include <sse/lsp/prim.h> #include <ase/lsp/prim.h>
#include <sse/bas/assert.h> #include <ase/bas/assert.h>
static sse_lsp_obj_t* make_func ( static ase_lsp_obj_t* make_func (
sse_lsp_t* lsp, sse_lsp_obj_t* cdr, int is_macro); ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro);
static sse_lsp_obj_t* eval_cons ( static ase_lsp_obj_t* eval_cons (
sse_lsp_t* lsp, sse_lsp_obj_t* cons); ase_lsp_t* lsp, ase_lsp_obj_t* cons);
static sse_lsp_obj_t* apply ( static ase_lsp_obj_t* apply (
sse_lsp_t* lsp, sse_lsp_obj_t* func, sse_lsp_obj_t* actual); ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual);
sse_lsp_obj_t* sse_lsp_eval (sse_lsp_t* lsp, sse_lsp_obj_t* obj) ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{ {
lsp->errnum = SSE_LSP_ERR_NONE; lsp->errnum = ASE_LSP_ERR_NONE;
if (SSE_LSP_TYPE(obj) == SSE_LSP_OBJ_CONS) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
return eval_cons (lsp, obj); return eval_cons (lsp, obj);
else if (SSE_LSP_TYPE(obj) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_SYMBOL) {
sse_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
/* /*
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) { if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
printf ("lambda or macro can't be used as a normal symbol\n"); printf ("lambda or macro can't be used as a normal symbol\n");
lsp->errnum = SSE_LSP_ERR_BAD_SYMBOL; lsp->errnum = ASE_LSP_ERR_BAD_SYMBOL;
return SSE_NULL; return ASE_NULL;
} }
*/ */
assoc = sse_lsp_lookup(lsp->mem, obj); assoc = ase_lsp_lookup(lsp->mem, obj);
if (assoc == SSE_NULL || assoc->value == SSE_NULL) { if (assoc == ASE_NULL || assoc->value == ASE_NULL) {
if (lsp->opt_undef_symbol) { if (lsp->opt_undef_symbol) {
lsp->errnum = SSE_LSP_ERR_UNDEF_SYMBOL; lsp->errnum = ASE_LSP_ERR_UNDEF_SYMBOL;
return SSE_NULL; return ASE_NULL;
} }
return lsp->mem->nil; return lsp->mem->nil;
} }
@ -46,58 +46,58 @@ sse_lsp_obj_t* sse_lsp_eval (sse_lsp_t* lsp, sse_lsp_obj_t* obj)
return obj; return obj;
} }
static sse_lsp_obj_t* make_func (sse_lsp_t* lsp, sse_lsp_obj_t* cdr, int is_macro) static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro)
{ {
sse_lsp_obj_t* func, * formal, * body, * p; ase_lsp_obj_t* func, * formal, * body, * p;
if (cdr == lsp->mem->nil) { if (cdr == lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS; lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS;
return SSE_NULL; return ASE_NULL;
} }
if (SSE_LSP_TYPE(cdr) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(cdr) != ASE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
formal = SSE_LSP_CAR(cdr); formal = ASE_LSP_CAR(cdr);
body = SSE_LSP_CDR(cdr); body = ASE_LSP_CDR(cdr);
if (body == lsp->mem->nil) { if (body == lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_EMPTY_BODY; lsp->errnum = ASE_LSP_ERR_EMPTY_BODY;
return SSE_NULL; return ASE_NULL;
} }
// TODO: more lambda expression syntax checks required???. // TODO: more lambda expression syntax checks required???.
/* check if the lambda express has non-nil value /* check if the lambda express has non-nil value
* at the terminating cdr */ * at the terminating cdr */
for (p = body; SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS; p = SSE_LSP_CDR(p)); for (p = body; ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS; p = ASE_LSP_CDR(p));
if (p != lsp->mem->nil) { if (p != lsp->mem->nil) {
/* like in (lambda (x) (+ x 10) . 4) */ /* like in (lambda (x) (+ x 10) . 4) */
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
func = (is_macro)? func = (is_macro)?
sse_lsp_make_macro (lsp->mem, formal, body): ase_lsp_make_macro (lsp->mem, formal, body):
sse_lsp_make_func (lsp->mem, formal, body); ase_lsp_make_func (lsp->mem, formal, body);
if (func == SSE_NULL) { if (func == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return func; return func;
} }
static sse_lsp_obj_t* eval_cons (sse_lsp_t* lsp, sse_lsp_obj_t* cons) static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
{ {
sse_lsp_obj_t* car, * cdr; ase_lsp_obj_t* car, * cdr;
sse_assert (SSE_LSP_TYPE(cons) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(cons) == ASE_LSP_OBJ_CONS);
car = SSE_LSP_CAR(cons); car = ASE_LSP_CAR(cons);
cdr = SSE_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);
@ -105,92 +105,92 @@ static sse_lsp_obj_t* eval_cons (sse_lsp_t* lsp, sse_lsp_obj_t* cons)
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 (SSE_LSP_TYPE(car) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_SYMBOL) {
sse_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
if ((assoc = sse_lsp_lookup(lsp->mem, car)) != SSE_NULL) { if ((assoc = ase_lsp_lookup(lsp->mem, car)) != ASE_NULL) {
//sse_lsp_obj_t* func = assoc->value; //ase_lsp_obj_t* func = assoc->value;
sse_lsp_obj_t* func = assoc->func; ase_lsp_obj_t* func = assoc->func;
if (func == SSE_NULL) { if (func == ASE_NULL) {
/* the symbol's function definition is void */ /* the symbol's function definition is void */
lsp->errnum = SSE_LSP_ERR_UNDEF_FUNC; lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
return SSE_NULL; return ASE_NULL;
} }
if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_FUNC || if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC ||
SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO) { ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) {
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
} }
else if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_PRIM) { else if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_PRIM) {
/* primitive function */ /* primitive function */
return SSE_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 = SSE_LSP_ERR_UNDEF_FUNC; lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
//TODO: better error handling. //TODO: better error handling.
//TODO: emit the name for debugging //TODO: emit the name for debugging
lsp->errnum = SSE_LSP_ERR_UNDEF_FUNC; lsp->errnum = ASE_LSP_ERR_UNDEF_FUNC;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(car) == SSE_LSP_OBJ_FUNC || else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_FUNC ||
SSE_LSP_TYPE(car) == SSE_LSP_OBJ_MACRO) { ASE_LSP_TYPE(car) == ASE_LSP_OBJ_MACRO) {
return apply (lsp, car, cdr); return apply (lsp, car, cdr);
} }
else if (SSE_LSP_TYPE(car) == SSE_LSP_OBJ_CONS) { else if (ASE_LSP_TYPE(car) == ASE_LSP_OBJ_CONS) {
if (SSE_LSP_CAR(car) == lsp->mem->lambda) { if (ASE_LSP_CAR(car) == lsp->mem->lambda) {
sse_lsp_obj_t* func = make_func (lsp, SSE_LSP_CDR(car), 0); ase_lsp_obj_t* func = make_func (lsp, ASE_LSP_CDR(car), 0);
if (func == SSE_NULL) return SSE_NULL; if (func == ASE_NULL) return ASE_NULL;
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
} }
else if (SSE_LSP_CAR(car) == lsp->mem->macro) { else if (ASE_LSP_CAR(car) == lsp->mem->macro) {
sse_lsp_obj_t* func = make_func (lsp, SSE_LSP_CDR(car), 1); ase_lsp_obj_t* func = make_func (lsp, ASE_LSP_CDR(car), 1);
if (func == SSE_NULL) return SSE_NULL; if (func == ASE_NULL) return ASE_NULL;
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
} }
} }
//TODO: emit the name for debugging //TODO: emit the name for debugging
lsp->errnum = SSE_LSP_ERR_BAD_FUNC; lsp->errnum = ASE_LSP_ERR_BAD_FUNC;
return SSE_NULL; return ASE_NULL;
} }
static sse_lsp_obj_t* apply ( static ase_lsp_obj_t* apply (
sse_lsp_t* lsp, sse_lsp_obj_t* func, sse_lsp_obj_t* actual) ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual)
{ {
sse_lsp_frame_t* frame; ase_lsp_frame_t* frame;
sse_lsp_obj_t* formal; ase_lsp_obj_t* formal;
sse_lsp_obj_t* body; ase_lsp_obj_t* body;
sse_lsp_obj_t* value; ase_lsp_obj_t* value;
sse_lsp_mem_t* mem; ase_lsp_mem_t* mem;
sse_assert ( ase_assert (
SSE_LSP_TYPE(func) == SSE_LSP_OBJ_FUNC || ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC ||
SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO); ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO);
sse_assert (SSE_LSP_TYPE(SSE_LSP_CDR(func)) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(ASE_LSP_CDR(func)) == ASE_LSP_OBJ_CONS);
mem = lsp->mem; mem = lsp->mem;
if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO) { if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) {
formal = SSE_LSP_MFORMAL (func); formal = ASE_LSP_MFORMAL (func);
body = SSE_LSP_MBODY (func); body = ASE_LSP_MBODY (func);
} }
else { else {
formal = SSE_LSP_FFORMAL (func); formal = ASE_LSP_FFORMAL (func);
body = SSE_LSP_FBODY (func); body = ASE_LSP_FBODY (func);
} }
// make a new frame. // make a new frame.
frame = sse_lsp_frame_new (); frame = ase_lsp_frame_new ();
if (frame == SSE_NULL) { if (frame == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
// attach it to the brooding frame list to // attach it to the brooding frame list to
@ -201,56 +201,56 @@ static sse_lsp_obj_t* apply (
// evaluate arguments and push them into the frame. // evaluate arguments and push them into the frame.
while (formal != mem->nil) { while (formal != mem->nil) {
if (actual == mem->nil) { if (actual == mem->nil) {
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS; lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
value = SSE_LSP_CAR(actual); value = ASE_LSP_CAR(actual);
if (SSE_LSP_TYPE(func) != SSE_LSP_OBJ_MACRO) { if (ASE_LSP_TYPE(func) != ASE_LSP_OBJ_MACRO) {
// macro doesn't evaluate actual arguments. // macro doesn't evaluate actual arguments.
value = sse_lsp_eval (lsp, value); value = ase_lsp_eval (lsp, value);
if (value == SSE_NULL) { if (value == ASE_NULL) {
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
} }
if (sse_lsp_frame_lookup ( if (ase_lsp_frame_lookup (
frame, SSE_LSP_CAR(formal)) != SSE_NULL) { frame, ASE_LSP_CAR(formal)) != ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_DUP_FORMAL; lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
if (sse_lsp_frame_insert_value ( if (ase_lsp_frame_insert_value (
frame, SSE_LSP_CAR(formal), value) == SSE_NULL) { frame, ASE_LSP_CAR(formal), value) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
actual = SSE_LSP_CDR(actual); actual = ASE_LSP_CDR(actual);
formal = SSE_LSP_CDR(formal); formal = ASE_LSP_CDR(formal);
} }
if (SSE_LSP_TYPE(actual) == SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS; lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
else if (actual != mem->nil) { else if (actual != mem->nil) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
// push the frame // push the frame
@ -261,25 +261,25 @@ static sse_lsp_obj_t* apply (
// do the evaluation of the body // do the evaluation of the body
value = mem->nil; value = mem->nil;
while (body != mem->nil) { while (body != mem->nil) {
value = sse_lsp_eval(lsp, SSE_LSP_CAR(body)); value = ase_lsp_eval(lsp, ASE_LSP_CAR(body));
if (value == SSE_NULL) { if (value == ASE_NULL) {
mem->frame = frame->link; mem->frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
// pop the frame. // pop the frame.
mem->frame = frame->link; mem->frame = frame->link;
// destroy the frame. // destroy the frame.
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
//if (SSE_LSP_CAR(func) == mem->macro) { //if (ASE_LSP_CAR(func) == mem->macro) {
if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO) { if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) {
value = sse_lsp_eval(lsp, value); value = ase_lsp_eval(lsp, value);
if (value == SSE_NULL) return SSE_NULL; if (value == ASE_NULL) return ASE_NULL;
} }
return value; return value;

220
ase/lsp/lsp.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: lsp.c,v 1.6 2006-10-23 14:44:43 bacon Exp $ * $Id: lsp.c,v 1.7 2006-10-24 04:22:39 bacon Exp $
*/ */
#if defined(__BORLANDC__) #if defined(__BORLANDC__)
@ -7,87 +7,87 @@
#define Library #define Library
#endif #endif
#include <sse/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
static int __add_builtin_prims (sse_lsp_t* lsp); static int __add_builtin_prims (ase_lsp_t* lsp);
sse_lsp_t* sse_lsp_open ( ase_lsp_t* ase_lsp_open (
const sse_lsp_syscas_t* syscas, const ase_lsp_syscas_t* syscas,
sse_size_t mem_ubound, sse_size_t mem_ubound_inc) ase_size_t mem_ubound, ase_size_t mem_ubound_inc)
{ {
sse_lsp_t* lsp; ase_lsp_t* lsp;
if (syscas == SSE_NULL) return SSE_NULL; if (syscas == ASE_NULL) return ASE_NULL;
if (syscas->malloc == SSE_NULL || if (syscas->malloc == ASE_NULL ||
syscas->free == SSE_NULL) return SSE_NULL; syscas->free == ASE_NULL) return ASE_NULL;
if (syscas->is_upper == SSE_NULL || if (syscas->is_upper == ASE_NULL ||
syscas->is_lower == SSE_NULL || syscas->is_lower == ASE_NULL ||
syscas->is_alpha == SSE_NULL || syscas->is_alpha == ASE_NULL ||
syscas->is_digit == SSE_NULL || syscas->is_digit == ASE_NULL ||
syscas->is_xdigit == SSE_NULL || syscas->is_xdigit == ASE_NULL ||
syscas->is_alnum == SSE_NULL || syscas->is_alnum == ASE_NULL ||
syscas->is_space == SSE_NULL || syscas->is_space == ASE_NULL ||
syscas->is_print == SSE_NULL || syscas->is_print == ASE_NULL ||
syscas->is_graph == SSE_NULL || syscas->is_graph == ASE_NULL ||
syscas->is_cntrl == SSE_NULL || syscas->is_cntrl == ASE_NULL ||
syscas->is_punct == SSE_NULL || syscas->is_punct == ASE_NULL ||
syscas->to_upper == SSE_NULL || syscas->to_upper == ASE_NULL ||
syscas->to_lower == SSE_NULL) return SSE_NULL; syscas->to_lower == ASE_NULL) return ASE_NULL;
if (syscas->sprintf == SSE_NULL || if (syscas->sprintf == ASE_NULL ||
syscas->dprintf == SSE_NULL || syscas->dprintf == ASE_NULL ||
syscas->abort == SSE_NULL) return SSE_NULL; syscas->abort == ASE_NULL) return ASE_NULL;
#if defined(_WIN32) && defined(_DEBUG) #if defined(_WIN32) && defined(_DEBUG)
lsp = (sse_lsp_t*) malloc (sse_sizeof(sse_lsp_t)); lsp = (ase_lsp_t*) malloc (ase_sizeof(ase_lsp_t));
#else #else
lsp = (sse_lsp_t*) syscas->malloc ( lsp = (ase_lsp_t*) syscas->malloc (
sse_sizeof(sse_lsp_t), syscas->custom_data); ase_sizeof(ase_lsp_t), syscas->custom_data);
#endif #endif
if (lsp == SSE_NULL) return SSE_NULL; if (lsp == ASE_NULL) return ASE_NULL;
/* it uses the built-in sse_lsp_memset because lsp is not /* it uses the built-in ase_lsp_memset because lsp is not
* fully initialized yet */ * fully initialized yet */
sse_lsp_memset (lsp, 0, sse_sizeof(sse_lsp_t)); ase_lsp_memset (lsp, 0, ase_sizeof(ase_lsp_t));
if (syscas->memcpy == SSE_NULL) if (syscas->memcpy == ASE_NULL)
{ {
sse_lsp_memcpy (&lsp->syscas, syscas, sse_sizeof(lsp->syscas)); ase_lsp_memcpy (&lsp->syscas, syscas, ase_sizeof(lsp->syscas));
lsp->syscas.memcpy = sse_lsp_memcpy; lsp->syscas.memcpy = ase_lsp_memcpy;
} }
else syscas->memcpy (&lsp->syscas, syscas, sse_sizeof(lsp->syscas)); else syscas->memcpy (&lsp->syscas, syscas, ase_sizeof(lsp->syscas));
if (syscas->memset == SSE_NULL) lsp->syscas.memset = sse_lsp_memset; if (syscas->memset == ASE_NULL) lsp->syscas.memset = ase_lsp_memset;
if (sse_lsp_token_open(&lsp->token, 0) == SSE_NULL) if (ase_lsp_token_open(&lsp->token, 0) == ASE_NULL)
{ {
if (lsp->__dynamic) SSE_LSP_FREE (lsp, lsp); if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp);
return SSE_NULL; return ASE_NULL;
} }
lsp->errnum = SSE_LSP_ENOERR; lsp->errnum = ASE_LSP_ENOERR;
lsp->opt_undef_symbol = 1; lsp->opt_undef_symbol = 1;
//lsp->opt_undef_symbol = 0; //lsp->opt_undef_symbol = 0;
lsp->curc = SSE_CHAR_EOF; lsp->curc = ASE_CHAR_EOF;
lsp->input_func = SSE_NULL; lsp->input_func = ASE_NULL;
lsp->output_func = SSE_NULL; lsp->output_func = ASE_NULL;
lsp->input_arg = SSE_NULL; lsp->input_arg = ASE_NULL;
lsp->output_arg = SSE_NULL; lsp->output_arg = ASE_NULL;
lsp->mem = sse_lsp_mem_new (mem_ubound, mem_ubound_inc); lsp->mem = ase_lsp_mem_new (mem_ubound, mem_ubound_inc);
if (lsp->mem == SSE_NULL) { if (lsp->mem == ASE_NULL) {
sse_lsp_token_close (&lsp->token); ase_lsp_token_close (&lsp->token);
if (lsp->__dynamic) SSE_LSP_FREE (lsp, lsp); if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp);
return SSE_NULL; return ASE_NULL;
} }
if (__add_builtin_prims(lsp) == -1) { if (__add_builtin_prims(lsp) == -1) {
sse_lsp_mem_free (lsp->mem); ase_lsp_mem_free (lsp->mem);
sse_lsp_token_close (&lsp->token); ase_lsp_token_close (&lsp->token);
if (lsp->__dynamic) SSE_LSP_FREE (lsp, lsp); if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp);
return SSE_NULL; return ASE_NULL;
} }
lsp->max_eval_depth = 0; // TODO: put restriction here.... lsp->max_eval_depth = 0; // TODO: put restriction here....
@ -96,52 +96,52 @@ sse_lsp_t* sse_lsp_open (
return lsp; return lsp;
} }
void sse_lsp_close (sse_lsp_t* lsp) void ase_lsp_close (ase_lsp_t* lsp)
{ {
sse_lsp_mem_free (lsp->mem); ase_lsp_mem_free (lsp->mem);
sse_lsp_token_close (&lsp->token); ase_lsp_token_close (&lsp->token);
if (lsp->__dynamic) SSE_LSP_FREE (lsp, lsp); if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp);
} }
int sse_lsp_attach_input (sse_lsp_t* lsp, sse_lsp_io_t input, void* arg) int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg)
{ {
if (sse_lsp_detach_input(lsp) == -1) return -1; if (ase_lsp_detach_input(lsp) == -1) return -1;
sse_lsp_assert (lsp, lsp->input_func == SSE_NULL); ase_lsp_assert (lsp, lsp->input_func == ASE_NULL);
if (input(SSE_LSP_IO_OPEN, arg, SSE_NULL, 0) == -1) { if (input(ASE_LSP_IO_OPEN, arg, ASE_NULL, 0) == -1) {
/* TODO: set error number */ /* TODO: set error number */
return -1; return -1;
} }
lsp->input_func = input; lsp->input_func = input;
lsp->input_arg = arg; lsp->input_arg = arg;
lsp->curc = SSE_CHAR_EOF; lsp->curc = ASE_CHAR_EOF;
return 0; return 0;
} }
int sse_lsp_detach_input (sse_lsp_t* lsp) int ase_lsp_detach_input (ase_lsp_t* lsp)
{ {
if (lsp->input_func != SSE_NULL) { if (lsp->input_func != ASE_NULL) {
if (lsp->input_func(SSE_LSP_IO_CLOSE, lsp->input_arg, SSE_NULL, 0) == -1) { if (lsp->input_func(ASE_LSP_IO_CLOSE, lsp->input_arg, ASE_NULL, 0) == -1) {
/* TODO: set error number */ /* TODO: set error number */
return -1; return -1;
} }
lsp->input_func = SSE_NULL; lsp->input_func = ASE_NULL;
lsp->input_arg = SSE_NULL; lsp->input_arg = ASE_NULL;
lsp->curc = SSE_CHAR_EOF; lsp->curc = ASE_CHAR_EOF;
} }
return 0; return 0;
} }
int sse_lsp_attach_output (sse_lsp_t* lsp, sse_lsp_io_t output, void* arg) int ase_lsp_attach_output (ase_lsp_t* lsp, ase_lsp_io_t output, void* arg)
{ {
if (sse_lsp_detach_output(lsp) == -1) return -1; if (ase_lsp_detach_output(lsp) == -1) return -1;
sse_lsp_assert (lsp, lsp->output_func == SSE_NULL); ase_lsp_assert (lsp, lsp->output_func == ASE_NULL);
if (output(SSE_LSP_IO_OPEN, arg, SSE_NULL, 0) == -1) { if (output(ASE_LSP_IO_OPEN, arg, ASE_NULL, 0) == -1) {
/* TODO: set error number */ /* TODO: set error number */
return -1; return -1;
} }
@ -150,59 +150,59 @@ int sse_lsp_attach_output (sse_lsp_t* lsp, sse_lsp_io_t output, void* arg)
return 0; return 0;
} }
int sse_lsp_detach_output (sse_lsp_t* lsp) int ase_lsp_detach_output (ase_lsp_t* lsp)
{ {
if (lsp->output_func != SSE_NULL) { if (lsp->output_func != ASE_NULL) {
if (lsp->output_func(SSE_LSP_IO_CLOSE, lsp->output_arg, SSE_NULL, 0) == -1) { if (lsp->output_func(ASE_LSP_IO_CLOSE, lsp->output_arg, ASE_NULL, 0) == -1) {
/* TODO: set error number */ /* TODO: set error number */
return -1; return -1;
} }
lsp->output_func = SSE_NULL; lsp->output_func = ASE_NULL;
lsp->output_arg = SSE_NULL; lsp->output_arg = ASE_NULL;
} }
return 0; return 0;
} }
static int __add_builtin_prims (sse_lsp_t* lsp) static int __add_builtin_prims (ase_lsp_t* lsp)
{ {
#define ADD_PRIM(mem,name,prim) \ #define ADD_PRIM(mem,name,prim) \
if (sse_lsp_add_prim(mem,name,prim) == -1) return -1; if (ase_lsp_add_prim(mem,name,prim) == -1) return -1;
ADD_PRIM (lsp, SSE_T("abort"), sse_lsp_prim_abort); ADD_PRIM (lsp, ASE_T("abort"), ase_lsp_prim_abort);
ADD_PRIM (lsp, SSE_T("eval"), sse_lsp_prim_eval); ADD_PRIM (lsp, ASE_T("eval"), ase_lsp_prim_eval);
ADD_PRIM (lsp, SSE_T("prog1"), sse_lsp_prim_prog1); ADD_PRIM (lsp, ASE_T("prog1"), ase_lsp_prim_prog1);
ADD_PRIM (lsp, SSE_T("progn"), sse_lsp_prim_progn); ADD_PRIM (lsp, ASE_T("progn"), ase_lsp_prim_progn);
ADD_PRIM (lsp, SSE_T("gc"), sse_lsp_prim_gc); ADD_PRIM (lsp, ASE_T("gc"), ase_lsp_prim_gc);
ADD_PRIM (lsp, SSE_T("cond"), sse_lsp_prim_cond); ADD_PRIM (lsp, ASE_T("cond"), ase_lsp_prim_cond);
ADD_PRIM (lsp, SSE_T("if"), sse_lsp_prim_if); ADD_PRIM (lsp, ASE_T("if"), ase_lsp_prim_if);
ADD_PRIM (lsp, SSE_T("while"), sse_lsp_prim_while); ADD_PRIM (lsp, ASE_T("while"), ase_lsp_prim_while);
ADD_PRIM (lsp, SSE_T("car"), sse_lsp_prim_car); ADD_PRIM (lsp, ASE_T("car"), ase_lsp_prim_car);
ADD_PRIM (lsp, SSE_T("cdr"), sse_lsp_prim_cdr); ADD_PRIM (lsp, ASE_T("cdr"), ase_lsp_prim_cdr);
ADD_PRIM (lsp, SSE_T("cons"), sse_lsp_prim_cons); ADD_PRIM (lsp, ASE_T("cons"), ase_lsp_prim_cons);
ADD_PRIM (lsp, SSE_T("set"), sse_lsp_prim_set); ADD_PRIM (lsp, ASE_T("set"), ase_lsp_prim_set);
ADD_PRIM (lsp, SSE_T("setq"), sse_lsp_prim_setq); ADD_PRIM (lsp, ASE_T("setq"), ase_lsp_prim_setq);
ADD_PRIM (lsp, SSE_T("quote"), sse_lsp_prim_quote); ADD_PRIM (lsp, ASE_T("quote"), ase_lsp_prim_quote);
ADD_PRIM (lsp, SSE_T("defun"), sse_lsp_prim_defun); ADD_PRIM (lsp, ASE_T("defun"), ase_lsp_prim_defun);
ADD_PRIM (lsp, SSE_T("demac"), sse_lsp_prim_demac); ADD_PRIM (lsp, ASE_T("demac"), ase_lsp_prim_demac);
ADD_PRIM (lsp, SSE_T("let"), sse_lsp_prim_let); ADD_PRIM (lsp, ASE_T("let"), ase_lsp_prim_let);
ADD_PRIM (lsp, SSE_T("let*"), sse_lsp_prim_letx); ADD_PRIM (lsp, ASE_T("let*"), ase_lsp_prim_letx);
ADD_PRIM (lsp, SSE_T("="), sse_lsp_prim_eq); ADD_PRIM (lsp, ASE_T("="), ase_lsp_prim_eq);
ADD_PRIM (lsp, SSE_T("/="), sse_lsp_prim_ne); ADD_PRIM (lsp, ASE_T("/="), ase_lsp_prim_ne);
ADD_PRIM (lsp, SSE_T(">"), sse_lsp_prim_gt); ADD_PRIM (lsp, ASE_T(">"), ase_lsp_prim_gt);
ADD_PRIM (lsp, SSE_T("<"), sse_lsp_prim_lt); ADD_PRIM (lsp, ASE_T("<"), ase_lsp_prim_lt);
ADD_PRIM (lsp, SSE_T(">="), sse_lsp_prim_ge); ADD_PRIM (lsp, ASE_T(">="), ase_lsp_prim_ge);
ADD_PRIM (lsp, SSE_T("<="), sse_lsp_prim_le); ADD_PRIM (lsp, ASE_T("<="), ase_lsp_prim_le);
ADD_PRIM (lsp, SSE_T("+"), sse_lsp_prim_plus); ADD_PRIM (lsp, ASE_T("+"), ase_lsp_prim_plus);
ADD_PRIM (lsp, SSE_T("-"), sse_lsp_prim_minus); ADD_PRIM (lsp, ASE_T("-"), ase_lsp_prim_minus);
ADD_PRIM (lsp, SSE_T("*"), sse_lsp_prim_multiply); ADD_PRIM (lsp, ASE_T("*"), ase_lsp_prim_multiply);
ADD_PRIM (lsp, SSE_T("/"), sse_lsp_prim_divide); ADD_PRIM (lsp, ASE_T("/"), ase_lsp_prim_divide);
ADD_PRIM (lsp, SSE_T("%"), sse_lsp_prim_modulus); ADD_PRIM (lsp, ASE_T("%"), ase_lsp_prim_modulus);
return 0; return 0;
} }

142
ase/lsp/lsp.h
View File

@ -1,47 +1,47 @@
/* /*
* $Id: lsp.h,v 1.24 2006-10-23 14:57:44 bacon Exp $ * $Id: lsp.h,v 1.25 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_LSP_H_ #ifndef _ASE_LSP_LSP_H_
#define _SSE_LSP_LSP_H_ #define _ASE_LSP_LSP_H_
#include <sse/lsp/types.h> #include <ase/lsp/types.h>
typedef struct sse_lsp_t sse_lsp_t; typedef struct ase_lsp_t ase_lsp_t;
typedef struct sse_lsp_obj_t sse_lsp_obj_t; typedef struct ase_lsp_obj_t ase_lsp_obj_t;
typedef struct sse_lsp_syscas_t sse_lsp_syscas_t; typedef struct ase_lsp_syscas_t ase_lsp_syscas_t;
typedef sse_ssize_t (*sse_lsp_io_t) ( typedef ase_ssize_t (*ase_lsp_io_t) (
int cmd, void* arg, sse_char_t* data, sse_size_t count); int cmd, void* arg, ase_char_t* data, ase_size_t count);
struct sse_lsp_syscas_t struct ase_lsp_syscas_t
{ {
/* memory */ /* memory */
void* (*malloc) (sse_size_t n, void* custom_data); void* (*malloc) (ase_size_t n, void* custom_data);
void* (*realloc) (void* ptr, sse_size_t n, void* custom_data); void* (*realloc) (void* ptr, ase_size_t n, void* custom_data);
void (*free) (void* ptr, void* custom_data); void (*free) (void* ptr, void* custom_data);
/* character class */ /* character class */
sse_bool_t (*is_upper) (sse_cint_t c); ase_bool_t (*is_upper) (ase_cint_t c);
sse_bool_t (*is_lower) (sse_cint_t c); ase_bool_t (*is_lower) (ase_cint_t c);
sse_bool_t (*is_alpha) (sse_cint_t c); ase_bool_t (*is_alpha) (ase_cint_t c);
sse_bool_t (*is_digit) (sse_cint_t c); ase_bool_t (*is_digit) (ase_cint_t c);
sse_bool_t (*is_xdigit) (sse_cint_t c); ase_bool_t (*is_xdigit) (ase_cint_t c);
sse_bool_t (*is_alnum) (sse_cint_t c); ase_bool_t (*is_alnum) (ase_cint_t c);
sse_bool_t (*is_space) (sse_cint_t c); ase_bool_t (*is_space) (ase_cint_t c);
sse_bool_t (*is_print) (sse_cint_t c); ase_bool_t (*is_print) (ase_cint_t c);
sse_bool_t (*is_graph) (sse_cint_t c); ase_bool_t (*is_graph) (ase_cint_t c);
sse_bool_t (*is_cntrl) (sse_cint_t c); ase_bool_t (*is_cntrl) (ase_cint_t c);
sse_bool_t (*is_punct) (sse_cint_t c); ase_bool_t (*is_punct) (ase_cint_t c);
sse_cint_t (*to_upper) (sse_cint_t c); ase_cint_t (*to_upper) (ase_cint_t c);
sse_cint_t (*to_lower) (sse_cint_t c); ase_cint_t (*to_lower) (ase_cint_t c);
/* utilities */ /* utilities */
void* (*memcpy) (void* dst, const void* src, sse_size_t n); void* (*memcpy) (void* dst, const void* src, ase_size_t n);
void* (*memset) (void* dst, int val, sse_size_t n); void* (*memset) (void* dst, int val, ase_size_t n);
int (*sprintf) (sse_char_t* buf, sse_size_t size, sse_char_t* fmt, ...); int (*sprintf) (ase_char_t* buf, ase_size_t size, ase_char_t* fmt, ...);
int (*dprintf) (sse_char_t* fmt, ...); int (*dprintf) (ase_char_t* fmt, ...);
void (*abort) (void); void (*abort) (void);
void* custom_data; void* custom_data;
@ -50,75 +50,75 @@ struct sse_lsp_syscas_t
/* io function commands */ /* io function commands */
enum enum
{ {
SSE_LSP_IO_OPEN = 0, ASE_LSP_IO_OPEN = 0,
SSE_LSP_IO_CLOSE = 1, ASE_LSP_IO_CLOSE = 1,
SSE_LSP_IO_READ = 2, ASE_LSP_IO_READ = 2,
SSE_LSP_IO_WRITE = 3 ASE_LSP_IO_WRITE = 3
}; };
/* option code */ /* option code */
enum enum
{ {
SSE_LSP_UNDEFSYMBOL = (1 << 0) ASE_LSP_UNDEFSYMBOL = (1 << 0)
}; };
/* error code */ /* error code */
enum enum
{ {
SSE_LSP_ENOERR, ASE_LSP_ENOERR,
SSE_LSP_ENOMEM, ASE_LSP_ENOMEM,
SSE_LSP_ERR_ABORT, ASE_LSP_ERR_ABORT,
SSE_LSP_ERR_END, ASE_LSP_ERR_END,
SSE_LSP_ERR_INPUT_NOT_ATTACHED, ASE_LSP_ERR_INPUT_NOT_ATTACHED,
SSE_LSP_ERR_INPUT, ASE_LSP_ERR_INPUT,
SSE_LSP_ERR_OUTPUT_NOT_ATTACHED, ASE_LSP_ERR_OUTPUT_NOT_ATTACHED,
SSE_LSP_ERR_OUTPUT, ASE_LSP_ERR_OUTPUT,
SSE_LSP_ERR_SYNTAX, ASE_LSP_ERR_SYNTAX,
SSE_LSP_ERR_BAD_ARG, ASE_LSP_ERR_BAD_ARG,
SSE_LSP_ERR_WRONG_ARG, ASE_LSP_ERR_WRONG_ARG,
SSE_LSP_ERR_TOO_FEW_ARGS, ASE_LSP_ERR_TOO_FEW_ARGS,
SSE_LSP_ERR_TOO_MANY_ARGS, ASE_LSP_ERR_TOO_MANY_ARGS,
SSE_LSP_ERR_UNDEF_FUNC, ASE_LSP_ERR_UNDEF_FUNC,
SSE_LSP_ERR_BAD_FUNC, ASE_LSP_ERR_BAD_FUNC,
SSE_LSP_ERR_DUP_FORMAL, ASE_LSP_ERR_DUP_FORMAL,
SSE_LSP_ERR_BAD_SYMBOL, ASE_LSP_ERR_BAD_SYMBOL,
SSE_LSP_ERR_UNDEF_SYMBOL, ASE_LSP_ERR_UNDEF_SYMBOL,
SSE_LSP_ERR_EMPTY_BODY, ASE_LSP_ERR_EMPTY_BODY,
SSE_LSP_ERR_BAD_VALUE, ASE_LSP_ERR_BAD_VALUE,
SSE_LSP_EDIVBYZERO ASE_LSP_EDIVBYZERO
}; };
typedef sse_lsp_obj_t* (*sse_lsp_prim_t) (sse_lsp_t* lsp, sse_lsp_obj_t* obj); typedef ase_lsp_obj_t* (*ase_lsp_prim_t) (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_t* sse_lsp_open ( ase_lsp_t* ase_lsp_open (
const sse_lsp_syscas_t* syscas, const ase_lsp_syscas_t* syscas,
sse_size_t mem_ubound, sse_size_t mem_ubound_inc); ase_size_t mem_ubound, ase_size_t mem_ubound_inc);
void sse_lsp_close (sse_lsp_t* lsp); void ase_lsp_close (ase_lsp_t* lsp);
int sse_lsp_geterrnum (sse_lsp_t* lsp); int ase_lsp_geterrnum (ase_lsp_t* lsp);
int sse_lsp_attach_input (sse_lsp_t* lsp, sse_lsp_io_t input, void* arg); int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg);
int sse_lsp_detach_input (sse_lsp_t* lsp); int ase_lsp_detach_input (ase_lsp_t* lsp);
int sse_lsp_attach_output (sse_lsp_t* lsp, sse_lsp_io_t output, void* arg); int ase_lsp_attach_output (ase_lsp_t* lsp, ase_lsp_io_t output, void* arg);
int sse_lsp_detach_output (sse_lsp_t* lsp); int ase_lsp_detach_output (ase_lsp_t* lsp);
sse_lsp_obj_t* sse_lsp_read (sse_lsp_t* lsp); ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp);
sse_lsp_obj_t* sse_lsp_eval (sse_lsp_t* lsp, sse_lsp_obj_t* obj); ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
int sse_lsp_print (sse_lsp_t* lsp, const sse_lsp_obj_t* obj); int ase_lsp_print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj);
int sse_lsp_add_prim (sse_lsp_t* lsp, const sse_char_t* name, sse_lsp_prim_t prim); int ase_lsp_add_prim (ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim);
int sse_lsp_remove_prim (sse_lsp_t* lsp, const sse_char_t* name); int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name);
const sse_char_t* sse_lsp_geterrstr (int errnum); const ase_char_t* ase_lsp_geterrstr (int errnum);
#ifdef __cplusplus #ifdef __cplusplus
} }

636
ase/lsp/mem.c
View File

File diff suppressed because it is too large Load Diff

130
ase/lsp/mem.h
View File

@ -1,111 +1,111 @@
/* /*
* $Id: mem.h,v 1.8 2006-10-23 14:42:38 bacon Exp $ * $Id: mem.h,v 1.9 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_MEM_H_ #ifndef _ASE_LSP_MEM_H_
#define _SSE_LSP_MEM_H_ #define _ASE_LSP_MEM_H_
#include <sse/lsp/obj.h> #include <ase/lsp/obj.h>
#include <sse/lsp/env.h> #include <ase/lsp/env.h>
#include <sse/lsp/array.h> #include <ase/lsp/array.h>
struct sse_lsp_mem_t struct ase_lsp_mem_t
{ {
/* /*
* object allocation list * object allocation list
*/ */
sse_size_t ubound; // upper bounds of the maximum number of objects ase_size_t ubound; // upper bounds of the maximum number of objects
sse_size_t ubound_inc; // increment of the upper bounds ase_size_t ubound_inc; // increment of the upper bounds
sse_size_t count; // the number of objects currently allocated ase_size_t count; // the number of objects currently allocated
sse_lsp_obj_t* used[SSE_LSP_TYPE_COUNT]; ase_lsp_obj_t* used[ASE_LSP_TYPE_COUNT];
sse_lsp_obj_t* free[SSE_LSP_TYPE_COUNT]; ase_lsp_obj_t* free[ASE_LSP_TYPE_COUNT];
sse_lsp_obj_t* locked; ase_lsp_obj_t* locked;
/* /*
* commonly accessed objects * commonly accessed objects
*/ */
sse_lsp_obj_t* nil; // sse_lsp_obj_nil_t ase_lsp_obj_t* nil; // ase_lsp_obj_nil_t
sse_lsp_obj_t* t; // sse_lsp_obj_true_t ase_lsp_obj_t* t; // ase_lsp_obj_true_t
sse_lsp_obj_t* quote; // sse_lsp_obj_symbol_t ase_lsp_obj_t* quote; // ase_lsp_obj_symbol_t
sse_lsp_obj_t* lambda; // sse_lsp_obj_symbol_t ase_lsp_obj_t* lambda; // ase_lsp_obj_symbol_t
sse_lsp_obj_t* macro; // sse_lsp_obj_symbol_t ase_lsp_obj_t* macro; // ase_lsp_obj_symbol_t
/* /*
* run-time environment frame * run-time environment frame
*/ */
sse_lsp_frame_t* frame; ase_lsp_frame_t* frame;
// pointer to a global-level frame // pointer to a global-level frame
sse_lsp_frame_t* root_frame; ase_lsp_frame_t* root_frame;
// pointer to an interim frame not yet added to "frame" // pointer to an interim frame not yet added to "frame"
sse_lsp_frame_t* brooding_frame; ase_lsp_frame_t* brooding_frame;
/* /*
* temporary objects * temporary objects
*/ */
sse_lsp_array_t* temp_array; ase_lsp_array_t* temp_array;
}; };
typedef struct sse_lsp_mem_t sse_lsp_mem_t; typedef struct ase_lsp_mem_t ase_lsp_mem_t;
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_mem_t* sse_lsp_mem_new (sse_size_t ubound, sse_size_t ubound_inc); ase_lsp_mem_t* ase_lsp_mem_new (ase_size_t ubound, ase_size_t ubound_inc);
void sse_lsp_mem_free (sse_lsp_mem_t* mem); void ase_lsp_mem_free (ase_lsp_mem_t* mem);
int sse_lsp_add_builtin_prims (sse_lsp_mem_t* mem); int ase_lsp_add_builtin_prims (ase_lsp_mem_t* mem);
sse_lsp_obj_t* sse_lsp_alloc (sse_lsp_mem_t* mem, int type, sse_size_t size); ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size);
void sse_lsp_dispose (sse_lsp_mem_t* mem, sse_lsp_obj_t* prev, sse_lsp_obj_t* obj); void ase_lsp_dispose (ase_lsp_mem_t* mem, ase_lsp_obj_t* prev, ase_lsp_obj_t* obj);
void sse_lsp_dispose_all (sse_lsp_mem_t* mem); void ase_lsp_dispose_all (ase_lsp_mem_t* mem);
void sse_lsp_garbage_collect (sse_lsp_mem_t* mem); void ase_lsp_garbage_collect (ase_lsp_mem_t* mem);
void sse_lsp_lock (sse_lsp_obj_t* obj); void ase_lsp_lock (ase_lsp_obj_t* obj);
void sse_lsp_unlock (sse_lsp_obj_t* obj); void ase_lsp_unlock (ase_lsp_obj_t* obj);
void sse_lsp_unlock_all (sse_lsp_obj_t* obj); void ase_lsp_unlock_all (ase_lsp_obj_t* obj);
// object creation of standard types // object creation of standard types
sse_lsp_obj_t* sse_lsp_make_nil (sse_lsp_mem_t* mem); ase_lsp_obj_t* ase_lsp_make_nil (ase_lsp_mem_t* mem);
sse_lsp_obj_t* sse_lsp_make_true (sse_lsp_mem_t* mem); ase_lsp_obj_t* ase_lsp_make_true (ase_lsp_mem_t* mem);
sse_lsp_obj_t* sse_lsp_make_int (sse_lsp_mem_t* mem, sse_lsp_int_t value); ase_lsp_obj_t* ase_lsp_make_int (ase_lsp_mem_t* mem, ase_lsp_int_t value);
sse_lsp_obj_t* sse_lsp_make_real (sse_lsp_mem_t* mem, sse_lsp_real_t value); ase_lsp_obj_t* ase_lsp_make_real (ase_lsp_mem_t* mem, ase_lsp_real_t value);
sse_lsp_obj_t* sse_lsp_make_symbol ( ase_lsp_obj_t* ase_lsp_make_symbol (
sse_lsp_mem_t* mem, const sse_char_t* str); ase_lsp_mem_t* mem, const ase_char_t* str);
sse_lsp_obj_t* sse_lsp_make_symbolx ( ase_lsp_obj_t* ase_lsp_make_symbolx (
sse_lsp_mem_t* mem, const sse_char_t* str, sse_size_t len); ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
sse_lsp_obj_t* sse_lsp_make_string ( ase_lsp_obj_t* ase_lsp_make_string (
sse_lsp_mem_t* mem, const sse_char_t* str); ase_lsp_mem_t* mem, const ase_char_t* str);
sse_lsp_obj_t* sse_lsp_make_stringx ( ase_lsp_obj_t* ase_lsp_make_stringx (
sse_lsp_mem_t* mem, const sse_char_t* str, sse_size_t len); ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
sse_lsp_obj_t* sse_lsp_make_cons ( ase_lsp_obj_t* ase_lsp_make_cons (
sse_lsp_mem_t* mem, sse_lsp_obj_t* car, sse_lsp_obj_t* cdr); ase_lsp_mem_t* mem, ase_lsp_obj_t* car, ase_lsp_obj_t* cdr);
sse_lsp_obj_t* sse_lsp_make_func ( ase_lsp_obj_t* ase_lsp_make_func (
sse_lsp_mem_t* mem, sse_lsp_obj_t* formal, sse_lsp_obj_t* body); ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body);
sse_lsp_obj_t* sse_lsp_make_macro ( ase_lsp_obj_t* ase_lsp_make_macro (
sse_lsp_mem_t* mem, sse_lsp_obj_t* formal, sse_lsp_obj_t* body); ase_lsp_mem_t* mem, ase_lsp_obj_t* formal, ase_lsp_obj_t* body);
sse_lsp_obj_t* sse_lsp_make_prim (sse_lsp_mem_t* mem, void* impl); ase_lsp_obj_t* ase_lsp_make_prim (ase_lsp_mem_t* mem, void* impl);
// frame lookup // frame lookup
sse_lsp_assoc_t* sse_lsp_lookup (sse_lsp_mem_t* mem, sse_lsp_obj_t* name); ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name);
sse_lsp_assoc_t* sse_lsp_set_value ( ase_lsp_assoc_t* ase_lsp_set_value (
sse_lsp_mem_t* mem, sse_lsp_obj_t* name, sse_lsp_obj_t* value); ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* value);
sse_lsp_assoc_t* sse_lsp_set_func ( ase_lsp_assoc_t* ase_lsp_set_func (
sse_lsp_mem_t* mem, sse_lsp_obj_t* name, sse_lsp_obj_t* func); ase_lsp_mem_t* mem, ase_lsp_obj_t* name, ase_lsp_obj_t* func);
// cons operations // cons operations
sse_size_t sse_lsp_cons_len (sse_lsp_mem_t* mem, sse_lsp_obj_t* obj); ase_size_t ase_lsp_cons_len (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj);
int sse_lsp_probe_args (sse_lsp_mem_t* mem, sse_lsp_obj_t* obj, sse_size_t* len); int ase_lsp_probe_args (ase_lsp_mem_t* mem, ase_lsp_obj_t* obj, ase_size_t* len);
// symbol and string operations // symbol and string operations
int sse_lsp_comp_symbol (sse_lsp_obj_t* obj, const sse_char_t* str); int ase_lsp_comp_symbol (ase_lsp_obj_t* obj, const ase_char_t* str);
int sse_lsp_comp_symbol2 (sse_lsp_obj_t* obj, const sse_char_t* str, sse_size_t len); int ase_lsp_comp_symbol2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len);
int sse_lsp_comp_string (sse_lsp_obj_t* obj, const sse_char_t* str); int ase_lsp_comp_string (ase_lsp_obj_t* obj, const ase_char_t* str);
int sse_lsp_comp_string2 (sse_lsp_obj_t* obj, const sse_char_t* str, sse_size_t len); int ase_lsp_comp_string2 (ase_lsp_obj_t* obj, const ase_char_t* str, ase_size_t len);
void sse_lsp_copy_string (sse_char_t* dst, const sse_char_t* str); void ase_lsp_copy_string (ase_char_t* dst, const ase_char_t* str);
void sse_lsp_copy_string2 (sse_char_t* dst, const sse_char_t* str, sse_size_t len); void ase_lsp_copy_string2 (ase_char_t* dst, const ase_char_t* str, ase_size_t len);
#ifdef __cplusplus #ifdef __cplusplus
} }

332
ase/lsp/misc.c
View File

@ -1,66 +1,66 @@
/* /*
* $Id: misc.c,v 1.1 2006-10-23 14:42:38 bacon Exp $ * $Id: misc.c,v 1.2 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
void* sse_lsp_memcpy (void* dst, const void* src, sse_size_t n) void* ase_lsp_memcpy (void* dst, const void* src, ase_size_t n)
{ {
void* p = dst; void* p = dst;
void* e = (sse_byte_t*)dst + n; void* e = (ase_byte_t*)dst + n;
while (dst < e) while (dst < e)
{ {
*(sse_byte_t*)dst = *(sse_byte_t*)src; *(ase_byte_t*)dst = *(ase_byte_t*)src;
dst = (sse_byte_t*)dst + 1; dst = (ase_byte_t*)dst + 1;
src = (sse_byte_t*)src + 1; src = (ase_byte_t*)src + 1;
} }
return p; return p;
} }
void* sse_lsp_memset (void* dst, int val, sse_size_t n) void* ase_lsp_memset (void* dst, int val, ase_size_t n)
{ {
void* p = dst; void* p = dst;
void* e = (sse_byte_t*)p + n; void* e = (ase_byte_t*)p + n;
while (p < e) while (p < e)
{ {
*(sse_byte_t*)p = (sse_byte_t)val; *(ase_byte_t*)p = (ase_byte_t)val;
p = (sse_byte_t*)p + 1; p = (ase_byte_t*)p + 1;
} }
return dst; return dst;
} }
sse_long_t sse_lsp_strxtolong ( ase_long_t ase_lsp_strxtolong (
sse_lsp_t* lsp, const sse_char_t* str, sse_size_t len, ase_lsp_t* lsp, const ase_char_t* str, ase_size_t len,
int base, const sse_char_t** endptr) int base, const ase_char_t** endptr)
{ {
sse_long_t n = 0; ase_long_t n = 0;
const sse_char_t* p; const ase_char_t* p;
const sse_char_t* end; const ase_char_t* end;
sse_size_t rem; ase_size_t rem;
int digit, negative = 0; int digit, negative = 0;
sse_lsp_assert (lsp, base < 37); ase_lsp_assert (lsp, base < 37);
p = str; p = str;
end = str + len; end = str + len;
/* strip off leading spaces */ /* strip off leading spaces */
/*while (SSE_LSP_ISSPACE(lsp,*p)) p++;*/ /*while (ASE_LSP_ISSPACE(lsp,*p)) p++;*/
/* check for a sign */ /* check for a sign */
/*while (*p != SSE_T('\0')) */ /*while (*p != ASE_T('\0')) */
while (p < end) while (p < end)
{ {
if (*p == SSE_T('-')) if (*p == ASE_T('-'))
{ {
negative = ~negative; negative = ~negative;
p++; p++;
} }
else if (*p == SSE_T('+')) p++; else if (*p == ASE_T('+')) p++;
else break; else break;
} }
@ -68,16 +68,16 @@ sse_long_t sse_lsp_strxtolong (
rem = end - p; rem = end - p;
if (base == 0) if (base == 0)
{ {
if (rem >= 1 && *p == SSE_T('0')) if (rem >= 1 && *p == ASE_T('0'))
{ {
p++; p++;
if (rem == 1) base = 8; if (rem == 1) base = 8;
else if (*p == SSE_T('x') || *p == SSE_T('X')) else if (*p == ASE_T('x') || *p == ASE_T('X'))
{ {
p++; base = 16; p++; base = 16;
} }
else if (*p == SSE_T('b') || *p == SSE_T('B')) else if (*p == ASE_T('b') || *p == ASE_T('B'))
{ {
p++; base = 2; p++; base = 2;
} }
@ -87,25 +87,25 @@ sse_long_t sse_lsp_strxtolong (
} }
else if (rem >= 2 && base == 16) else if (rem >= 2 && base == 16)
{ {
if (*p == SSE_T('0') && if (*p == ASE_T('0') &&
(*(p+1) == SSE_T('x') || *(p+1) == SSE_T('X'))) p += 2; (*(p+1) == ASE_T('x') || *(p+1) == ASE_T('X'))) p += 2;
} }
else if (rem >= 2 && base == 2) else if (rem >= 2 && base == 2)
{ {
if (*p == SSE_T('0') && if (*p == ASE_T('0') &&
(*(p+1) == SSE_T('b') || *(p+1) == SSE_T('B'))) p += 2; (*(p+1) == ASE_T('b') || *(p+1) == ASE_T('B'))) p += 2;
} }
/* process the digits */ /* process the digits */
/*while (*p != SSE_T('\0'))*/ /*while (*p != ASE_T('\0'))*/
while (p < end) while (p < end)
{ {
if (*p >= SSE_T('0') && *p <= SSE_T('9')) if (*p >= ASE_T('0') && *p <= ASE_T('9'))
digit = *p - SSE_T('0'); digit = *p - ASE_T('0');
else if (*p >= SSE_T('A') && *p <= SSE_T('Z')) else if (*p >= ASE_T('A') && *p <= ASE_T('Z'))
digit = *p - SSE_T('A') + 10; digit = *p - ASE_T('A') + 10;
else if (*p >= SSE_T('a') && *p <= SSE_T('z')) else if (*p >= ASE_T('a') && *p <= ASE_T('z'))
digit = *p - SSE_T('a') + 10; digit = *p - ASE_T('a') + 10;
else break; else break;
if (digit >= base) break; if (digit >= base) break;
@ -114,13 +114,13 @@ sse_long_t sse_lsp_strxtolong (
p++; p++;
} }
if (endptr != SSE_NULL) *endptr = p; if (endptr != ASE_NULL) *endptr = p;
return (negative)? -n: n; return (negative)? -n: n;
} }
/* /*
* sse_lsp_strtoreal is almost a replica of strtod. * ase_lsp_strtoreal is almost a replica of strtod.
* *
* strtod.c -- * strtod.c --
* *
@ -140,21 +140,21 @@ sse_long_t sse_lsp_strxtolong (
#define MAX_EXPONENT 511 #define MAX_EXPONENT 511
sse_real_t sse_lsp_strtoreal (sse_lsp_t* lsp, const sse_char_t* str) ase_real_t ase_lsp_strtoreal (ase_lsp_t* lsp, const ase_char_t* str)
{ {
/* /*
* Table giving binary powers of 10. Entry is 10^2^i. * Table giving binary powers of 10. Entry is 10^2^i.
* Used to convert decimal exponents into floating-point numbers. * Used to convert decimal exponents into floating-point numbers.
*/ */
static sse_real_t powers_of_10[] = static ase_real_t powers_of_10[] =
{ {
10., 100., 1.0e4, 1.0e8, 1.0e16, 10., 100., 1.0e4, 1.0e8, 1.0e16,
1.0e32, 1.0e64, 1.0e128, 1.0e256 1.0e32, 1.0e64, 1.0e128, 1.0e256
}; };
sse_real_t fraction, dbl_exp, * d; ase_real_t fraction, dbl_exp, * d;
const sse_char_t* p; const ase_char_t* p;
sse_cint_t c; ase_cint_t c;
int exp = 0; /* Esseonent read from "EX" field */ int exp = 0; /* Esseonent read from "EX" field */
/* /*
@ -169,23 +169,23 @@ sse_real_t sse_lsp_strtoreal (sse_lsp_t* lsp, const sse_char_t* str)
int frac_exp; int frac_exp;
int mant_size; /* Number of digits in mantissa. */ int mant_size; /* Number of digits in mantissa. */
int dec_pt; /* Number of mantissa digits BEFORE decimal point */ int dec_pt; /* Number of mantissa digits BEFORE decimal point */
const sse_char_t *pexp; /* Temporarily holds location of exponent in string */ const ase_char_t *pexp; /* Temporarily holds location of exponent in string */
int negative = 0, exp_negative = 0; int negative = 0, exp_negative = 0;
p = str; p = str;
/* strip off leading blanks */ /* strip off leading blanks */
/*while (SSE_LSP_ISSPACE(lsp,*p)) p++;*/ /*while (ASE_LSP_ISSPACE(lsp,*p)) p++;*/
/* check for a sign */ /* check for a sign */
while (*p != SSE_T('\0')) while (*p != ASE_T('\0'))
{ {
if (*p == SSE_T('-')) if (*p == ASE_T('-'))
{ {
negative = ~negative; negative = ~negative;
p++; p++;
} }
else if (*p == SSE_T('+')) p++; else if (*p == ASE_T('+')) p++;
else break; else break;
} }
@ -195,9 +195,9 @@ sse_real_t sse_lsp_strtoreal (sse_lsp_t* lsp, const sse_char_t* str)
for (mant_size = 0; ; mant_size++) for (mant_size = 0; ; mant_size++)
{ {
c = *p; c = *p;
if (!SSE_LSP_ISDIGIT (lsp, c)) if (!ASE_LSP_ISDIGIT (lsp, c))
{ {
if ((c != SSE_T('.')) || (dec_pt >= 0)) break; if ((c != ASE_T('.')) || (dec_pt >= 0)) break;
dec_pt = mant_size; dec_pt = mant_size;
} }
p++; p++;
@ -245,51 +245,51 @@ sse_real_t sse_lsp_strtoreal (sse_lsp_t* lsp, const sse_char_t* str)
{ {
c = *p; c = *p;
p++; p++;
if (c == SSE_T('.')) if (c == ASE_T('.'))
{ {
c = *p; c = *p;
p++; p++;
} }
frac1 = 10 * frac1 + (c - SSE_T('0')); frac1 = 10 * frac1 + (c - ASE_T('0'));
} }
frac2 = 0; frac2 = 0;
for (; mant_size > 0; mant_size--) { for (; mant_size > 0; mant_size--) {
c = *p; c = *p;
p++; p++;
if (c == SSE_T('.')) if (c == ASE_T('.'))
{ {
c = *p; c = *p;
p++; p++;
} }
frac2 = 10*frac2 + (c - SSE_T('0')); frac2 = 10*frac2 + (c - ASE_T('0'));
} }
fraction = (1.0e9 * frac1) + frac2; fraction = (1.0e9 * frac1) + frac2;
} }
/* Skim off the exponent */ /* Skim off the exponent */
p = pexp; p = pexp;
if ((*p == SSE_T('E')) || (*p == SSE_T('e'))) if ((*p == ASE_T('E')) || (*p == ASE_T('e')))
{ {
p++; p++;
if (*p == SSE_T('-')) if (*p == ASE_T('-'))
{ {
exp_negative = 1; exp_negative = 1;
p++; p++;
} }
else else
{ {
if (*p == SSE_T('+')) p++; if (*p == ASE_T('+')) p++;
exp_negative = 0; exp_negative = 0;
} }
if (!SSE_LSP_ISDIGIT (lsp, *p)) if (!ASE_LSP_ISDIGIT (lsp, *p))
{ {
/* p = pexp; */ /* p = pexp; */
/* goto done; */ /* goto done; */
goto no_exp; goto no_exp;
} }
while (SSE_LSP_ISDIGIT (lsp, *p)) while (ASE_LSP_ISDIGIT (lsp, *p))
{ {
exp = exp * 10 + (*p - SSE_T('0')); exp = exp * 10 + (*p - ASE_T('0'));
p++; p++;
} }
} }
@ -327,23 +327,23 @@ done:
return (negative)? -fraction: fraction; return (negative)? -fraction: fraction;
} }
sse_real_t sse_lsp_strxtoreal ( ase_real_t ase_lsp_strxtoreal (
sse_lsp_t* lsp, const sse_char_t* str, sse_size_t len, ase_lsp_t* lsp, const ase_char_t* str, ase_size_t len,
const sse_char_t** endptr) const ase_char_t** endptr)
{ {
/* /*
* Table giving binary powers of 10. Entry is 10^2^i. * Table giving binary powers of 10. Entry is 10^2^i.
* Used to convert decimal exponents into floating-point numbers. * Used to convert decimal exponents into floating-point numbers.
*/ */
static sse_real_t powers_of_10[] = static ase_real_t powers_of_10[] =
{ {
10., 100., 1.0e4, 1.0e8, 1.0e16, 10., 100., 1.0e4, 1.0e8, 1.0e16,
1.0e32, 1.0e64, 1.0e128, 1.0e256 1.0e32, 1.0e64, 1.0e128, 1.0e256
}; };
sse_real_t fraction, dbl_exp, * d; ase_real_t fraction, dbl_exp, * d;
const sse_char_t* p, * end; const ase_char_t* p, * end;
sse_cint_t c; ase_cint_t c;
int exp = 0; /* Esseonent read from "EX" field */ int exp = 0; /* Esseonent read from "EX" field */
/* /*
@ -358,24 +358,24 @@ sse_real_t sse_lsp_strxtoreal (
int frac_exp; int frac_exp;
int mant_size; /* Number of digits in mantissa. */ int mant_size; /* Number of digits in mantissa. */
int dec_pt; /* Number of mantissa digits BEFORE decimal point */ int dec_pt; /* Number of mantissa digits BEFORE decimal point */
const sse_char_t *pexp; /* Temporarily holds location of exponent in string */ const ase_char_t *pexp; /* Temporarily holds location of exponent in string */
int negative = 0, exp_negative = 0; int negative = 0, exp_negative = 0;
p = str; p = str;
end = str + len; end = str + len;
/* Strip off leading blanks and check for a sign */ /* Strip off leading blanks and check for a sign */
/*while (SSE_LSP_ISSPACE(lsp,*p)) p++;*/ /*while (ASE_LSP_ISSPACE(lsp,*p)) p++;*/
/*while (*p != SSE_T('\0')) */ /*while (*p != ASE_T('\0')) */
while (p < end) while (p < end)
{ {
if (*p == SSE_T('-')) if (*p == ASE_T('-'))
{ {
negative = ~negative; negative = ~negative;
p++; p++;
} }
else if (*p == SSE_T('+')) p++; else if (*p == ASE_T('+')) p++;
else break; else break;
} }
@ -386,9 +386,9 @@ sse_real_t sse_lsp_strxtoreal (
for (mant_size = 0; p < end; mant_size++) for (mant_size = 0; p < end; mant_size++)
{ {
c = *p; c = *p;
if (!SSE_LSP_ISDIGIT (lsp, c)) if (!ASE_LSP_ISDIGIT (lsp, c))
{ {
if (c != SSE_T('.') || dec_pt >= 0) break; if (c != ASE_T('.') || dec_pt >= 0) break;
dec_pt = mant_size; dec_pt = mant_size;
} }
p++; p++;
@ -411,7 +411,7 @@ sse_real_t sse_lsp_strxtoreal (
mant_size--; /* One of the digits was the point */ mant_size--; /* One of the digits was the point */
} }
if (mant_size > 18) /* TODO: is 18 correct for sse_real_t??? */ if (mant_size > 18) /* TODO: is 18 correct for ase_real_t??? */
{ {
frac_exp = dec_pt - 18; frac_exp = dec_pt - 18;
mant_size = 18; mant_size = 18;
@ -437,58 +437,58 @@ sse_real_t sse_lsp_strxtoreal (
{ {
c = *p; c = *p;
p++; p++;
if (c == SSE_T('.')) if (c == ASE_T('.'))
{ {
c = *p; c = *p;
p++; p++;
} }
frac1 = 10 * frac1 + (c - SSE_T('0')); frac1 = 10 * frac1 + (c - ASE_T('0'));
} }
frac2 = 0; frac2 = 0;
for (; mant_size > 0; mant_size--) { for (; mant_size > 0; mant_size--) {
c = *p++; c = *p++;
if (c == SSE_T('.')) if (c == ASE_T('.'))
{ {
c = *p; c = *p;
p++; p++;
} }
frac2 = 10 * frac2 + (c - SSE_T('0')); frac2 = 10 * frac2 + (c - ASE_T('0'));
} }
fraction = (1.0e9 * frac1) + frac2; fraction = (1.0e9 * frac1) + frac2;
} }
/* Skim off the exponent */ /* Skim off the exponent */
p = pexp; p = pexp;
if (p < end && (*p == SSE_T('E') || *p == SSE_T('e'))) if (p < end && (*p == ASE_T('E') || *p == ASE_T('e')))
{ {
p++; p++;
if (p < end) if (p < end)
{ {
if (*p == SSE_T('-')) if (*p == ASE_T('-'))
{ {
exp_negative = 1; exp_negative = 1;
p++; p++;
} }
else else
{ {
if (*p == SSE_T('+')) p++; if (*p == ASE_T('+')) p++;
exp_negative = 0; exp_negative = 0;
} }
} }
else exp_negative = 0; else exp_negative = 0;
if (!(p < end && SSE_LSP_ISDIGIT (lsp, *p))) if (!(p < end && ASE_LSP_ISDIGIT (lsp, *p)))
{ {
/*p = pexp;*/ /*p = pexp;*/
/*goto done;*/ /*goto done;*/
goto no_exp; goto no_exp;
} }
while (p < end && SSE_LSP_ISDIGIT (lsp, *p)) while (p < end && ASE_LSP_ISDIGIT (lsp, *p))
{ {
exp = exp * 10 + (*p - SSE_T('0')); exp = exp * 10 + (*p - ASE_T('0'));
p++; p++;
} }
} }
@ -523,35 +523,35 @@ no_exp:
else fraction *= dbl_exp; else fraction *= dbl_exp;
done: done:
if (endptr != SSE_NULL) *endptr = p; if (endptr != ASE_NULL) *endptr = p;
return (negative)? -fraction: fraction; return (negative)? -fraction: fraction;
} }
sse_size_t sse_lsp_longtostr ( ase_size_t ase_lsp_longtostr (
sse_long_t value, int radix, const sse_char_t* prefix, ase_long_t value, int radix, const ase_char_t* prefix,
sse_char_t* buf, sse_size_t size) ase_char_t* buf, ase_size_t size)
{ {
sse_long_t t, rem; ase_long_t t, rem;
sse_size_t len, ret, i; ase_size_t len, ret, i;
sse_size_t prefix_len; ase_size_t prefix_len;
prefix_len = (prefix != SSE_NULL)? sse_lsp_strlen(prefix): 0; prefix_len = (prefix != ASE_NULL)? ase_lsp_strlen(prefix): 0;
t = value; t = value;
if (t == 0) if (t == 0)
{ {
/* zero */ /* zero */
if (buf == SSE_NULL) return prefix_len + 1; if (buf == ASE_NULL) return prefix_len + 1;
if (size < prefix_len+1) if (size < prefix_len+1)
{ {
/* buffer too small */ /* buffer too small */
return (sse_size_t)-1; return (ase_size_t)-1;
} }
for (i = 0; i < prefix_len; i++) buf[i] = prefix[i]; for (i = 0; i < prefix_len; i++) buf[i] = prefix[i];
buf[prefix_len] = SSE_T('0'); buf[prefix_len] = ASE_T('0');
if (size > prefix_len+1) buf[prefix_len+1] = SSE_T('\0'); if (size > prefix_len+1) buf[prefix_len+1] = ASE_T('\0');
return 1; return 1;
} }
@ -560,14 +560,14 @@ sse_size_t sse_lsp_longtostr (
if (t < 0) { t = -t; len++; } if (t < 0) { t = -t; len++; }
while (t > 0) { len++; t /= radix; } while (t > 0) { len++; t /= radix; }
if (buf == SSE_NULL) if (buf == ASE_NULL)
{ {
/* if buf is not given, return the number of bytes required */ /* if buf is not given, return the number of bytes required */
return len; return len;
} }
if (size < len) return (sse_size_t)-1; /* buffer too small */ if (size < len) return (ase_size_t)-1; /* buffer too small */
if (size > len) buf[len] = SSE_T('\0'); if (size > len) buf[len] = ASE_T('\0');
ret = len; ret = len;
t = value; t = value;
@ -577,9 +577,9 @@ sse_size_t sse_lsp_longtostr (
{ {
rem = t % radix; rem = t % radix;
if (rem >= 10) if (rem >= 10)
buf[--len] = (sse_char_t)rem + SSE_T('a') - 10; buf[--len] = (ase_char_t)rem + ASE_T('a') - 10;
else else
buf[--len] = (sse_char_t)rem + SSE_T('0'); buf[--len] = (ase_char_t)rem + ASE_T('0');
t /= radix; t /= radix;
} }
@ -590,7 +590,7 @@ sse_size_t sse_lsp_longtostr (
buf[i] = prefix[i-1]; buf[i] = prefix[i-1];
len--; len--;
} }
buf[--len] = SSE_T('-'); buf[--len] = ASE_T('-');
} }
else else
{ {
@ -600,86 +600,86 @@ sse_size_t sse_lsp_longtostr (
return ret; return ret;
} }
sse_char_t* sse_lsp_strdup (sse_lsp_t* lsp, const sse_char_t* str) ase_char_t* ase_lsp_strdup (ase_lsp_t* lsp, const ase_char_t* str)
{ {
sse_char_t* tmp; ase_char_t* tmp;
tmp = (sse_char_t*) SSE_LSP_MALLOC ( tmp = (ase_char_t*) ASE_LSP_MALLOC (
lsp, (sse_lsp_strlen(str) + 1) * sse_sizeof(sse_char_t)); lsp, (ase_lsp_strlen(str) + 1) * ase_sizeof(ase_char_t));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
sse_lsp_strcpy (tmp, str); ase_lsp_strcpy (tmp, str);
return tmp; return tmp;
} }
sse_char_t* sse_lsp_strxdup (sse_lsp_t* lsp, const sse_char_t* str, sse_size_t len) ase_char_t* ase_lsp_strxdup (ase_lsp_t* lsp, const ase_char_t* str, ase_size_t len)
{ {
sse_char_t* tmp; ase_char_t* tmp;
tmp = (sse_char_t*) SSE_LSP_MALLOC ( tmp = (ase_char_t*) ASE_LSP_MALLOC (
lsp, (len + 1) * sse_sizeof(sse_char_t)); lsp, (len + 1) * ase_sizeof(ase_char_t));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
sse_lsp_strncpy (tmp, str, len); ase_lsp_strncpy (tmp, str, len);
return tmp; return tmp;
} }
sse_char_t* sse_lsp_strxdup2 ( ase_char_t* ase_lsp_strxdup2 (
sse_lsp_t* lsp, ase_lsp_t* lsp,
const sse_char_t* str1, sse_size_t len1, const ase_char_t* str1, ase_size_t len1,
const sse_char_t* str2, sse_size_t len2) const ase_char_t* str2, ase_size_t len2)
{ {
sse_char_t* tmp; ase_char_t* tmp;
tmp = (sse_char_t*) SSE_LSP_MALLOC ( tmp = (ase_char_t*) ASE_LSP_MALLOC (
lsp, (len1 + len2 + 1) * sse_sizeof(sse_char_t)); lsp, (len1 + len2 + 1) * ase_sizeof(ase_char_t));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
sse_lsp_strncpy (tmp, str1, len1); ase_lsp_strncpy (tmp, str1, len1);
sse_lsp_strncpy (tmp + len1, str2, len2); ase_lsp_strncpy (tmp + len1, str2, len2);
return tmp; return tmp;
} }
sse_size_t sse_lsp_strlen (const sse_char_t* str) ase_size_t ase_lsp_strlen (const ase_char_t* str)
{ {
const sse_char_t* p = str; const ase_char_t* p = str;
while (*p != SSE_T('\0')) p++; while (*p != ASE_T('\0')) p++;
return p - str; return p - str;
} }
sse_size_t sse_lsp_strcpy (sse_char_t* buf, const sse_char_t* str) ase_size_t ase_lsp_strcpy (ase_char_t* buf, const ase_char_t* str)
{ {
sse_char_t* org = buf; ase_char_t* org = buf;
while ((*buf++ = *str++) != SSE_T('\0')); while ((*buf++ = *str++) != ASE_T('\0'));
return buf - org - 1; return buf - org - 1;
} }
sse_size_t sse_lsp_strncpy (sse_char_t* buf, const sse_char_t* str, sse_size_t len) ase_size_t ase_lsp_strncpy (ase_char_t* buf, const ase_char_t* str, ase_size_t len)
{ {
const sse_char_t* end = str + len; const ase_char_t* end = str + len;
while (str < end) *buf++ = *str++; while (str < end) *buf++ = *str++;
*buf = SSE_T('\0'); *buf = ASE_T('\0');
return len; return len;
} }
int sse_lsp_strcmp (const sse_char_t* s1, const sse_char_t* s2) int ase_lsp_strcmp (const ase_char_t* s1, const ase_char_t* s2)
{ {
while (*s1 == *s2) while (*s1 == *s2)
{ {
if (*s1 == SSE_C('\0')) return 0; if (*s1 == ASE_C('\0')) return 0;
s1++, s2++; s1++, s2++;
} }
return (*s1 > *s2)? 1: -1; return (*s1 > *s2)? 1: -1;
} }
int sse_lsp_strxncmp ( int ase_lsp_strxncmp (
const sse_char_t* s1, sse_size_t len1, const ase_char_t* s1, ase_size_t len1,
const sse_char_t* s2, sse_size_t len2) const ase_char_t* s2, ase_size_t len2)
{ {
sse_char_t c1, c2; ase_char_t c1, c2;
const sse_char_t* end1 = s1 + len1; const ase_char_t* end1 = s1 + len1;
const sse_char_t* end2 = s2 + len2; const ase_char_t* end2 = s2 + len2;
while (s1 < end1) while (s1 < end1)
{ {
@ -697,21 +697,21 @@ int sse_lsp_strxncmp (
return (s2 < end2)? -1: 0; return (s2 < end2)? -1: 0;
} }
int sse_lsp_strxncasecmp ( int ase_lsp_strxncasecmp (
sse_lsp_t* lsp, ase_lsp_t* lsp,
const sse_char_t* s1, sse_size_t len1, const ase_char_t* s1, ase_size_t len1,
const sse_char_t* s2, sse_size_t len2) const ase_char_t* s2, ase_size_t len2)
{ {
sse_char_t c1, c2; ase_char_t c1, c2;
const sse_char_t* end1 = s1 + len1; const ase_char_t* end1 = s1 + len1;
const sse_char_t* end2 = s2 + len2; const ase_char_t* end2 = s2 + len2;
while (s1 < end1) while (s1 < end1)
{ {
c1 = SSE_LSP_TOUPPER (lsp, *s1); c1 = ASE_LSP_TOUPPER (lsp, *s1);
if (s2 < end2) if (s2 < end2)
{ {
c2 = SSE_LSP_TOUPPER (lsp, *s2); c2 = ASE_LSP_TOUPPER (lsp, *s2);
if (c1 > c2) return 1; if (c1 > c2) return 1;
if (c1 < c2) return -1; if (c1 < c2) return -1;
} }
@ -722,24 +722,24 @@ int sse_lsp_strxncasecmp (
return (s2 < end2)? -1: 0; return (s2 < end2)? -1: 0;
} }
sse_char_t* sse_lsp_strxnstr ( ase_char_t* ase_lsp_strxnstr (
const sse_char_t* str, sse_size_t strsz, const ase_char_t* str, ase_size_t strsz,
const sse_char_t* sub, sse_size_t subsz) const ase_char_t* sub, ase_size_t subsz)
{ {
const sse_char_t* end, * subp; const ase_char_t* end, * subp;
if (subsz == 0) return (sse_char_t*)str; if (subsz == 0) return (ase_char_t*)str;
if (strsz < subsz) return SSE_NULL; if (strsz < subsz) return ASE_NULL;
end = str + strsz - subsz; end = str + strsz - subsz;
subp = sub + subsz; subp = sub + subsz;
while (str <= end) { while (str <= end) {
const sse_char_t* x = str; const ase_char_t* x = str;
const sse_char_t* y = sub; const ase_char_t* y = sub;
while (sse_true) { while (ase_true) {
if (y >= subp) return (sse_char_t*)str; if (y >= subp) return (ase_char_t*)str;
if (*x != *y) break; if (*x != *y) break;
x++; y++; x++; y++;
} }
@ -747,14 +747,14 @@ sse_char_t* sse_lsp_strxnstr (
str++; str++;
} }
return SSE_NULL; return ASE_NULL;
} }
int sse_lsp_abort (sse_lsp_t* lsp, int ase_lsp_abort (ase_lsp_t* lsp,
const sse_char_t* expr, const sse_char_t* file, int line) const ase_char_t* expr, const ase_char_t* file, int line)
{ {
lsp->syscas.dprintf ( lsp->syscas.dprintf (
SSE_T("ASSERTION FAILURE AT FILE %s, LINE %d\n%s\n"), ASE_T("ASSERTION FAILURE AT FILE %s, LINE %d\n%s\n"),
file, line, expr); file, line, expr);
lsp->syscas.abort (); lsp->syscas.abort ();
return 0; return 0;

18
ase/lsp/misc.h
View File

@ -1,23 +1,23 @@
/* /*
* $Id: misc.h,v 1.1 2006-10-23 14:42:38 bacon Exp $ * $Id: misc.h,v 1.2 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_MISC_H_ #ifndef _ASE_LSP_MISC_H_
#define _SSE_LSP_MISC_H_ #define _ASE_LSP_MISC_H_
#ifndef _SSE_LSP_LSP_H_ #ifndef _ASE_LSP_LSP_H_
#error Never include this file directly. Include <sse/lsp/lsp.h> instead #error Never include this file directly. Include <ase/lsp/lsp.h> instead
#endif #endif
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
void* sse_lsp_memcpy (void* dst, const void* src, sse_size_t n); void* ase_lsp_memcpy (void* dst, const void* src, ase_size_t n);
void* sse_lsp_memset (void* dst, int val, sse_size_t n); void* ase_lsp_memset (void* dst, int val, ase_size_t n);
int sse_lsp_abort (sse_lsp_t* lsp, int ase_lsp_abort (ase_lsp_t* lsp,
const sse_char_t* expr, const sse_char_t* file, int line); const ase_char_t* expr, const ase_char_t* file, int line);
#ifdef __cplusplus #ifdef __cplusplus
} }

120
ase/lsp/name.c
View File

@ -1,73 +1,73 @@
/* /*
* $Id: name.c,v 1.5 2006-10-23 14:42:38 bacon Exp $ * $Id: name.c,v 1.6 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/name.h> #include <ase/lsp/name.h>
sse_lsp_name_t* sse_lsp_name_open ( ase_lsp_name_t* ase_lsp_name_open (
sse_lsp_name_t* name, sse_word_t capacity) ase_lsp_name_t* name, ase_word_t capacity)
{ {
if (capacity == 0) if (capacity == 0)
capacity = sse_countof(name->static_buffer) - 1; capacity = ase_countof(name->static_buffer) - 1;
if (name == SSE_NULL) { if (name == ASE_NULL) {
name = (sse_lsp_name_t*) name = (ase_lsp_name_t*)
sse_malloc (sse_sizeof(sse_lsp_name_t)); ase_malloc (ase_sizeof(ase_lsp_name_t));
if (name == SSE_NULL) return SSE_NULL; if (name == ASE_NULL) return ASE_NULL;
name->__dynamic = sse_true; name->__dynamic = ase_true;
} }
else name->__dynamic = sse_false; else name->__dynamic = ase_false;
if (capacity < sse_countof(name->static_buffer)) { if (capacity < ase_countof(name->static_buffer)) {
name->buffer = name->static_buffer; name->buffer = name->static_buffer;
} }
else { else {
name->buffer = (sse_char_t*) name->buffer = (ase_char_t*)
sse_malloc ((capacity + 1) * sse_sizeof(sse_char_t)); ase_malloc ((capacity + 1) * ase_sizeof(ase_char_t));
if (name->buffer == SSE_NULL) { if (name->buffer == ASE_NULL) {
if (name->__dynamic) sse_free (name); if (name->__dynamic) ase_free (name);
return SSE_NULL; return ASE_NULL;
} }
} }
name->size = 0; name->size = 0;
name->capacity = capacity; name->capacity = capacity;
name->buffer[0] = SSE_CHAR('\0'); name->buffer[0] = ASE_CHAR('\0');
return name; return name;
} }
void sse_lsp_name_close (sse_lsp_name_t* name) void ase_lsp_name_close (ase_lsp_name_t* name)
{ {
if (name->capacity >= sse_countof(name->static_buffer)) { if (name->capacity >= ase_countof(name->static_buffer)) {
sse_assert (name->buffer != name->static_buffer); ase_assert (name->buffer != name->static_buffer);
sse_free (name->buffer); ase_free (name->buffer);
} }
if (name->__dynamic) sse_free (name); if (name->__dynamic) ase_free (name);
} }
int sse_lsp_name_addc (sse_lsp_name_t* name, sse_cint_t c) int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c)
{ {
if (name->size >= name->capacity) { if (name->size >= name->capacity) {
/* double the capacity. */ /* double the capacity. */
sse_size_t new_capacity = name->capacity * 2; ase_size_t new_capacity = name->capacity * 2;
if (new_capacity >= sse_countof(name->static_buffer)) { if (new_capacity >= ase_countof(name->static_buffer)) {
sse_char_t* space; ase_char_t* space;
if (name->capacity < sse_countof(name->static_buffer)) { if (name->capacity < ase_countof(name->static_buffer)) {
space = (sse_char_t*)sse_malloc ( space = (ase_char_t*)ase_malloc (
(new_capacity + 1) * sse_sizeof(sse_char_t)); (new_capacity + 1) * ase_sizeof(ase_char_t));
if (space == SSE_NULL) return -1; if (space == ASE_NULL) return -1;
/* don't need to copy up to the terminating null */ /* don't need to copy up to the terminating null */
sse_memcpy (space, name->buffer, ase_memcpy (space, name->buffer,
name->capacity * sse_sizeof(sse_char_t)); name->capacity * ase_sizeof(ase_char_t));
} }
else { else {
space = (sse_char_t*)sse_realloc (name->buffer, space = (ase_char_t*)ase_realloc (name->buffer,
(new_capacity + 1) * sse_sizeof(sse_char_t)); (new_capacity + 1) * ase_sizeof(ase_char_t));
if (space == SSE_NULL) return -1; if (space == ASE_NULL) return -1;
} }
name->buffer = space; name->buffer = space;
@ -77,63 +77,63 @@ int sse_lsp_name_addc (sse_lsp_name_t* name, sse_cint_t c)
} }
name->buffer[name->size++] = c; name->buffer[name->size++] = c;
name->buffer[name->size] = SSE_CHAR('\0'); name->buffer[name->size] = ASE_CHAR('\0');
return 0; return 0;
} }
int sse_lsp_name_adds (sse_lsp_name_t* name, const sse_char_t* s) int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s)
{ {
while (*s != SSE_CHAR('\0')) { while (*s != ASE_CHAR('\0')) {
if (sse_lsp_name_addc(name, *s) == -1) return -1; if (ase_lsp_name_addc(name, *s) == -1) return -1;
s++; s++;
} }
return 0; return 0;
} }
void sse_lsp_name_clear (sse_lsp_name_t* name) void ase_lsp_name_clear (ase_lsp_name_t* name)
{ {
name->size = 0; name->size = 0;
name->buffer[0] = SSE_CHAR('\0'); name->buffer[0] = ASE_CHAR('\0');
} }
sse_char_t* sse_lsp_name_yield (sse_lsp_name_t* name, sse_word_t capacity) ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_word_t capacity)
{ {
sse_char_t* old_buffer, * new_buffer; ase_char_t* old_buffer, * new_buffer;
if (capacity == 0) if (capacity == 0)
capacity = sse_countof(name->static_buffer) - 1; capacity = ase_countof(name->static_buffer) - 1;
if (name->capacity < sse_countof(name->static_buffer)) { if (name->capacity < ase_countof(name->static_buffer)) {
old_buffer = (sse_char_t*) old_buffer = (ase_char_t*)
sse_malloc((name->capacity + 1) * sse_sizeof(sse_char_t)); ase_malloc((name->capacity + 1) * ase_sizeof(ase_char_t));
if (old_buffer == SSE_NULL) return SSE_NULL; if (old_buffer == ASE_NULL) return ASE_NULL;
sse_memcpy (old_buffer, name->buffer, ase_memcpy (old_buffer, name->buffer,
(name->capacity + 1) * sse_sizeof(sse_char_t)); (name->capacity + 1) * ase_sizeof(ase_char_t));
} }
else old_buffer = name->buffer; else old_buffer = name->buffer;
if (capacity < sse_countof(name->static_buffer)) { if (capacity < ase_countof(name->static_buffer)) {
new_buffer = name->static_buffer; new_buffer = name->static_buffer;
} }
else { else {
new_buffer = (sse_char_t*) new_buffer = (ase_char_t*)
sse_malloc((capacity + 1) * sse_sizeof(sse_char_t)); ase_malloc((capacity + 1) * ase_sizeof(ase_char_t));
if (new_buffer == SSE_NULL) return SSE_NULL; if (new_buffer == ASE_NULL) return ASE_NULL;
} }
name->buffer = new_buffer; name->buffer = new_buffer;
name->size = 0; name->size = 0;
name->capacity = capacity; name->capacity = capacity;
name->buffer[0] = SSE_CHAR('\0'); name->buffer[0] = ASE_CHAR('\0');
return old_buffer; return old_buffer;
} }
int sse_lsp_name_compare (sse_lsp_name_t* name, const sse_char_t* str) int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str)
{ {
sse_char_t* p = name->buffer; ase_char_t* p = name->buffer;
sse_word_t index = 0; ase_word_t index = 0;
while (index < name->size) { while (index < name->size) {
if (*p > *str) return 1; if (*p > *str) return 1;
@ -141,5 +141,5 @@ int sse_lsp_name_compare (sse_lsp_name_t* name, const sse_char_t* str)
index++; p++; str++; index++; p++; str++;
} }
return (*str == SSE_CHAR('\0'))? 0: -1; return (*str == ASE_CHAR('\0'))? 0: -1;
} }

40
ase/lsp/name.h
View File

@ -1,37 +1,37 @@
/* /*
* $Id: name.h,v 1.4 2006-10-22 13:10:46 bacon Exp $ * $Id: name.h,v 1.5 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_NAME_H_ #ifndef _ASE_LSP_NAME_H_
#define _SSE_LSP_NAME_H_ #define _ASE_LSP_NAME_H_
#include <sse/types.h> #include <ase/types.h>
#include <sse/macros.h> #include <ase/macros.h>
struct sse_lsp_name_t struct ase_lsp_name_t
{ {
sse_word_t capacity; ase_word_t capacity;
sse_word_t size; ase_word_t size;
sse_char_t* buffer; ase_char_t* buffer;
sse_char_t static_buffer[128]; ase_char_t static_buffer[128];
sse_bool_t __dynamic; ase_bool_t __dynamic;
}; };
typedef struct sse_lsp_name_t sse_lsp_name_t; typedef struct ase_lsp_name_t ase_lsp_name_t;
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_name_t* sse_lsp_name_open ( ase_lsp_name_t* ase_lsp_name_open (
sse_lsp_name_t* name, sse_word_t capacity); ase_lsp_name_t* name, ase_word_t capacity);
void sse_lsp_name_close (sse_lsp_name_t* name); void ase_lsp_name_close (ase_lsp_name_t* name);
int sse_lsp_name_addc (sse_lsp_name_t* name, sse_cint_t c); int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c);
int sse_lsp_name_adds (sse_lsp_name_t* name, const sse_char_t* s); int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s);
void sse_lsp_name_clear (sse_lsp_name_t* name); void ase_lsp_name_clear (ase_lsp_name_t* name);
sse_char_t* sse_lsp_name_yield (sse_lsp_name_t* name, sse_word_t capacity); ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_word_t capacity);
int sse_lsp_name_compare (sse_lsp_name_t* name, const sse_char_t* str); int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str);
#ifdef __cplusplus #ifdef __cplusplus
} }

172
ase/lsp/obj.h
View File

@ -1,154 +1,154 @@
/* /*
* $Id: obj.h,v 1.6 2006-10-23 14:42:38 bacon Exp $ * $Id: obj.h,v 1.7 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_OBJ_H_ #ifndef _ASE_LSP_OBJ_H_
#define _SSE_LSP_OBJ_H_ #define _ASE_LSP_OBJ_H_
#include <sse/lsp/types.h> #include <ase/lsp/types.h>
/* object types */ /* object types */
enum enum
{ {
SSE_LSP_OBJ_NIL = 0, ASE_LSP_OBJ_NIL = 0,
SSE_LSP_OBJ_TRUE, ASE_LSP_OBJ_TRUE,
SSE_LSP_OBJ_INT, ASE_LSP_OBJ_INT,
SSE_LSP_OBJ_REAL, ASE_LSP_OBJ_REAL,
SSE_LSP_OBJ_SYMBOL, ASE_LSP_OBJ_SYMBOL,
SSE_LSP_OBJ_STRING, ASE_LSP_OBJ_STRING,
SSE_LSP_OBJ_CONS, ASE_LSP_OBJ_CONS,
SSE_LSP_OBJ_FUNC, ASE_LSP_OBJ_FUNC,
SSE_LSP_OBJ_MACRO, ASE_LSP_OBJ_MACRO,
SSE_LSP_OBJ_PRIM, ASE_LSP_OBJ_PRIM,
SSE_LSP_TYPE_COUNT // the number of lsp object types ASE_LSP_TYPE_COUNT // the number of lsp object types
}; };
typedef struct sse_lsp_objhdr_t sse_lsp_objhdr_t; typedef struct ase_lsp_objhdr_t ase_lsp_objhdr_t;
typedef struct sse_lsp_obj_t sse_lsp_obj_t; typedef struct ase_lsp_obj_t ase_lsp_obj_t;
typedef struct sse_lsp_obj_nil_t sse_lsp_obj_nil_t; typedef struct ase_lsp_obj_nil_t ase_lsp_obj_nil_t;
typedef struct sse_lsp_obj_true_t sse_lsp_obj_true_t; typedef struct ase_lsp_obj_true_t ase_lsp_obj_true_t;
typedef struct sse_lsp_obj_int_t sse_lsp_obj_int_t; typedef struct ase_lsp_obj_int_t ase_lsp_obj_int_t;
typedef struct sse_lsp_obj_real_t sse_lsp_obj_real_t; typedef struct ase_lsp_obj_real_t ase_lsp_obj_real_t;
typedef struct sse_lsp_obj_symbol_t sse_lsp_obj_symbol_t; typedef struct ase_lsp_obj_symbol_t ase_lsp_obj_symbol_t;
typedef struct sse_lsp_obj_string_t sse_lsp_obj_string_t; typedef struct ase_lsp_obj_string_t ase_lsp_obj_string_t;
typedef struct sse_lsp_obj_cons_t sse_lsp_obj_cons_t; typedef struct ase_lsp_obj_cons_t ase_lsp_obj_cons_t;
typedef struct sse_lsp_obj_func_t sse_lsp_obj_func_t; typedef struct ase_lsp_obj_func_t ase_lsp_obj_func_t;
typedef struct sse_lsp_obj_macro_t sse_lsp_obj_macro_t; typedef struct ase_lsp_obj_macro_t ase_lsp_obj_macro_t;
typedef struct sse_lsp_obj_prim_t sse_lsp_obj_prim_t; typedef struct ase_lsp_obj_prim_t ase_lsp_obj_prim_t;
struct sse_lsp_objhdr_t struct ase_lsp_objhdr_t
{ {
sse_uint32_t type: 24; ase_uint32_t type: 24;
sse_uint32_t mark: 4; ase_uint32_t mark: 4;
sse_uint32_t lock: 4; ase_uint32_t lock: 4;
sse_size_t size; ase_size_t size;
sse_lsp_obj_t* link; ase_lsp_obj_t* link;
}; };
struct sse_lsp_obj_t struct ase_lsp_obj_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
}; };
struct sse_lsp_obj_nil_t struct ase_lsp_obj_nil_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
}; };
struct sse_lsp_obj_true_t struct ase_lsp_obj_true_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
}; };
struct sse_lsp_obj_int_t struct ase_lsp_obj_int_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
sse_lsp_int_t value; ase_lsp_int_t value;
}; };
struct sse_lsp_obj_real_t struct ase_lsp_obj_real_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
sse_lsp_real_t value; ase_lsp_real_t value;
}; };
struct sse_lsp_obj_symbol_t struct ase_lsp_obj_symbol_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
#if defined(__BORLANDC__) || defined(_MSC_VER) #if defined(__BORLANDC__) || defined(_MSC_VER)
#else #else
sse_char_t buffer[0]; ase_char_t buffer[0];
#endif #endif
}; };
struct sse_lsp_obj_string_t struct ase_lsp_obj_string_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
#if defined(__BORLANDC__) || defined(_MSC_VER) #if defined(__BORLANDC__) || defined(_MSC_VER)
#else #else
sse_char_t buffer[0]; ase_char_t buffer[0];
#endif #endif
}; };
struct sse_lsp_obj_cons_t struct ase_lsp_obj_cons_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
struct sse_lsp_obj_t* car; struct ase_lsp_obj_t* car;
struct sse_lsp_obj_t* cdr; struct ase_lsp_obj_t* cdr;
}; };
struct sse_lsp_obj_func_t struct ase_lsp_obj_func_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
struct sse_lsp_obj_t* formal; struct ase_lsp_obj_t* formal;
struct sse_lsp_obj_t* body; struct ase_lsp_obj_t* body;
}; };
struct sse_lsp_obj_macro_t struct ase_lsp_obj_macro_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
struct sse_lsp_obj_t* formal; struct ase_lsp_obj_t* formal;
struct sse_lsp_obj_t* body; struct ase_lsp_obj_t* body;
}; };
struct sse_lsp_obj_prim_t struct ase_lsp_obj_prim_t
{ {
sse_lsp_objhdr_t hdr; ase_lsp_objhdr_t hdr;
void* impl; /* sse_lsp_prim_t */ void* impl; /* ase_lsp_prim_t */
}; };
/* header access */ /* header access */
#define SSE_LSP_TYPE(x) (((sse_lsp_obj_t*)x)->hdr.type) #define ASE_LSP_TYPE(x) (((ase_lsp_obj_t*)x)->hdr.type)
#define SSE_LSP_SIZE(x) (((sse_lsp_obj_t*)x)->hdr.size) #define ASE_LSP_SIZE(x) (((ase_lsp_obj_t*)x)->hdr.size)
#define SSE_LSP_MARK(x) (((sse_lsp_obj_t*)x)->hdr.mark) #define ASE_LSP_MARK(x) (((ase_lsp_obj_t*)x)->hdr.mark)
#define SSE_LSP_LOCK(x) (((sse_lsp_obj_t*)x)->hdr.lock) #define ASE_LSP_LOCK(x) (((ase_lsp_obj_t*)x)->hdr.lock)
#define SSE_LSP_LINK(x) (((sse_lsp_obj_t*)x)->hdr.link) #define ASE_LSP_LINK(x) (((ase_lsp_obj_t*)x)->hdr.link)
/* value access */ /* value access */
#define SSE_LSP_IVALUE(x) (((sse_lsp_obj_int_t*)x)->value) #define ASE_LSP_IVALUE(x) (((ase_lsp_obj_int_t*)x)->value)
#define SSE_LSP_RVALUE(x) (((sse_lsp_obj_real_t*)x)->value) #define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value)
#ifdef __BORLANDC__ #ifdef __BORLANDC__
#define SSE_LSP_SYMVALUE(x) ((sse_char_t*)(((sse_lsp_obj_symbol_t*)x) + 1)) #define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_symbol_t*)x) + 1))
#else #else
#define SSE_LSP_SYMVALUE(x) (((sse_lsp_obj_symbol_t*)x)->buffer) #define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_symbol_t*)x)->buffer)
#endif #endif
#define SSE_LSP_SYMLEN(x) ((((sse_lsp_obj_symbol_t*)x)->hdr.size - sizeof(sse_lsp_obj_t)) / sizeof(sse_char_t) - 1) #define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_symbol_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1)
#ifdef __BORLANDC__ #ifdef __BORLANDC__
#define SSE_LSP_STRVALUE(x) ((sse_char_t*)(((sse_lsp_obj_string_t*)x) + 1)) #define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_string_t*)x) + 1))
#else #else
#define SSE_LSP_STRVALUE(x) (((sse_lsp_obj_string_t*)x)->buffer) #define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_string_t*)x)->buffer)
#endif #endif
#define SSE_LSP_STRLEN(x) ((((sse_lsp_obj_string_t*)x)->hdr.size - sizeof(sse_lsp_obj_t)) / sizeof(sse_char_t) - 1) #define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_string_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1)
#define SSE_LSP_CAR(x) (((sse_lsp_obj_cons_t*)x)->car) #define ASE_LSP_CAR(x) (((ase_lsp_obj_cons_t*)x)->car)
#define SSE_LSP_CDR(x) (((sse_lsp_obj_cons_t*)x)->cdr) #define ASE_LSP_CDR(x) (((ase_lsp_obj_cons_t*)x)->cdr)
#define SSE_LSP_FFORMAL(x) (((sse_lsp_obj_func_t*)x)->formal) #define ASE_LSP_FFORMAL(x) (((ase_lsp_obj_func_t*)x)->formal)
#define SSE_LSP_FBODY(x) (((sse_lsp_obj_func_t*)x)->body) #define ASE_LSP_FBODY(x) (((ase_lsp_obj_func_t*)x)->body)
#define SSE_LSP_MFORMAL(x) (((sse_lsp_obj_macro_t*)x)->formal) #define ASE_LSP_MFORMAL(x) (((ase_lsp_obj_macro_t*)x)->formal)
#define SSE_LSP_MBODY(x) (((sse_lsp_obj_macro_t*)x)->body) #define ASE_LSP_MBODY(x) (((ase_lsp_obj_macro_t*)x)->body)
#define SSE_LSP_PRIM(x) ((sse_lsp_prim_t)(((sse_lsp_obj_prim_t*)x)->impl)) #define ASE_LSP_PRIM(x) ((ase_lsp_prim_t)(((ase_lsp_obj_prim_t*)x)->impl))
#endif #endif

350
ase/lsp/prim.c
View File

@ -1,80 +1,80 @@
/* /*
* $Id: prim.c,v 1.9 2006-10-22 13:10:46 bacon Exp $ * $Id: prim.c,v 1.10 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp.h> #include <ase/lsp/lsp.h>
#include <sse/lsp/mem.h> #include <ase/lsp/mem.h>
#include <sse/lsp/prim.h> #include <ase/lsp/prim.h>
#include <sse/bas/string.h> #include <ase/bas/string.h>
#include <sse/bas/assert.h> #include <ase/bas/assert.h>
static int __add_prim (sse_lsp_mem_t* mem, static int __add_prim (ase_lsp_mem_t* mem,
const sse_char_t* name, sse_size_t len, sse_lsp_prim_t prim); const ase_char_t* name, ase_size_t len, ase_lsp_prim_t prim);
int sse_lsp_add_prim ( int ase_lsp_add_prim (
sse_lsp_t* lsp, const sse_char_t* name, sse_lsp_prim_t prim) ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim)
{ {
return __add_prim (lsp->mem, name, sse_strlen(name), prim); return __add_prim (lsp->mem, name, ase_strlen(name), prim);
} }
int sse_lsp_remove_prim (sse_lsp_t* lsp, const sse_char_t* name) int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name)
{ {
// TODO: // TODO:
return -1; return -1;
} }
static int __add_prim (sse_lsp_mem_t* mem, static int __add_prim (ase_lsp_mem_t* mem,
const sse_char_t* name, sse_size_t len, sse_lsp_prim_t prim) const ase_char_t* name, ase_size_t len, ase_lsp_prim_t prim)
{ {
sse_lsp_obj_t* n, * p; ase_lsp_obj_t* n, * p;
n = sse_lsp_make_symbolx (mem, name, len); n = ase_lsp_make_symbolx (mem, name, len);
if (n == SSE_NULL) return -1; if (n == ASE_NULL) return -1;
sse_lsp_lock (n); ase_lsp_lock (n);
p = sse_lsp_make_prim (mem, prim); p = ase_lsp_make_prim (mem, prim);
if (p == SSE_NULL) return -1; if (p == ASE_NULL) return -1;
sse_lsp_unlock (n); ase_lsp_unlock (n);
if (sse_lsp_set_func(mem, n, p) == SSE_NULL) return -1; if (ase_lsp_set_func(mem, n, p) == ASE_NULL) return -1;
return 0; return 0;
} }
sse_lsp_obj_t* sse_lsp_prim_abort (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_abort (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
lsp->errnum = SSE_LSP_ERR_ABORT; lsp->errnum = ASE_LSP_ERR_ABORT;
return SSE_NULL; return ASE_NULL;
} }
sse_lsp_obj_t* sse_lsp_prim_eval (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
tmp = sse_lsp_eval (lsp, tmp); tmp = ase_lsp_eval (lsp, tmp);
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
return tmp; return tmp;
} }
sse_lsp_obj_t* sse_lsp_prim_gc (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
sse_lsp_garbage_collect (lsp->mem); ase_lsp_garbage_collect (lsp->mem);
return lsp->mem->nil; return lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_cond (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (cond * (cond
@ -84,181 +84,181 @@ sse_lsp_obj_t* sse_lsp_prim_cond (sse_lsp_t* lsp, sse_lsp_obj_t* args)
* (t resultN)) * (t resultN))
*/ */
sse_lsp_obj_t* tmp, * ret; ase_lsp_obj_t* tmp, * ret;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, ASE_LSP_PRIM_MAX_ARG_COUNT);
while (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) {
if (SSE_LSP_TYPE(SSE_LSP_CAR(args)) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(ASE_LSP_CAR(args)) != ASE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CAR(args))); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CAR(args)));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
tmp = SSE_LSP_CDR(SSE_LSP_CAR(args)); tmp = ASE_LSP_CDR(ASE_LSP_CAR(args));
ret = lsp->mem->nil; ret = lsp->mem->nil;
while (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS) {
ret = sse_lsp_eval (lsp, SSE_LSP_CAR(tmp)); ret = ase_lsp_eval (lsp, ASE_LSP_CAR(tmp));
if (ret == SSE_NULL) return SSE_NULL; if (ret == ASE_NULL) return ASE_NULL;
tmp = SSE_LSP_CDR(tmp); tmp = ASE_LSP_CDR(tmp);
} }
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
return ret; return ret;
} }
args = SSE_LSP_CDR(args); args = ASE_LSP_CDR(args);
} }
return lsp->mem->nil; return lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_if (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
return tmp; return tmp;
} }
else { else {
sse_lsp_obj_t* res = lsp->mem->nil; ase_lsp_obj_t* res = lsp->mem->nil;
tmp = SSE_LSP_CDR(SSE_LSP_CDR(args)); tmp = ASE_LSP_CDR(ASE_LSP_CDR(args));
while (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS) {
res = sse_lsp_eval (lsp, SSE_LSP_CAR(tmp)); res = ase_lsp_eval (lsp, ASE_LSP_CAR(tmp));
if (res == SSE_NULL) return SSE_NULL; if (res == ASE_NULL) return ASE_NULL;
tmp = SSE_LSP_CDR(tmp); tmp = ASE_LSP_CDR(tmp);
} }
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
return res; return res;
} }
} }
sse_lsp_obj_t* sse_lsp_prim_while (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (setq a 1) * (setq a 1)
* (while (< a 100) (setq a (+ a 1))) * (while (< a 100) (setq a (+ a 1)))
*/ */
sse_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
for (;;) { for (;;) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (tmp == lsp->mem->nil) break; if (tmp == lsp->mem->nil) break;
tmp = SSE_LSP_CDR(args); tmp = ASE_LSP_CDR(args);
while (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_CONS) {
if (sse_lsp_eval(lsp, SSE_LSP_CAR(tmp)) == SSE_NULL) if (ase_lsp_eval(lsp, ASE_LSP_CAR(tmp)) == ASE_NULL)
return SSE_NULL; return ASE_NULL;
tmp = SSE_LSP_CDR(tmp); tmp = ASE_LSP_CDR(tmp);
} }
if (tmp != lsp->mem->nil) { if (tmp != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
} }
return lsp->mem->nil; return lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_car (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (car '(10 20 30)) * (car '(10 20 30))
*/ */
sse_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (tmp == lsp->mem->nil) return lsp->mem->nil; if (tmp == lsp->mem->nil) return lsp->mem->nil;
if (SSE_LSP_TYPE(tmp) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(tmp) != ASE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
return SSE_LSP_CAR(tmp); return ASE_LSP_CAR(tmp);
} }
sse_lsp_obj_t* sse_lsp_prim_cdr (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (cdr '(10 20 30)) * (cdr '(10 20 30))
*/ */
sse_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (tmp == lsp->mem->nil) return lsp->mem->nil; if (tmp == lsp->mem->nil) return lsp->mem->nil;
if (SSE_LSP_TYPE(tmp) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(tmp) != ASE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
return SSE_LSP_CDR(tmp); return ASE_LSP_CDR(tmp);
} }
sse_lsp_obj_t* sse_lsp_prim_cons (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (cons 10 20) * (cons 10 20)
* (cons '(10 20) 30) * (cons '(10 20) 30)
*/ */
sse_lsp_obj_t* car, * cdr, * cons; ase_lsp_obj_t* car, * cdr, * cons;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
car = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); car = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (car == SSE_NULL) return SSE_NULL; if (car == ASE_NULL) return ASE_NULL;
cdr = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); cdr = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (cdr == SSE_NULL) return SSE_NULL; if (cdr == ASE_NULL) return ASE_NULL;
cons = sse_lsp_make_cons (lsp->mem, car, cdr); cons = ase_lsp_make_cons (lsp->mem, car, cdr);
if (cons == SSE_NULL) { if (cons == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return cons; return cons;
} }
sse_lsp_obj_t* sse_lsp_prim_set (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (set 'flowers 'rose) * (set 'flowers 'rose)
@ -266,79 +266,79 @@ sse_lsp_obj_t* sse_lsp_prim_set (sse_lsp_t* lsp, sse_lsp_obj_t* args)
* (rose) * (rose)
*/ */
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) != SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (sse_lsp_set_value (lsp->mem, p1, p2) == SSE_NULL) { if (ase_lsp_set_value (lsp->mem, p1, p2) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return p2; return p2;
} }
sse_lsp_obj_t* sse_lsp_prim_setq (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (setq x 10) * (setq x 10)
* (setq x "stirng") * (setq x "stirng")
*/ */
sse_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil; ase_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
while (p != lsp->mem->nil) { while (p != lsp->mem->nil) {
sse_assert (SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
p1 = SSE_LSP_CAR(p); p1 = ASE_LSP_CAR(p);
if (SSE_LSP_TYPE(p1) != SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
if (SSE_LSP_TYPE(SSE_LSP_CDR(p)) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(ASE_LSP_CDR(p)) != ASE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS; lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS;
return SSE_NULL; return ASE_NULL;
} }
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(p))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(p)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (sse_lsp_set_value (lsp->mem, p1, p2) == SSE_NULL) { if (ase_lsp_set_value (lsp->mem, p1, p2) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
p = SSE_LSP_CDR(SSE_LSP_CDR(p)); p = ASE_LSP_CDR(ASE_LSP_CDR(p));
} }
return p2; return p2;
} }
sse_lsp_obj_t* sse_lsp_prim_quote (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (quote (10 20 30 50)) * (quote (10 20 30 50))
*/ */
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
return SSE_LSP_CAR(args); return ASE_LSP_CAR(args);
} }
sse_lsp_obj_t* sse_lsp_prim_defun (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (defun x (a b) (+ a b 100)) * (defun x (a b) (+ a b 100))
@ -349,51 +349,51 @@ sse_lsp_obj_t* sse_lsp_prim_defun (sse_lsp_t* lsp, sse_lsp_obj_t* args)
* temp * temp
*/ */
sse_lsp_obj_t* name, * fun; ase_lsp_obj_t* name, * fun;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = SSE_LSP_CAR(args); name = ASE_LSP_CAR(args);
if (SSE_LSP_TYPE(name) != SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
fun = sse_lsp_make_func (lsp->mem, fun = ase_lsp_make_func (lsp->mem,
SSE_LSP_CAR(SSE_LSP_CDR(args)), SSE_LSP_CDR(SSE_LSP_CDR(args))); ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args)));
if (fun == SSE_NULL) return SSE_NULL; if (fun == ASE_NULL) return ASE_NULL;
if (sse_lsp_set_func (lsp->mem, SSE_LSP_CAR(args), fun) == SSE_NULL) { if (ase_lsp_set_func (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return fun; return fun;
} }
sse_lsp_obj_t* sse_lsp_prim_demac (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (demac x (abc) x y z) * (demac x (abc) x y z)
*(setq x (macro (abc) x y z)) *(setq x (macro (abc) x y z))
*/ */
sse_lsp_obj_t* name, * mac; ase_lsp_obj_t* name, * mac;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, ASE_LSP_PRIM_MAX_ARG_COUNT);
name = SSE_LSP_CAR(args); name = ASE_LSP_CAR(args);
if (SSE_LSP_TYPE(name) != SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(name) != ASE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
return SSE_NULL; return ASE_NULL;
} }
mac = sse_lsp_make_macro (lsp->mem, mac = ase_lsp_make_macro (lsp->mem,
SSE_LSP_CAR(SSE_LSP_CDR(args)), SSE_LSP_CDR(SSE_LSP_CDR(args))); ASE_LSP_CAR(ASE_LSP_CDR(args)), ASE_LSP_CDR(ASE_LSP_CDR(args)));
if (mac == SSE_NULL) return SSE_NULL; if (mac == ASE_NULL) return ASE_NULL;
if (sse_lsp_set_func (lsp->mem, SSE_LSP_CAR(args), mac) == SSE_NULL) { if (ase_lsp_set_func (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return mac; return mac;
} }

86
ase/lsp/prim.h
View File

@ -1,76 +1,76 @@
/* /*
* $Id: prim.h,v 1.7 2006-10-23 14:42:38 bacon Exp $ * $Id: prim.h,v 1.8 2006-10-24 04:22:39 bacon Exp $
*/ */
#ifndef _SSE_LSP_PRIM_H_ #ifndef _ASE_LSP_PRIM_H_
#define _SSE_LSP_PRIM_H_ #define _ASE_LSP_PRIM_H_
#include <sse/lsp/lsp.h> #include <ase/lsp/lsp.h>
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_obj_t* sse_lsp_prim_abort (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_abort (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_eval (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_prog1 (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_progn (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_gc (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_cond (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_cond (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_if (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_while (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_car (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_cdr (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_cons (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_set (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_setq (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_quote (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_defun (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_demac (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_let (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_let (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_letx (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_letx (ase_lsp_t* lsp, ase_lsp_obj_t* args);
/*--------------------- /*---------------------
prim_compar.c prim_compar.c
---------------------*/ ---------------------*/
sse_lsp_obj_t* sse_lsp_prim_eq (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_ne (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_gt (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_lt (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_ge (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_le (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args);
/*--------------------- /*---------------------
prim_math.c prim_math.c
---------------------*/ ---------------------*/
sse_lsp_obj_t* sse_lsp_prim_plus (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_minus (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_multiply (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_divide (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_modulus (sse_lsp_t* lsp, sse_lsp_obj_t* args); ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args);
#ifdef __cplusplus #ifdef __cplusplus
} }
#endif #endif
#define SSE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \ #define ASE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \
{ \ { \
sse_size_t count; \ ase_size_t count; \
if (sse_lsp_probe_args(lsp->mem, args, &count) == -1) { \ if (ase_lsp_probe_args(lsp->mem, args, &count) == -1) { \
lsp->errnum = SSE_LSP_ERR_BAD_ARG; \ lsp->errnum = ASE_LSP_ERR_BAD_ARG; \
return SSE_NULL; \ return ASE_NULL; \
} \ } \
if (count < min) { \ if (count < min) { \
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS; \ lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS; \
return SSE_NULL; \ return ASE_NULL; \
} \ } \
if (count > max) { \ if (count > max) { \
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS; \ lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; \
return SSE_NULL; \ return ASE_NULL; \
} \ } \
} }
#define SSE_LSP_PRIM_MAX_ARG_COUNT ((sse_size_t)~(sse_size_t)0) #define ASE_LSP_PRIM_MAX_ARG_COUNT ((ase_size_t)~(ase_size_t)0)
#endif #endif

438
ase/lsp/prim_compar.c
View File

@ -1,407 +1,407 @@
/* /*
* $Id: prim_compar.c,v 1.3 2006-10-22 13:10:46 bacon Exp $ * $Id: prim_compar.c,v 1.4 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/prim.h> #include <ase/lsp/prim.h>
#include <sse/bas/assert.h> #include <ase/bas/assert.h>
sse_lsp_obj_t* sse_lsp_prim_eq (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
int res; int res;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1.... // TODO: lock p1....
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) == SSE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) == ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) == SSE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) == ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) == SSE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) == ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) == SSE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) == ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 ( res = ase_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) == 0; p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 ( res = ase_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) == 0; p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) == 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
return (res)? lsp->mem->t: lsp->mem->nil; return (res)? lsp->mem->t: lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_ne (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
int res; int res;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1.... // TODO: lock p1....
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) != SSE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) != ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) != SSE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) != ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) != SSE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) != ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) != SSE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) != ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 ( res = ase_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) != 0; p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 ( res = ase_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) != 0; p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) != 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
return (res)? lsp->mem->t: lsp->mem->nil; return (res)? lsp->mem->t: lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_gt (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
int res; int res;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1.... // TODO: lock p1....
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) > SSE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) > ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) > SSE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) > ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) > SSE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) > ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) > SSE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) > ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 ( res = ase_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) > 0; p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 ( res = ase_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) > 0; p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) > 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
return (res)? lsp->mem->t: lsp->mem->nil; return (res)? lsp->mem->t: lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_lt (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
int res; int res;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1.... // TODO: lock p1....
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) < SSE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) < ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) < SSE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) < ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) < SSE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) < ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) < SSE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) < ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 ( res = ase_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) < 0; p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 ( res = ase_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) < 0; p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) < 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
return (res)? lsp->mem->t: lsp->mem->nil; return (res)? lsp->mem->t: lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_ge (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
int res; int res;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1.... // TODO: lock p1....
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) >= SSE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) >= ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) >= SSE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) >= ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) >= SSE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) >= ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) >= SSE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) >= ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 ( res = ase_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) >= 0; p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 ( res = ase_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) >= 0; p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) >= 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
return (res)? lsp->mem->t: lsp->mem->nil; return (res)? lsp->mem->t: lsp->mem->nil;
} }
sse_lsp_obj_t* sse_lsp_prim_le (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
int res; int res;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
// TODO: lock p1.... // TODO: lock p1....
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args))); p2 = ase_lsp_eval (lsp, ASE_LSP_CAR(ASE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) <= SSE_LSP_IVALUE(p2); res = ASE_LSP_IVALUE(p1) <= ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) <= SSE_LSP_RVALUE(p2); res = ASE_LSP_IVALUE(p1) <= ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) <= SSE_LSP_IVALUE(p2); res = ASE_LSP_RVALUE(p1) <= ASE_LSP_IVALUE(p2);
} }
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) <= SSE_LSP_RVALUE(p2); res = ASE_LSP_RVALUE(p1) <= ASE_LSP_RVALUE(p2);
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 ( res = ase_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) <= 0; p1, ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) { else if (ASE_LSP_TYPE(p1) == ASE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) { if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 ( res = ase_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) <= 0; p1, ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) <= 0;
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
return (res)? lsp->mem->t: lsp->mem->nil; return (res)? lsp->mem->t: lsp->mem->nil;

126
ase/lsp/prim_let.c
View File

@ -1,24 +1,24 @@
/* /*
* $Id: prim_let.c,v 1.4 2006-10-22 13:10:46 bacon Exp $ * $Id: prim_let.c,v 1.5 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/prim.h> #include <ase/lsp/prim.h>
static sse_lsp_obj_t* __prim_let ( static ase_lsp_obj_t* __prim_let (
sse_lsp_t* lsp, sse_lsp_obj_t* args, int sequential) ase_lsp_t* lsp, ase_lsp_obj_t* args, int sequential)
{ {
sse_lsp_frame_t* frame; ase_lsp_frame_t* frame;
sse_lsp_obj_t* assoc; ase_lsp_obj_t* assoc;
sse_lsp_obj_t* body; ase_lsp_obj_t* body;
sse_lsp_obj_t* value; ase_lsp_obj_t* value;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
// create a new frame // create a new frame
frame = sse_lsp_frame_new (); frame = ase_lsp_frame_new ();
if (frame == SSE_NULL) { if (frame == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
//frame->link = lsp->mem->frame; //frame->link = lsp->mem->frame;
@ -31,87 +31,87 @@ static sse_lsp_obj_t* __prim_let (
lsp->mem->brooding_frame = frame; lsp->mem->brooding_frame = frame;
} }
assoc = SSE_LSP_CAR(args); assoc = ASE_LSP_CAR(args);
//while (assoc != lsp->mem->nil) { //while (assoc != lsp->mem->nil) {
while (SSE_LSP_TYPE(assoc) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(assoc) == ASE_LSP_OBJ_CONS) {
sse_lsp_obj_t* ass = SSE_LSP_CAR(assoc); ase_lsp_obj_t* ass = ASE_LSP_CAR(assoc);
if (SSE_LSP_TYPE(ass) == SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_CONS) {
sse_lsp_obj_t* n = SSE_LSP_CAR(ass); ase_lsp_obj_t* n = ASE_LSP_CAR(ass);
sse_lsp_obj_t* v = SSE_LSP_CDR(ass); ase_lsp_obj_t* v = ASE_LSP_CDR(ass);
if (SSE_LSP_TYPE(n) != SSE_LSP_OBJ_SYMBOL) { if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
if (v != lsp->mem->nil) { if (v != lsp->mem->nil) {
if (SSE_LSP_CDR(v) != lsp->mem->nil) { if (ASE_LSP_CDR(v) != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS; // must be a symbol lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; // 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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
if ((v = sse_lsp_eval(lsp, SSE_LSP_CAR(v))) == SSE_NULL) { if ((v = ase_lsp_eval(lsp, ASE_LSP_CAR(v))) == ASE_NULL) {
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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
} }
if (sse_lsp_frame_lookup (frame, n) != SSE_NULL) { if (ase_lsp_frame_lookup (frame, n) != ASE_NULL) {
lsp->errnum = SSE_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;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
if (sse_lsp_frame_insert_value(frame, n, v) == SSE_NULL) { if (ase_lsp_frame_insert_value(frame, n, v) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
} }
else if (SSE_LSP_TYPE(ass) == SSE_LSP_OBJ_SYMBOL) { else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYMBOL) {
if (sse_lsp_frame_lookup(frame, ass) != SSE_NULL) { if (ase_lsp_frame_lookup(frame, ass) != ASE_NULL) {
lsp->errnum = SSE_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;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
if (sse_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == SSE_NULL) { if (ase_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
assoc = SSE_LSP_CDR(assoc); assoc = ASE_LSP_CDR(assoc);
} }
if (assoc != lsp->mem->nil) { if (assoc != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
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;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
// push the frame // push the frame
@ -123,26 +123,26 @@ static sse_lsp_obj_t* __prim_let (
// evaluate forms in the body // evaluate forms in the body
value = lsp->mem->nil; value = lsp->mem->nil;
body = SSE_LSP_CDR(args); body = ASE_LSP_CDR(args);
while (body != lsp->mem->nil) { while (body != lsp->mem->nil) {
value = sse_lsp_eval (lsp, SSE_LSP_CAR(body)); value = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (value == SSE_NULL) { if (value == ASE_NULL) {
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
// pop the frame // pop the frame
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
// destroy the frame // destroy the frame
sse_lsp_frame_free (frame); ase_lsp_frame_free (frame);
return value; return value;
} }
sse_lsp_obj_t* sse_lsp_prim_let (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_let (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
/* /*
* (defun x (x y) * (defun x (x y)
@ -154,7 +154,7 @@ sse_lsp_obj_t* sse_lsp_prim_let (sse_lsp_t* lsp, sse_lsp_obj_t* args)
return __prim_let (lsp, args, 0); return __prim_let (lsp, args, 0);
} }
sse_lsp_obj_t* sse_lsp_prim_letx (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_letx (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
return __prim_let (lsp, args, 1); return __prim_let (lsp, args, 1);
} }

318
ase/lsp/prim_math.c
View File

@ -1,331 +1,331 @@
/* /*
* $Id: prim_math.c,v 1.7 2006-10-22 13:10:46 bacon Exp $ * $Id: prim_math.c,v 1.8 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/prim.h> #include <ase/lsp/prim.h>
#include <sse/bas/assert.h> #include <ase/bas/assert.h>
sse_lsp_obj_t* sse_lsp_prim_plus (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0; ase_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0; ase_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false; ase_bool_t realnum = ase_false;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
/*lsp->errnum = SSE_LSP_ERR_BAD_VALUE; */ /*lsp->errnum = ASE_LSP_ERR_BAD_VALUE; */
return SSE_NULL; return ASE_NULL;
} }
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
ivalue = SSE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
if (!realnum) if (!realnum)
ivalue = ivalue + SSE_LSP_IVALUE(tmp); ivalue = ivalue + ASE_LSP_IVALUE(tmp);
else else
rvalue = rvalue + SSE_LSP_IVALUE(tmp); rvalue = rvalue + ASE_LSP_IVALUE(tmp);
} }
} }
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
realnum = sse_true; realnum = ase_true;
rvalue = SSE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else {
if (!realnum) { if (!realnum) {
realnum = sse_true; realnum = ase_true;
rvalue = (sse_lsp_real_t)ivalue; rvalue = (ase_lsp_real_t)ivalue;
} }
rvalue = rvalue + SSE_LSP_RVALUE(tmp); rvalue = rvalue + ASE_LSP_RVALUE(tmp);
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
sse_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
sse_lsp_make_real (lsp->mem, rvalue): ase_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue); ase_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return tmp; return tmp;
} }
sse_lsp_obj_t* sse_lsp_prim_minus (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0; ase_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0; ase_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false; ase_bool_t realnum = ase_false;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
ivalue = SSE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
if (!realnum) if (!realnum)
ivalue = ivalue - SSE_LSP_IVALUE(tmp); ivalue = ivalue - ASE_LSP_IVALUE(tmp);
else else
rvalue = rvalue - SSE_LSP_IVALUE(tmp); rvalue = rvalue - ASE_LSP_IVALUE(tmp);
} }
} }
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
realnum = sse_true; realnum = ase_true;
rvalue = SSE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else {
if (!realnum) { if (!realnum) {
realnum = sse_true; realnum = ase_true;
rvalue = (sse_lsp_real_t)ivalue; rvalue = (ase_lsp_real_t)ivalue;
} }
rvalue = rvalue - SSE_LSP_RVALUE(tmp); rvalue = rvalue - ASE_LSP_RVALUE(tmp);
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
sse_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
sse_lsp_make_real (lsp->mem, rvalue): ase_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue); ase_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return tmp; return tmp;
} }
sse_lsp_obj_t* sse_lsp_prim_multiply (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0; ase_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0; ase_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false; ase_bool_t realnum = ase_false;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
ivalue = SSE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
if (!realnum) if (!realnum)
ivalue = ivalue * SSE_LSP_IVALUE(tmp); ivalue = ivalue * ASE_LSP_IVALUE(tmp);
else else
rvalue = rvalue * SSE_LSP_IVALUE(tmp); rvalue = rvalue * ASE_LSP_IVALUE(tmp);
} }
} }
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
realnum = sse_true; realnum = ase_true;
rvalue = SSE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else {
if (!realnum) { if (!realnum) {
realnum = sse_true; realnum = ase_true;
rvalue = (sse_lsp_real_t)ivalue; rvalue = (ase_lsp_real_t)ivalue;
} }
rvalue = rvalue * SSE_LSP_RVALUE(tmp); rvalue = rvalue * ASE_LSP_RVALUE(tmp);
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
sse_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
sse_lsp_make_real (lsp->mem, rvalue): ase_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue); ase_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return tmp; return tmp;
} }
sse_lsp_obj_t* sse_lsp_prim_divide (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0; ase_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0; ase_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false; ase_bool_t realnum = ase_false;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
ivalue = SSE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
if (!realnum) { if (!realnum) {
if (SSE_LSP_IVALUE(tmp) == 0) { if (ASE_LSP_IVALUE(tmp) == 0) {
lsp->errnum = SSE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO;
return SSE_NULL; return ASE_NULL;
} }
ivalue = ivalue / SSE_LSP_IVALUE(tmp); ivalue = ivalue / ASE_LSP_IVALUE(tmp);
} }
else else
rvalue = rvalue / SSE_LSP_IVALUE(tmp); rvalue = rvalue / ASE_LSP_IVALUE(tmp);
} }
} }
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
sse_assert (realnum == sse_false); ase_assert (realnum == ase_false);
realnum = sse_true; realnum = ase_true;
rvalue = SSE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
else { else {
if (!realnum) { if (!realnum) {
realnum = sse_true; realnum = ase_true;
rvalue = (sse_lsp_real_t)ivalue; rvalue = (ase_lsp_real_t)ivalue;
} }
rvalue = rvalue / SSE_LSP_RVALUE(tmp); rvalue = rvalue / ASE_LSP_RVALUE(tmp);
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
sse_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
sse_lsp_make_real (lsp->mem, rvalue): ase_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue); ase_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return tmp; return tmp;
} }
sse_lsp_obj_t* sse_lsp_prim_modulus (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* body, * tmp; ase_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0; ase_lsp_int_t ivalue = 0;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS); ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(body) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
ivalue = SSE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
if (SSE_LSP_IVALUE(tmp) == 0) { if (ASE_LSP_IVALUE(tmp) == 0) {
lsp->errnum = SSE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO;
return SSE_NULL; return ASE_NULL;
} }
ivalue = ivalue % SSE_LSP_IVALUE(tmp); ivalue = ivalue % ASE_LSP_IVALUE(tmp);
} }
} }
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
ivalue = (sse_lsp_int_t)SSE_LSP_RVALUE(tmp); ivalue = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp);
} }
else { else {
sse_lsp_int_t tmpi = (sse_lsp_int_t)SSE_LSP_RVALUE(tmp); ase_lsp_int_t tmpi = (ase_lsp_int_t)ASE_LSP_RVALUE(tmp);
if (tmpi == 0) { if (tmpi == 0) {
lsp->errnum = SSE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO;
return SSE_NULL; return ASE_NULL;
} }
ivalue = ivalue % tmpi; ivalue = ivalue % tmpi;
} }
} }
else { else {
lsp->errnum = SSE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
return SSE_NULL; return ASE_NULL;
} }
body = SSE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
sse_assert (body == lsp->mem->nil); ase_assert (body == lsp->mem->nil);
tmp = sse_lsp_make_int (lsp->mem, ivalue); tmp = ase_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
return tmp; return tmp;

38
ase/lsp/prim_prog.c
View File

@ -1,49 +1,49 @@
/* /*
* $Id: prim_prog.c,v 1.2 2006-10-22 13:10:46 bacon Exp $ * $Id: prim_prog.c,v 1.3 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/prim.h> #include <ase/lsp/prim.h>
sse_lsp_obj_t* sse_lsp_prim_prog1 (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* res = SSE_NULL, * tmp; ase_lsp_obj_t* res = ASE_NULL, * tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
//while (args != lsp->mem->nil) { //while (args != lsp->mem->nil) {
while (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
if (res == SSE_NULL) { if (res == ASE_NULL) {
/* /*
sse_lsp_array_t* ta = lsp->mem->temp_array; ase_lsp_array_t* ta = lsp->mem->temp_array;
sse_lsp_array_insert (ta, ta->size, tmp); ase_lsp_array_insert (ta, ta->size, tmp);
*/ */
res = tmp; res = tmp;
} }
args = SSE_LSP_CDR(args); args = ASE_LSP_CDR(args);
} }
return res; return res;
} }
sse_lsp_obj_t* sse_lsp_prim_progn (sse_lsp_t* lsp, sse_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_progn (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
sse_lsp_obj_t* res, * tmp; ase_lsp_obj_t* res, * tmp;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
res = lsp->mem->nil; res = lsp->mem->nil;
//while (args != lsp->mem->nil) { //while (args != lsp->mem->nil) {
while (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
res = tmp; res = tmp;
args = SSE_LSP_CDR(args); args = ASE_LSP_CDR(args);
} }
return res; return res;

198
ase/lsp/print.c
View File

@ -1,174 +1,174 @@
/* /*
* $Id: print.c,v 1.13 2006-10-22 13:10:46 bacon Exp $ * $Id: print.c,v 1.14 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp.h> #include <ase/lsp/lsp.h>
#include <sse/bas/stdio.h> #include <ase/bas/stdio.h>
#include <sse/bas/string.h> #include <ase/bas/string.h>
void sse_lsp_print_debug (sse_lsp_obj_t* obj) void ase_lsp_print_debug (ase_lsp_obj_t* obj)
{ {
switch (SSE_LSP_TYPE(obj)) { switch (ASE_LSP_TYPE(obj)) {
case SSE_LSP_OBJ_NIL: case ASE_LSP_OBJ_NIL:
sse_printf (SSE_TEXT("nil")); ase_printf (ASE_TEXT("nil"));
break; break;
case SSE_LSP_OBJ_TRUE: case ASE_LSP_OBJ_TRUE:
sse_printf (SSE_TEXT("t")); ase_printf (ASE_TEXT("t"));
break; break;
case SSE_LSP_OBJ_INT: case ASE_LSP_OBJ_INT:
sse_printf (SSE_TEXT("%d"), SSE_LSP_IVALUE(obj)); ase_printf (ASE_TEXT("%d"), ASE_LSP_IVALUE(obj));
break; break;
case SSE_LSP_OBJ_REAL: case ASE_LSP_OBJ_REAL:
sse_printf (SSE_TEXT("%f"), SSE_LSP_RVALUE(obj)); ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj));
break; break;
case SSE_LSP_OBJ_SYMBOL: case ASE_LSP_OBJ_SYMBOL:
sse_printf (SSE_TEXT("%s"), SSE_LSP_SYMVALUE(obj)); ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj));
break; break;
case SSE_LSP_OBJ_STRING: case ASE_LSP_OBJ_STRING:
sse_printf (SSE_TEXT("%s"), SSE_LSP_STRVALUE(obj)); ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj));
break; break;
case SSE_LSP_OBJ_CONS: case ASE_LSP_OBJ_CONS:
{ {
sse_lsp_obj_t* p = obj; ase_lsp_obj_t* p = obj;
sse_printf (SSE_TEXT("(")); ase_printf (ASE_TEXT("("));
do { do {
sse_lsp_print_debug (SSE_LSP_CAR(p)); ase_lsp_print_debug (ASE_LSP_CAR(p));
p = SSE_LSP_CDR(p); p = ASE_LSP_CDR(p);
if (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_NIL) { if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL) {
sse_printf (SSE_TEXT(" ")); ase_printf (ASE_TEXT(" "));
if (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) {
sse_printf (SSE_TEXT(". ")); ase_printf (ASE_TEXT(". "));
sse_lsp_print_debug (p); ase_lsp_print_debug (p);
} }
} }
} while (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_NIL && SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS); } while (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
sse_printf (SSE_TEXT(")")); ase_printf (ASE_TEXT(")"));
} }
break; break;
case SSE_LSP_OBJ_FUNC: case ASE_LSP_OBJ_FUNC:
sse_printf (SSE_TEXT("func")); ase_printf (ASE_TEXT("func"));
break; break;
case SSE_LSP_OBJ_MACRO: case ASE_LSP_OBJ_MACRO:
sse_printf (SSE_TEXT("macro")); ase_printf (ASE_TEXT("macro"));
break; break;
case SSE_LSP_OBJ_PRIM: case ASE_LSP_OBJ_PRIM:
sse_printf (SSE_TEXT("prim")); ase_printf (ASE_TEXT("prim"));
break; break;
default: default:
sse_printf (SSE_TEXT("unknown object type: %d"), SSE_LSP_TYPE(obj)); ase_printf (ASE_TEXT("unknown object type: %d"), ASE_LSP_TYPE(obj));
} }
} }
#define OUTPUT_STR(lsp,str) \ #define OUTPUT_STR(lsp,str) \
do { \ do { \
if (lsp->output_func(SSE_LSP_IO_DATA, lsp->output_arg, (sse_char_t*)str, sse_strlen(str)) == -1) { \ if (lsp->output_func(ASE_LSP_IO_DATA, lsp->output_arg, (ase_char_t*)str, ase_strlen(str)) == -1) { \
lsp->errnum = SSE_LSP_ERR_OUTPUT; \ lsp->errnum = ASE_LSP_ERR_OUTPUT; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
#define OUTPUT_STRX(lsp,str,len) \ #define OUTPUT_STRX(lsp,str,len) \
do { \ do { \
if (lsp->output_func(SSE_LSP_IO_DATA, lsp->output_arg, (sse_char_t*)str, len) == -1) { \ if (lsp->output_func(ASE_LSP_IO_DATA, lsp->output_arg, (ase_char_t*)str, len) == -1) { \
lsp->errnum = SSE_LSP_ERR_OUTPUT; \ lsp->errnum = ASE_LSP_ERR_OUTPUT; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
static int __print (sse_lsp_t* lsp, const sse_lsp_obj_t* obj, sse_bool_t prt_cons_par) static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_cons_par)
{ {
sse_char_t buf[256]; ase_char_t buf[256];
if (lsp->output_func == SSE_NULL) { if (lsp->output_func == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_OUTPUT_NOT_ATTACHED; lsp->errnum = ASE_LSP_ERR_OUTPUT_NOT_ATTACHED;
return -1; return -1;
} }
switch (SSE_LSP_TYPE(obj)) { switch (ASE_LSP_TYPE(obj)) {
case SSE_LSP_OBJ_NIL: case ASE_LSP_OBJ_NIL:
OUTPUT_STR (lsp, SSE_TEXT("nil")); OUTPUT_STR (lsp, ASE_TEXT("nil"));
break; break;
case SSE_LSP_OBJ_TRUE: case ASE_LSP_OBJ_TRUE:
OUTPUT_STR (lsp, SSE_TEXT("t")); OUTPUT_STR (lsp, ASE_TEXT("t"));
break; break;
case SSE_LSP_OBJ_INT: case ASE_LSP_OBJ_INT:
if (sse_sizeof(sse_lsp_int_t) == sse_sizeof(int)) { if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(int)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%d"), SSE_LSP_IVALUE(obj)); ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%d"), ASE_LSP_IVALUE(obj));
} }
else if (sse_sizeof(sse_lsp_int_t) == sse_sizeof(long)) { else if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(long)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%ld"), SSE_LSP_IVALUE(obj)); ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%ld"), ASE_LSP_IVALUE(obj));
} }
else if (sse_sizeof(sse_lsp_int_t) == sse_sizeof(long long)) { else if (ase_sizeof(ase_lsp_int_t) == ase_sizeof(long long)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%lld"), SSE_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 SSE_LSP_OBJ_REAL: case ASE_LSP_OBJ_REAL:
if (sse_sizeof(sse_lsp_real_t) == sse_sizeof(double)) { if (ase_sizeof(ase_lsp_real_t) == ase_sizeof(double)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%f"), ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%f"),
(double)SSE_LSP_RVALUE(obj)); (double)ASE_LSP_RVALUE(obj));
} }
else if (sse_sizeof(sse_lsp_real_t) == sse_sizeof(long double)) { else if (ase_sizeof(ase_lsp_real_t) == ase_sizeof(long double)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%Lf"), ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%Lf"),
(long double)SSE_LSP_RVALUE(obj)); (long double)ASE_LSP_RVALUE(obj));
} }
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
break; break;
case SSE_LSP_OBJ_SYMBOL: case ASE_LSP_OBJ_SYMBOL:
OUTPUT_STR (lsp, SSE_LSP_SYMVALUE(obj)); OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj));
break; break;
case SSE_LSP_OBJ_STRING: case ASE_LSP_OBJ_STRING:
OUTPUT_STR (lsp, SSE_LSP_STRVALUE(obj)); OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj));
break; break;
case SSE_LSP_OBJ_CONS: case ASE_LSP_OBJ_CONS:
{ {
const sse_lsp_obj_t* p = obj; const ase_lsp_obj_t* p = obj;
if (prt_cons_par) OUTPUT_STR (lsp, SSE_TEXT("(")); if (prt_cons_par) OUTPUT_STR (lsp, ASE_TEXT("("));
do { do {
sse_lsp_print (lsp, SSE_LSP_CAR(p)); ase_lsp_print (lsp, ASE_LSP_CAR(p));
p = SSE_LSP_CDR(p); p = ASE_LSP_CDR(p);
if (p != lsp->mem->nil) { if (p != lsp->mem->nil) {
OUTPUT_STR (lsp, SSE_TEXT(" ")); OUTPUT_STR (lsp, ASE_TEXT(" "));
if (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) {
OUTPUT_STR (lsp, SSE_TEXT(". ")); OUTPUT_STR (lsp, ASE_TEXT(". "));
sse_lsp_print (lsp, p); ase_lsp_print (lsp, p);
} }
} }
} while (p != lsp->mem->nil && SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS); } while (p != lsp->mem->nil && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
if (prt_cons_par) OUTPUT_STR (lsp, SSE_TEXT(")")); if (prt_cons_par) OUTPUT_STR (lsp, ASE_TEXT(")"));
} }
break; break;
case SSE_LSP_OBJ_FUNC: case ASE_LSP_OBJ_FUNC:
/*OUTPUT_STR (lsp, SSE_TEXT("func"));*/ /*OUTPUT_STR (lsp, ASE_TEXT("func"));*/
OUTPUT_STR (lsp, SSE_TEXT("(lambda ")); OUTPUT_STR (lsp, ASE_TEXT("(lambda "));
if (__print (lsp, SSE_LSP_FFORMAL(obj), sse_true) == -1) return -1; if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(" ")); OUTPUT_STR (lsp, ASE_TEXT(" "));
if (__print (lsp, SSE_LSP_FBODY(obj), sse_false) == -1) return -1; if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(")")); OUTPUT_STR (lsp, ASE_TEXT(")"));
break; break;
case SSE_LSP_OBJ_MACRO: case ASE_LSP_OBJ_MACRO:
/*OUTPUT_STR (lsp, SSE_TEXT("macro"));*/ /*OUTPUT_STR (lsp, ASE_TEXT("macro"));*/
OUTPUT_STR (lsp, SSE_TEXT("(macro ")); OUTPUT_STR (lsp, ASE_TEXT("(macro "));
if (__print (lsp, SSE_LSP_FFORMAL(obj), sse_true) == -1) return -1; if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(" ")); OUTPUT_STR (lsp, ASE_TEXT(" "));
if (__print (lsp, SSE_LSP_FBODY(obj), sse_false) == -1) return -1; if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(")")); OUTPUT_STR (lsp, ASE_TEXT(")"));
break; break;
case SSE_LSP_OBJ_PRIM: case ASE_LSP_OBJ_PRIM:
OUTPUT_STR (lsp, SSE_TEXT("prim")); OUTPUT_STR (lsp, ASE_TEXT("prim"));
break; break;
default: default:
sse_sprintf (buf, sse_countof(buf), ase_sprintf (buf, ase_countof(buf),
SSE_TEXT("unknown object type: %d"), SSE_LSP_TYPE(obj)); ASE_TEXT("unknown object type: %d"), ASE_LSP_TYPE(obj));
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
} }
return 0; return 0;
} }
int sse_lsp_print (sse_lsp_t* lsp, const sse_lsp_obj_t* obj) int ase_lsp_print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj)
{ {
return __print (lsp, obj, sse_true); return __print (lsp, obj, ase_true);
} }

292
ase/lsp/read.c
View File

@ -1,26 +1,26 @@
/* /*
* $Id: read.c,v 1.19 2006-10-23 14:44:43 bacon Exp $ * $Id: read.c,v 1.20 2006-10-24 04:22:39 bacon Exp $
*/ */
#include <sse/lsp/lsp.h> #include <ase/lsp/lsp.h>
#include <sse/lsp/token.h> #include <ase/lsp/token.h>
#include <sse/bas/assert.h> #include <ase/bas/assert.h>
#include <sse/bas/ctype.h> #include <ase/bas/ctype.h>
#define IS_SPACE(x) sse_isspace(x) #define IS_SPACE(x) ase_isspace(x)
#define IS_DIGIT(x) sse_isdigit(x) #define IS_DIGIT(x) ase_isdigit(x)
#define IS_ALPHA(x) sse_isalpha(x) #define IS_ALPHA(x) ase_isalpha(x)
#define IS_ALNUM(x) sse_isalnum(x) #define IS_ALNUM(x) ase_isalnum(x)
#define IS_IDENT(c) \ #define IS_IDENT(c) \
((c) == SSE_T('+') || (c) == SSE_T('-') || \ ((c) == ASE_T('+') || (c) == ASE_T('-') || \
(c) == SSE_T('*') || (c) == SSE_T('/') || \ (c) == ASE_T('*') || (c) == ASE_T('/') || \
(c) == SSE_T('%') || (c) == SSE_T('&') || \ (c) == ASE_T('%') || (c) == ASE_T('&') || \
(c) == SSE_T('<') || (c) == SSE_T('>') || \ (c) == ASE_T('<') || (c) == ASE_T('>') || \
(c) == SSE_T('=') || (c) == SSE_T('_') || \ (c) == ASE_T('=') || (c) == ASE_T('_') || \
(c) == SSE_T('?')) (c) == ASE_T('?'))
#define TOKEN_CLEAR(lsp) sse_lsp_token_clear (&(lsp)->token) #define TOKEN_CLEAR(lsp) ase_lsp_token_clear (&(lsp)->token)
#define TOKEN_TYPE(lsp) (lsp)->token.type #define TOKEN_TYPE(lsp) (lsp)->token.type
#define TOKEN_IVALUE(lsp) (lsp)->token.ivalue #define TOKEN_IVALUE(lsp) (lsp)->token.ivalue
#define TOKEN_RVALUE(lsp) (lsp)->token.rvalue #define TOKEN_RVALUE(lsp) (lsp)->token.rvalue
@ -28,13 +28,13 @@
#define TOKEN_SLENGTH(lsp) (lsp)->token.name.size #define TOKEN_SLENGTH(lsp) (lsp)->token.name.size
#define TOKEN_ADD_CHAR(lsp,ch) do { \ #define TOKEN_ADD_CHAR(lsp,ch) do { \
if (sse_lsp_token_addc(&(lsp)->token, ch) == -1) { \ if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \
lsp->errnum = SSE_LSP_ERR_MEMORY; \ lsp->errnum = ASE_LSP_ERR_MEMORY; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
#define TOKEN_COMPARE(lsp,str) sse_lsp_token_compare_name (&(lsp)->token, str) #define TOKEN_COMPARE(lsp,str) ase_lsp_token_compare_name (&(lsp)->token, str)
#define TOKEN_END 0 #define TOKEN_END 0
#define TOKEN_INT 1 #define TOKEN_INT 1
@ -52,42 +52,42 @@
do { if (read_char(lsp) == -1) return -1;} while (0) do { if (read_char(lsp) == -1) return -1;} while (0)
#define NEXT_TOKEN(lsp) \ #define NEXT_TOKEN(lsp) \
do { if (read_token(lsp) == -1) return SSE_NULL; } while (0) do { if (read_token(lsp) == -1) return ASE_NULL; } while (0)
static sse_lsp_obj_t* read_obj (sse_lsp_t* lsp); static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp);
static sse_lsp_obj_t* read_list (sse_lsp_t* lsp); static ase_lsp_obj_t* read_list (ase_lsp_t* lsp);
static sse_lsp_obj_t* read_quote (sse_lsp_t* lsp); static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp);
static int read_char (sse_lsp_t* lsp); static int read_char (ase_lsp_t* lsp);
static int read_token (sse_lsp_t* lsp); static int read_token (ase_lsp_t* lsp);
static int read_number (sse_lsp_t* lsp, int negative); static int read_number (ase_lsp_t* lsp, int negative);
static int read_ident (sse_lsp_t* lsp); static int read_ident (ase_lsp_t* lsp);
static int read_string (sse_lsp_t* lsp); static int read_string (ase_lsp_t* lsp);
sse_lsp_obj_t* sse_lsp_read (sse_lsp_t* lsp) ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp)
{ {
if (lsp->curc == SSE_T_EOF && if (lsp->curc == ASE_T_EOF &&
read_char(lsp) == -1) return SSE_NULL; read_char(lsp) == -1) return ASE_NULL;
lsp->errnum = SSE_LSP_ERR_NONE; lsp->errnum = ASE_LSP_ERR_NONE;
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
if (lsp->mem->locked != SSE_NULL) { if (lsp->mem->locked != ASE_NULL) {
sse_lsp_unlock_all (lsp->mem->locked); ase_lsp_unlock_all (lsp->mem->locked);
lsp->mem->locked = SSE_NULL; lsp->mem->locked = ASE_NULL;
} }
lsp->mem->locked = read_obj (lsp); lsp->mem->locked = read_obj (lsp);
return lsp->mem->locked; return lsp->mem->locked;
} }
static sse_lsp_obj_t* read_obj (sse_lsp_t* lsp) static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
{ {
sse_lsp_obj_t* obj; ase_lsp_obj_t* obj;
switch (TOKEN_TYPE(lsp)) { switch (TOKEN_TYPE(lsp)) {
case TOKEN_END: case TOKEN_END:
lsp->errnum = SSE_LSP_ERR_END; lsp->errnum = ASE_LSP_ERR_END;
return SSE_NULL; return ASE_NULL;
case TOKEN_LPAREN: case TOKEN_LPAREN:
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
return read_list (lsp); return read_list (lsp);
@ -95,94 +95,94 @@ static sse_lsp_obj_t* read_obj (sse_lsp_t* lsp)
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
return read_quote (lsp); return read_quote (lsp);
case TOKEN_INT: case TOKEN_INT:
obj = sse_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp)); obj = ase_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp));
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
sse_lsp_lock (obj); ase_lsp_lock (obj);
return obj; return obj;
case TOKEN_REAL: case TOKEN_REAL:
obj = sse_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp)); obj = ase_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp));
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
sse_lsp_lock (obj); ase_lsp_lock (obj);
return obj; return obj;
case TOKEN_STRING: case TOKEN_STRING:
obj = sse_lsp_make_stringx ( obj = ase_lsp_make_stringx (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
sse_lsp_lock (obj); ase_lsp_lock (obj);
return obj; return obj;
case TOKEN_IDENT: case TOKEN_IDENT:
sse_assert (lsp->mem->nil != SSE_NULL && lsp->mem->t != SSE_NULL); ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL);
if (TOKEN_COMPARE(lsp,SSE_T("nil")) == 0) obj = lsp->mem->nil; if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,SSE_T("t")) == 0) obj = lsp->mem->t; else if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0) obj = lsp->mem->t;
else { else {
obj = sse_lsp_make_symbolx ( obj = ase_lsp_make_symbolx (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp)); lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY; if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ERR_MEMORY;
sse_lsp_lock (obj); ase_lsp_lock (obj);
} }
return obj; return obj;
} }
lsp->errnum = SSE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
return SSE_NULL; return ASE_NULL;
} }
static sse_lsp_obj_t* read_list (sse_lsp_t* lsp) static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
{ {
sse_lsp_obj_t* obj; ase_lsp_obj_t* obj;
sse_lsp_obj_cons_t* p, * first = SSE_NULL, * prev = SSE_NULL; ase_lsp_obj_cons_t* p, * first = ASE_NULL, * prev = ASE_NULL;
while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
if (TOKEN_TYPE(lsp) == TOKEN_END) { if (TOKEN_TYPE(lsp) == TOKEN_END) {
lsp->errnum = SSE_LSP_ERR_SYNTAX; // unexpected end of input lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected end of input
return SSE_NULL; return ASE_NULL;
} }
if (TOKEN_TYPE(lsp) == TOKEN_DOT) { if (TOKEN_TYPE(lsp) == TOKEN_DOT) {
if (prev == SSE_NULL) { if (prev == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_SYNTAX; // unexpected . lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected .
return SSE_NULL; return ASE_NULL;
} }
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
obj = read_obj (lsp); obj = read_obj (lsp);
if (obj == SSE_NULL) { if (obj == ASE_NULL) {
if (lsp->errnum == SSE_LSP_ERR_END) { if (lsp->errnum == ASE_LSP_ERR_END) {
//unexpected end of input //unexpected end of input
lsp->errnum = SSE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
} }
return SSE_NULL; return ASE_NULL;
} }
prev->cdr = obj; prev->cdr = obj;
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
lsp->errnum = SSE_LSP_ERR_SYNTAX; // ) expected lsp->errnum = ASE_LSP_ERR_SYNTAX; // ) expected
return SSE_NULL; return ASE_NULL;
} }
break; break;
} }
obj = read_obj (lsp); obj = read_obj (lsp);
if (obj == SSE_NULL) { if (obj == ASE_NULL) {
if (lsp->errnum == SSE_LSP_ERR_END) { if (lsp->errnum == ASE_LSP_ERR_END) {
// unexpected end of input // unexpected end of input
lsp->errnum = SSE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
} }
return SSE_NULL; return ASE_NULL;
} }
p = (sse_lsp_obj_cons_t*)sse_lsp_make_cons ( p = (ase_lsp_obj_cons_t*)ase_lsp_make_cons (
lsp->mem, lsp->mem->nil, lsp->mem->nil); lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == SSE_NULL) { if (p == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
sse_lsp_lock ((sse_lsp_obj_t*)p); ase_lsp_lock ((ase_lsp_obj_t*)p);
if (first == SSE_NULL) first = p; if (first == ASE_NULL) first = p;
if (prev != SSE_NULL) prev->cdr = (sse_lsp_obj_t*)p; if (prev != ASE_NULL) prev->cdr = (ase_lsp_obj_t*)p;
p->car = obj; p->car = obj;
prev = p; prev = p;
@ -190,61 +190,61 @@ static sse_lsp_obj_t* read_list (sse_lsp_t* lsp)
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
} }
return (first == SSE_NULL)? lsp->mem->nil: (sse_lsp_obj_t*)first; return (first == ASE_NULL)? lsp->mem->nil: (ase_lsp_obj_t*)first;
} }
static sse_lsp_obj_t* read_quote (sse_lsp_t* lsp) static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp)
{ {
sse_lsp_obj_t* cons, * tmp; ase_lsp_obj_t* cons, * tmp;
tmp = read_obj (lsp); tmp = read_obj (lsp);
if (tmp == SSE_NULL) { if (tmp == ASE_NULL) {
if (lsp->errnum == SSE_LSP_ERR_END) { if (lsp->errnum == ASE_LSP_ERR_END) {
// unexpected end of input // unexpected end of input
lsp->errnum = SSE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
} }
return SSE_NULL; return ASE_NULL;
} }
cons = sse_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil); cons = ase_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil);
if (cons == SSE_NULL) { if (cons == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
sse_lsp_lock (cons); ase_lsp_lock (cons);
cons = sse_lsp_make_cons (lsp->mem, lsp->mem->quote, cons); cons = ase_lsp_make_cons (lsp->mem, lsp->mem->quote, cons);
if (cons == SSE_NULL) { if (cons == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ERR_MEMORY;
return SSE_NULL; return ASE_NULL;
} }
sse_lsp_lock (cons); ase_lsp_lock (cons);
return cons; return cons;
} }
static int read_char (sse_lsp_t* lsp) static int read_char (ase_lsp_t* lsp)
{ {
sse_ssize_t n; ase_ssize_t n;
if (lsp->input_func == SSE_NULL) { if (lsp->input_func == ASE_NULL) {
lsp->errnum = SSE_LSP_ERR_INPUT_NOT_ATTACHED; lsp->errnum = ASE_LSP_ERR_INPUT_NOT_ATTACHED;
return -1; return -1;
} }
n = lsp->input_func(SSE_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 = SSE_LSP_ERR_INPUT; lsp->errnum = ASE_LSP_ERR_INPUT;
return -1; return -1;
} }
if (n == 0) lsp->curc = SSE_T_EOF; if (n == 0) lsp->curc = ASE_T_EOF;
return 0; return 0;
} }
static int read_token (sse_lsp_t* lsp) static int read_token (ase_lsp_t* lsp)
{ {
sse_assert (lsp->input_func != SSE_NULL); ase_assert (lsp->input_func != ASE_NULL);
TOKEN_CLEAR (lsp); TOKEN_CLEAR (lsp);
@ -253,43 +253,43 @@ static int read_token (sse_lsp_t* lsp)
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 == SSE_T(';')) { if (lsp->curc == ASE_T(';')) {
do { do {
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (lsp->curc != SSE_T('\n') && lsp->curc != SSE_T_EOF); } while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_T_EOF);
} }
else break; else break;
} }
if (lsp->curc == SSE_T_EOF) { if (lsp->curc == ASE_T_EOF) {
TOKEN_TYPE(lsp) = TOKEN_END; TOKEN_TYPE(lsp) = TOKEN_END;
return 0; return 0;
} }
else if (lsp->curc == SSE_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 == SSE_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 == SSE_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 == SSE_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 == SSE_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)) {
@ -309,7 +309,7 @@ static int read_token (sse_lsp_t* lsp)
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 == SSE_T('\"')) { else if (lsp->curc == ASE_T('\"')) {
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
return read_string (lsp); return read_string (lsp);
} }
@ -319,26 +319,26 @@ static int read_token (sse_lsp_t* lsp)
return 0; return 0;
} }
static int read_number (sse_lsp_t* lsp, int negative) static int read_number (ase_lsp_t* lsp, int negative)
{ {
sse_lsp_int_t ivalue = 0; ase_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = 0.; ase_lsp_real_t rvalue = 0.;
do { do {
ivalue = ivalue * 10 + (lsp->curc - SSE_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 == SSE_T('.')) { if (lsp->curc == ASE_T('.')) {
sse_lsp_real_t fraction = 0.1; ase_lsp_real_t fraction = 0.1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
rvalue = (sse_lsp_real_t)ivalue; rvalue = (ase_lsp_real_t)ivalue;
while (IS_DIGIT(lsp->curc)) { while (IS_DIGIT(lsp->curc)) {
rvalue += (sse_lsp_real_t)(lsp->curc - SSE_T('0')) * fraction; rvalue += (ase_lsp_real_t)(lsp->curc - ASE_T('0')) * fraction;
fraction *= 0.1; fraction *= 0.1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} }
@ -356,7 +356,7 @@ static int read_number (sse_lsp_t* lsp, int negative)
return 0; return 0;
} }
static int read_ident (sse_lsp_t* lsp) static int read_ident (ase_lsp_t* lsp)
{ {
do { do {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
@ -366,13 +366,13 @@ static int read_ident (sse_lsp_t* lsp)
return 0; return 0;
} }
static int read_string (sse_lsp_t* lsp) static int read_string (ase_lsp_t* lsp)
{ {
int escaped = 0; int escaped = 0;
sse_cint_t code = 0; ase_cint_t code = 0;
do { do {
if (lsp->curc == SSE_T_EOF) { if (lsp->curc == ASE_T_EOF) {
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0; return 0;
} }
@ -386,34 +386,34 @@ static int read_string (sse_lsp_t* lsp)
} }
else if (escaped == 1) { else if (escaped == 1) {
/* backslash + character */ /* backslash + character */
if (lsp->curc == SSE_T('a')) if (lsp->curc == ASE_T('a'))
lsp->curc = SSE_T('\a'); lsp->curc = ASE_T('\a');
else if (lsp->curc == SSE_T('b')) else if (lsp->curc == ASE_T('b'))
lsp->curc = SSE_T('\b'); lsp->curc = ASE_T('\b');
else if (lsp->curc == SSE_T('f')) else if (lsp->curc == ASE_T('f'))
lsp->curc = SSE_T('\f'); lsp->curc = ASE_T('\f');
else if (lsp->curc == SSE_T('n')) else if (lsp->curc == ASE_T('n'))
lsp->curc = SSE_T('\n'); lsp->curc = ASE_T('\n');
else if (lsp->curc == SSE_T('r')) else if (lsp->curc == ASE_T('r'))
lsp->curc = SSE_T('\r'); lsp->curc = ASE_T('\r');
else if (lsp->curc == SSE_T('t')) else if (lsp->curc == ASE_T('t'))
lsp->curc = SSE_T('\t'); lsp->curc = ASE_T('\t');
else if (lsp->curc == SSE_T('v')) else if (lsp->curc == ASE_T('v'))
lsp->curc = SSE_T('\v'); lsp->curc = ASE_T('\v');
else if (lsp->curc == SSE_T('0')) { else if (lsp->curc == ASE_T('0')) {
escaped = 2; escaped = 2;
code = 0; code = 0;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
} }
else if (lsp->curc == SSE_T('x')) { else if (lsp->curc == ASE_T('x')) {
escaped = 3; escaped = 3;
code = 0; code = 0;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
} }
} }
else if (lsp->curc == SSE_T('\\')) { else if (lsp->curc == ASE_T('\\')) {
escaped = 1; escaped = 1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
@ -421,7 +421,7 @@ static int read_string (sse_lsp_t* lsp)
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (lsp->curc != SSE_T('\"')); } while (lsp->curc != ASE_T('\"'));
TOKEN_TYPE(lsp) = TOKEN_STRING; TOKEN_TYPE(lsp) = TOKEN_STRING;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);

62
ase/lsp/token.c
View File

@ -1,77 +1,77 @@
/* /*
* $Id: token.c,v 1.14 2006-10-23 14:49:16 bacon Exp $ * $Id: token.c,v 1.15 2006-10-24 04:22:40 bacon Exp $
*/ */
#include <sse/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
sse_lsp_token_t* sse_lsp_token_open ( ase_lsp_token_t* ase_lsp_token_open (
sse_lsp_token_t* token, sse_word_t capacity) ase_lsp_token_t* token, ase_word_t capacity)
{ {
if (token == SSE_NULL) if (token == ASE_NULL)
{ {
token = (sse_lsp_token_t*) token = (ase_lsp_token_t*)
sse_malloc (sse_sizeof(sse_lsp_token_t)); ase_malloc (ase_sizeof(ase_lsp_token_t));
if (token == SSE_NULL) return SSE_NULL; if (token == ASE_NULL) return ASE_NULL;
token->__dynamic = sse_true; token->__dynamic = ase_true;
} }
else token->__dynamic = sse_false; else token->__dynamic = ase_false;
if (sse_lsp_name_open(&token->name, capacity) == SSE_NULL) { if (ase_lsp_name_open(&token->name, capacity) == ASE_NULL) {
if (token->__dynamic) sse_free (token); if (token->__dynamic) ase_free (token);
return SSE_NULL; return ASE_NULL;
} }
/* /*
token->ivalue = 0; token->ivalue = 0;
token->fvalue = .0; token->fvalue = .0;
*/ */
token->type = SSE_LSP_TOKEN_END; token->type = ASE_LSP_TOKEN_END;
return token; return token;
} }
void sse_lsp_token_close (sse_lsp_token_t* token) void ase_lsp_token_close (ase_lsp_token_t* token)
{ {
sse_lsp_name_close (&token->name); ase_lsp_name_close (&token->name);
if (token->__dynamic) sse_free (token); if (token->__dynamic) ase_free (token);
} }
int sse_lsp_token_addc (sse_lsp_token_t* token, sse_cint_t c) int ase_lsp_token_addc (ase_lsp_token_t* token, ase_cint_t c)
{ {
return sse_lsp_name_addc (&token->name, c); return ase_lsp_name_addc (&token->name, c);
} }
int sse_lsp_token_adds (sse_lsp_token_t* token, const sse_char_t* s) int ase_lsp_token_adds (ase_lsp_token_t* token, const ase_char_t* s)
{ {
return sse_lsp_name_adds (&token->name, s); return ase_lsp_name_adds (&token->name, s);
} }
void sse_lsp_token_clear (sse_lsp_token_t* token) void ase_lsp_token_clear (ase_lsp_token_t* token)
{ {
/* /*
token->ivalue = 0; token->ivalue = 0;
token->fvalue = .0; token->fvalue = .0;
*/ */
token->type = SSE_LSP_TOKEN_END; token->type = ASE_LSP_TOKEN_END;
sse_lsp_name_clear (&token->name); ase_lsp_name_clear (&token->name);
} }
sse_char_t* sse_lsp_token_yield (sse_lsp_token_t* token, sse_word_t capacity) ase_char_t* ase_lsp_token_yield (ase_lsp_token_t* token, ase_word_t capacity)
{ {
sse_char_t* p; ase_char_t* p;
p = sse_lsp_name_yield (&token->name, capacity); p = ase_lsp_name_yield (&token->name, capacity);
if (p == SSE_NULL) return SSE_NULL; if (p == ASE_NULL) return ASE_NULL;
/* /*
token->ivalue = 0; token->ivalue = 0;
token->fvalue = .0; token->fvalue = .0;
*/ */
token->type = SSE_LSP_TOKEN_END; token->type = ASE_LSP_TOKEN_END;
return p; return p;
} }
int sse_lsp_token_compare_name (sse_lsp_token_t* token, const sse_char_t* str) int ase_lsp_token_compare_name (ase_lsp_token_t* token, const ase_char_t* str)
{ {
return sse_lsp_name_compare (&token->name, str); return ase_lsp_name_compare (&token->name, str);
} }

40
ase/lsp/token.h
View File

@ -1,44 +1,44 @@
/* /*
* $Id: token.h,v 1.12 2006-10-22 13:10:46 bacon Exp $ * $Id: token.h,v 1.13 2006-10-24 04:22:40 bacon Exp $
*/ */
#ifndef _SSE_LSP_TOKEN_H_ #ifndef _ASE_LSP_TOKEN_H_
#define _SSE_LSP_TOKEN_H_ #define _ASE_LSP_TOKEN_H_
#include <sse/lsp/types.h> #include <ase/lsp/types.h>
#include <sse/lsp/name.h> #include <ase/lsp/name.h>
enum enum
{ {
SSE_LSP_TOKEN_END ASE_LSP_TOKEN_END
}; };
struct sse_lsp_token_t struct ase_lsp_token_t
{ {
int type; int type;
sse_lsp_int_t ivalue; ase_lsp_int_t ivalue;
sse_lsp_real_t rvalue; ase_lsp_real_t rvalue;
sse_lsp_name_t name; ase_lsp_name_t name;
sse_bool_t __dynamic; ase_bool_t __dynamic;
}; };
typedef struct sse_lsp_token_t sse_lsp_token_t; typedef struct ase_lsp_token_t ase_lsp_token_t;
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
sse_lsp_token_t* sse_lsp_token_open ( ase_lsp_token_t* ase_lsp_token_open (
sse_lsp_token_t* token, sse_word_t capacity); ase_lsp_token_t* token, ase_word_t capacity);
void sse_lsp_token_close (sse_lsp_token_t* token); void ase_lsp_token_close (ase_lsp_token_t* token);
int sse_lsp_token_addc (sse_lsp_token_t* token, sse_cint_t c); int ase_lsp_token_addc (ase_lsp_token_t* token, ase_cint_t c);
int sse_lsp_token_adds (sse_lsp_token_t* token, const sse_char_t* s); int ase_lsp_token_adds (ase_lsp_token_t* token, const ase_char_t* s);
void sse_lsp_token_clear (sse_lsp_token_t* token); void ase_lsp_token_clear (ase_lsp_token_t* token);
sse_char_t* sse_lsp_token_yield (sse_lsp_token_t* token, sse_word_t capacity); ase_char_t* ase_lsp_token_yield (ase_lsp_token_t* token, ase_word_t capacity);
int sse_lsp_token_compare_name (sse_lsp_token_t* token, const sse_char_t* str); int ase_lsp_token_compare_name (ase_lsp_token_t* token, const ase_char_t* str);
#ifdef __cplusplus #ifdef __cplusplus
} }

14
ase/lsp/types.h
View File

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