hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan
2006-10-22 13:10:46 +00:00
parent b44656b9b6
commit 97392088fd
28 changed files with 1976 additions and 1972 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
ase/configure vendored
View File

@ -1,5 +1,5 @@
#! /bin/sh
# From configure.ac Revision: 1.67 .
# From configure.ac Revision: 1.68 .
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.59 for sse deb-0.1.0.
#
@ -12938,7 +12938,7 @@ then
CFLAGS="$CFLAGS -D_REENTRANT -D_THREAD_SAFE"
fi
ac_config_files="$ac_config_files makefile awk/makefile test/awk/makefile"
ac_config_files="$ac_config_files makefile awk/makefile lsp/makefile stx/makefile test/awk/makefile test/lsp/makefile test/stx/makefile"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@ -13466,7 +13466,11 @@ do
# Handling of arguments.
"makefile" ) CONFIG_FILES="$CONFIG_FILES makefile" ;;
"awk/makefile" ) CONFIG_FILES="$CONFIG_FILES awk/makefile" ;;
"lsp/makefile" ) CONFIG_FILES="$CONFIG_FILES lsp/makefile" ;;
"stx/makefile" ) CONFIG_FILES="$CONFIG_FILES stx/makefile" ;;
"test/awk/makefile" ) CONFIG_FILES="$CONFIG_FILES test/awk/makefile" ;;
"test/lsp/makefile" ) CONFIG_FILES="$CONFIG_FILES test/lsp/makefile" ;;
"test/stx/makefile" ) CONFIG_FILES="$CONFIG_FILES test/stx/makefile" ;;
"config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}

4
ase/configure.ac
View File

@ -1,6 +1,6 @@
AC_PREREQ(2.53)
AC_INIT([sse], [deb-0.1.0])
AC_REVISION([$Revision: 1.68 $])
AC_REVISION([$Revision: 1.69 $])
AC_CONFIG_HEADER([config.h])
# Checks for programs.
@ -123,5 +123,5 @@ then
[CFLAGS="$CFLAGS -D_REENTRANT -D_THREAD_SAFE"]
fi
AC_CONFIG_FILES([makefile awk/makefile test/awk/makefile])
AC_CONFIG_FILES([makefile awk/makefile lsp/makefile stx/makefile test/awk/makefile test/lsp/makefile test/stx/makefile])
AC_OUTPUT

56
ase/lsp/array.c
View File

@ -1,64 +1,64 @@
/*
* $Id: array.c,v 1.7 2005-09-18 11:34:35 bacon Exp $
* $Id: array.c,v 1.8 2006-10-22 13:10:45 bacon Exp $
*/
#include <xp/lsp/array.h>
#include <xp/bas/memory.h>
#include <xp/bas/assert.h>
#include <sse/lsp/array.h>
#include <sse/bas/memory.h>
#include <sse/bas/assert.h>
xp_lsp_array_t* xp_lsp_array_new (xp_size_t capacity)
sse_lsp_array_t* sse_lsp_array_new (sse_size_t capacity)
{
xp_lsp_array_t* array;
sse_lsp_array_t* array;
xp_assert (capacity > 0);
array = (xp_lsp_array_t*)malloc (sizeof(xp_lsp_array_t));
if (array == XP_NULL) return XP_NULL;
sse_assert (capacity > 0);
array = (sse_lsp_array_t*)malloc (sizeof(sse_lsp_array_t));
if (array == SSE_NULL) return SSE_NULL;
array->buffer = (void**)malloc (capacity + 1);
if (array->buffer == XP_NULL) {
if (array->buffer == SSE_NULL) {
free (array);
return XP_NULL;
return SSE_NULL;
}
array->size = 0;
array->capacity = capacity;
array->buffer[0] = XP_NULL;
array->buffer[0] = SSE_NULL;
return array;
}
void xp_lsp_array_free (xp_lsp_array_t* array)
void sse_lsp_array_free (sse_lsp_array_t* array)
{
while (array->size > 0)
free (array->buffer[--array->size]);
xp_assert (array->size == 0);
sse_assert (array->size == 0);
free (array->buffer);
free (array);
}
int xp_lsp_array_add_item (xp_lsp_array_t* array, void* item)
int sse_lsp_array_add_item (sse_lsp_array_t* array, void* item)
{
if (array->size >= array->capacity) {
void* new_buffer = (void**)realloc (
array->buffer, array->capacity * 2 + 1);
if (new_buffer == XP_NULL) return -1;
if (new_buffer == SSE_NULL) return -1;
array->buffer = new_buffer;
array->capacity = array->capacity * 2;
}
array->buffer[array->size++] = item;
array->buffer[array->size] = XP_NULL;
array->buffer[array->size] = SSE_NULL;
return 0;
}
int xp_lsp_array_insert (xp_lsp_array_t* array, xp_size_t index, void* value)
int sse_lsp_array_insert (sse_lsp_array_t* array, sse_size_t index, void* value)
{
xp_size_t i;
sse_size_t i;
if (index >= array->capacity) {
void* new_buffer = (void**)realloc (
array->buffer, array->capacity * 2 + 1);
if (new_buffer == XP_NULL) return -1;
if (new_buffer == SSE_NULL) return -1;
array->buffer = new_buffer;
array->capacity = array->capacity * 2;
}
@ -72,32 +72,32 @@ int xp_lsp_array_insert (xp_lsp_array_t* array, xp_size_t index, void* value)
return 0;
}
void xp_lsp_array_delete (xp_lsp_array_t* array, xp_size_t index)
void sse_lsp_array_delete (sse_lsp_array_t* array, sse_size_t index)
{
xp_assert (index < array->size);
sse_assert (index < array->size);
}
void xp_lsp_array_clear (xp_lsp_array_t* array)
void sse_lsp_array_clear (sse_lsp_array_t* array)
{
while (array->size > 0)
free (array->buffer[--array->size]);
xp_assert (array->size == 0);
array->buffer[0] = XP_NULL;
sse_assert (array->size == 0);
array->buffer[0] = SSE_NULL;
}
void** xp_lsp_array_yield (xp_lsp_array_t* array, xp_size_t capacity)
void** sse_lsp_array_yield (sse_lsp_array_t* array, sse_size_t capacity)
{
void** old_buffer, ** new_buffer;
new_buffer = (void**)malloc(capacity + 1);
if (new_buffer == XP_NULL) return XP_NULL;
if (new_buffer == SSE_NULL) return SSE_NULL;
old_buffer = array->buffer;
array->buffer = new_buffer;
array->size = 0;
array->capacity = capacity;
array->buffer[0] = XP_NULL;
array->buffer[0] = SSE_NULL;
return old_buffer;
}

30
ase/lsp/array.h
View File

@ -1,32 +1,32 @@
/*
* $Id: array.h,v 1.5 2005-09-18 08:10:50 bacon Exp $
* $Id: array.h,v 1.6 2006-10-22 13:10:45 bacon Exp $
*/
#ifndef _XP_LSP_ARRAY_H_
#define _XP_LSP_ARRAY_H_
#ifndef _SSE_LSP_ARRAY_H_
#define _SSE_LSP_ARRAY_H_
#include <xp/types.h>
#include <sse/types.h>
struct xp_lsp_array_t
struct sse_lsp_array_t
{
void** buffer;
xp_size_t size;
xp_size_t capacity;
sse_size_t size;
sse_size_t capacity;
};
typedef struct xp_lsp_array_t xp_lsp_array_t;
typedef struct sse_lsp_array_t sse_lsp_array_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_array_t* xp_lsp_array_new (xp_size_t capacity);
void xp_lsp_array_free (xp_lsp_array_t* array);
int xp_lsp_array_add_item (xp_lsp_array_t* array, void* item);
int xp_lsp_array_insert (xp_lsp_array_t* array, xp_size_t index, void* value);
void xp_lsp_array_delete (xp_lsp_array_t* array, xp_size_t index);
void xp_lsp_array_clear (xp_lsp_array_t* array);
void** xp_lsp_array_yield (xp_lsp_array_t* array, xp_size_t capacity);
sse_lsp_array_t* sse_lsp_array_new (sse_size_t capacity);
void sse_lsp_array_free (sse_lsp_array_t* array);
int sse_lsp_array_add_item (sse_lsp_array_t* array, void* item);
int sse_lsp_array_insert (sse_lsp_array_t* array, sse_size_t index, void* value);
void sse_lsp_array_delete (sse_lsp_array_t* array, sse_size_t index);
void sse_lsp_array_clear (sse_lsp_array_t* array);
void** sse_lsp_array_yield (sse_lsp_array_t* array, sse_size_t capacity);
#ifdef __cplusplus
}

80
ase/lsp/env.c
View File

@ -1,99 +1,99 @@
/*
* $Id: env.c,v 1.8 2005-09-20 09:17:06 bacon Exp $
* $Id: env.c,v 1.9 2006-10-22 13:10:45 bacon Exp $
*/
#include <xp/lsp/env.h>
#include <xp/bas/memory.h>
#include <xp/bas/assert.h>
#include <sse/lsp/env.h>
#include <sse/bas/memory.h>
#include <sse/bas/assert.h>
// TODO: make the frame hash accessible....
xp_lsp_assoc_t* xp_lsp_assoc_new (
xp_lsp_obj_t* name, xp_lsp_obj_t* value, xp_lsp_obj_t* func)
sse_lsp_assoc_t* sse_lsp_assoc_new (
sse_lsp_obj_t* name, sse_lsp_obj_t* value, sse_lsp_obj_t* func)
{
xp_lsp_assoc_t* assoc;
sse_lsp_assoc_t* assoc;
assoc = (xp_lsp_assoc_t*) xp_malloc (sizeof(xp_lsp_assoc_t));
if (assoc == XP_NULL) return XP_NULL;
assoc = (sse_lsp_assoc_t*) sse_malloc (sizeof(sse_lsp_assoc_t));
if (assoc == SSE_NULL) return SSE_NULL;
assoc->name = name;
assoc->value = value;
assoc->func = func;
assoc->link = XP_NULL;
assoc->link = SSE_NULL;
return assoc;
}
void xp_lsp_assoc_free (xp_lsp_assoc_t* assoc)
void sse_lsp_assoc_free (sse_lsp_assoc_t* assoc)
{
xp_free (assoc);
sse_free (assoc);
}
xp_lsp_frame_t* xp_lsp_frame_new (void)
sse_lsp_frame_t* sse_lsp_frame_new (void)
{
xp_lsp_frame_t* frame;
sse_lsp_frame_t* frame;
frame = (xp_lsp_frame_t*) xp_malloc (sizeof(xp_lsp_frame_t));
if (frame == XP_NULL) return XP_NULL;
frame = (sse_lsp_frame_t*) sse_malloc (sizeof(sse_lsp_frame_t));
if (frame == SSE_NULL) return SSE_NULL;
frame->assoc = XP_NULL;
frame->link = XP_NULL;
frame->assoc = SSE_NULL;
frame->link = SSE_NULL;
return frame;
}
void xp_lsp_frame_free (xp_lsp_frame_t* frame)
void sse_lsp_frame_free (sse_lsp_frame_t* frame)
{
xp_lsp_assoc_t* assoc, * link;
sse_lsp_assoc_t* assoc, * link;
// destroy the associations
assoc = frame->assoc;
while (assoc != XP_NULL) {
while (assoc != SSE_NULL) {
link = assoc->link;
xp_lsp_assoc_free (assoc);
sse_lsp_assoc_free (assoc);
assoc = link;
}
xp_free (frame);
sse_free (frame);
}
xp_lsp_assoc_t* xp_lsp_frame_lookup (xp_lsp_frame_t* frame, xp_lsp_obj_t* name)
sse_lsp_assoc_t* sse_lsp_frame_lookup (sse_lsp_frame_t* frame, sse_lsp_obj_t* name)
{
xp_lsp_assoc_t* assoc;
sse_lsp_assoc_t* assoc;
xp_assert (XP_LSP_TYPE(name) == XP_LSP_OBJ_SYMBOL);
sse_assert (SSE_LSP_TYPE(name) == SSE_LSP_OBJ_SYMBOL);
assoc = frame->assoc;
while (assoc != XP_NULL) {
while (assoc != SSE_NULL) {
if (name == assoc->name) return assoc;
assoc = assoc->link;
}
return XP_NULL;
return SSE_NULL;
}
xp_lsp_assoc_t* xp_lsp_frame_insert_value (
xp_lsp_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* value)
sse_lsp_assoc_t* sse_lsp_frame_insert_value (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* value)
{
xp_lsp_assoc_t* assoc;
sse_lsp_assoc_t* assoc;
xp_assert (XP_LSP_TYPE(name) == XP_LSP_OBJ_SYMBOL);
sse_assert (SSE_LSP_TYPE(name) == SSE_LSP_OBJ_SYMBOL);
assoc = xp_lsp_assoc_new (name, value, XP_NULL);
if (assoc == XP_NULL) return XP_NULL;
assoc = sse_lsp_assoc_new (name, value, SSE_NULL);
if (assoc == SSE_NULL) return SSE_NULL;
assoc->link = frame->assoc;
frame->assoc = assoc;
return assoc;
}
xp_lsp_assoc_t* xp_lsp_frame_insert_func (
xp_lsp_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* func)
sse_lsp_assoc_t* sse_lsp_frame_insert_func (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* func)
{
xp_lsp_assoc_t* assoc;
sse_lsp_assoc_t* assoc;
xp_assert (XP_LSP_TYPE(name) == XP_LSP_OBJ_SYMBOL);
sse_assert (SSE_LSP_TYPE(name) == SSE_LSP_OBJ_SYMBOL);
assoc = xp_lsp_assoc_new (name, XP_NULL, func);
if (assoc == XP_NULL) return XP_NULL;
assoc = sse_lsp_assoc_new (name, SSE_NULL, func);
if (assoc == SSE_NULL) return SSE_NULL;
assoc->link = frame->assoc;
frame->assoc = assoc;
return assoc;

50
ase/lsp/env.h
View File

@ -1,46 +1,46 @@
/*
* $Id: env.h,v 1.7 2005-09-20 09:17:06 bacon Exp $
* $Id: env.h,v 1.8 2006-10-22 13:10:45 bacon Exp $
*/
#ifndef _XP_LSP_ENV_H_
#define _XP_LSP_ENV_H_
#ifndef _SSE_LSP_ENV_H_
#define _SSE_LSP_ENV_H_
#include <xp/lsp/obj.h>
#include <sse/lsp/obj.h>
struct xp_lsp_assoc_t
struct sse_lsp_assoc_t
{
xp_lsp_obj_t* name; // xp_lsp_obj_symbol_t
/*xp_lsp_obj_t* value;*/
xp_lsp_obj_t* value; /* value as a variable */
xp_lsp_obj_t* func; /* function definition */
struct xp_lsp_assoc_t* link;
sse_lsp_obj_t* name; // sse_lsp_obj_symbol_t
/*sse_lsp_obj_t* value;*/
sse_lsp_obj_t* value; /* value as a variable */
sse_lsp_obj_t* func; /* function definition */
struct sse_lsp_assoc_t* link;
};
struct xp_lsp_frame_t
struct sse_lsp_frame_t
{
struct xp_lsp_assoc_t* assoc;
struct xp_lsp_frame_t* link;
struct sse_lsp_assoc_t* assoc;
struct sse_lsp_frame_t* link;
};
typedef struct xp_lsp_assoc_t xp_lsp_assoc_t;
typedef struct xp_lsp_frame_t xp_lsp_frame_t;
typedef struct sse_lsp_assoc_t sse_lsp_assoc_t;
typedef struct sse_lsp_frame_t sse_lsp_frame_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_assoc_t* xp_lsp_assoc_new (
xp_lsp_obj_t* name, xp_lsp_obj_t* value, xp_lsp_obj_t* func);
void xp_lsp_assoc_free (xp_lsp_assoc_t* assoc);
sse_lsp_assoc_t* sse_lsp_assoc_new (
sse_lsp_obj_t* name, sse_lsp_obj_t* value, sse_lsp_obj_t* func);
void sse_lsp_assoc_free (sse_lsp_assoc_t* assoc);
xp_lsp_frame_t* xp_lsp_frame_new (void);
void xp_lsp_frame_free (xp_lsp_frame_t* frame);
xp_lsp_assoc_t* xp_lsp_frame_lookup (xp_lsp_frame_t* frame, xp_lsp_obj_t* name);
sse_lsp_frame_t* sse_lsp_frame_new (void);
void sse_lsp_frame_free (sse_lsp_frame_t* frame);
sse_lsp_assoc_t* sse_lsp_frame_lookup (sse_lsp_frame_t* frame, sse_lsp_obj_t* name);
xp_lsp_assoc_t* xp_lsp_frame_insert_value (
xp_lsp_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* value);
xp_lsp_assoc_t* xp_lsp_frame_insert_func (
xp_lsp_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* func);
sse_lsp_assoc_t* sse_lsp_frame_insert_value (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* value);
sse_lsp_assoc_t* sse_lsp_frame_insert_func (
sse_lsp_frame_t* frame, sse_lsp_obj_t* name, sse_lsp_obj_t* func);
#ifdef __cplusplus
}

56
ase/lsp/error.c
View File

@ -1,39 +1,39 @@
/*
* $Id: error.c,v 1.2 2005-09-21 12:04:05 bacon Exp $
* $Id: error.c,v 1.3 2006-10-22 13:10:45 bacon Exp $
*/
#include <xp/lsp/lsp.h>
#include <xp/bas/string.h>
#include <sse/lsp/lsp.h>
#include <sse/bas/string.h>
static const xp_char_t* __errstr[] =
static const sse_char_t* __errstr[] =
{
XP_TEXT("no error"),
XP_TEXT("abort"),
XP_TEXT("end"),
XP_TEXT("memory"),
XP_TEXT("input not attached"),
XP_TEXT("input"),
XP_TEXT("output not attached"),
XP_TEXT("output"),
XP_TEXT("syntax"),
XP_TEXT("bad arguments"),
XP_TEXT("wrong arguments"),
XP_TEXT("too few arguments"),
XP_TEXT("too many arguments"),
XP_TEXT("undefined function"),
XP_TEXT("bad function"),
XP_TEXT("duplicate formal"),
XP_TEXT("bad symbol"),
XP_TEXT("undefined symbol"),
XP_TEXT("empty body"),
XP_TEXT("bad value"),
XP_TEXT("divide by zero")
SSE_TEXT("no error"),
SSE_TEXT("abort"),
SSE_TEXT("end"),
SSE_TEXT("memory"),
SSE_TEXT("input not attached"),
SSE_TEXT("input"),
SSE_TEXT("output not attached"),
SSE_TEXT("output"),
SSE_TEXT("syntax"),
SSE_TEXT("bad arguments"),
SSE_TEXT("wrong arguments"),
SSE_TEXT("too few arguments"),
SSE_TEXT("too many arguments"),
SSE_TEXT("undefined function"),
SSE_TEXT("bad function"),
SSE_TEXT("duplicate formal"),
SSE_TEXT("bad symbol"),
SSE_TEXT("undefined symbol"),
SSE_TEXT("empty body"),
SSE_TEXT("bad value"),
SSE_TEXT("divide by zero")
};
int xp_lsp_error (xp_lsp_t* lsp, xp_char_t* buf, xp_size_t size)
int sse_lsp_error (sse_lsp_t* lsp, sse_char_t* buf, sse_size_t size)
{
if (buf == XP_NULL || size == 0) return lsp->errnum;
xp_strxcpy (buf, size, __errstr[lsp->errnum]);
if (buf == SSE_NULL || size == 0) return lsp->errnum;
sse_strxcpy (buf, size, __errstr[lsp->errnum]);
return lsp->errnum;
}

262
ase/lsp/eval.c
View File

@ -1,41 +1,41 @@
/*
* $Id: eval.c,v 1.13 2005-09-24 08:16:02 bacon Exp $
* $Id: eval.c,v 1.14 2006-10-22 13:10:45 bacon Exp $
*/
#include <xp/lsp/lsp.h>
#include <xp/lsp/env.h>
#include <xp/lsp/prim.h>
#include <xp/bas/assert.h>
#include <sse/lsp/lsp.h>
#include <sse/lsp/env.h>
#include <sse/lsp/prim.h>
#include <sse/bas/assert.h>
static xp_lsp_obj_t* make_func (
xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro);
static xp_lsp_obj_t* eval_cons (
xp_lsp_t* lsp, xp_lsp_obj_t* cons);
static xp_lsp_obj_t* apply (
xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* actual);
static sse_lsp_obj_t* make_func (
sse_lsp_t* lsp, sse_lsp_obj_t* cdr, int is_macro);
static sse_lsp_obj_t* eval_cons (
sse_lsp_t* lsp, sse_lsp_obj_t* cons);
static sse_lsp_obj_t* apply (
sse_lsp_t* lsp, sse_lsp_obj_t* func, sse_lsp_obj_t* actual);
xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj)
sse_lsp_obj_t* sse_lsp_eval (sse_lsp_t* lsp, sse_lsp_obj_t* obj)
{
lsp->errnum = XP_LSP_ERR_NONE;
lsp->errnum = SSE_LSP_ERR_NONE;
if (XP_LSP_TYPE(obj) == XP_LSP_OBJ_CONS)
if (SSE_LSP_TYPE(obj) == SSE_LSP_OBJ_CONS)
return eval_cons (lsp, obj);
else if (XP_LSP_TYPE(obj) == XP_LSP_OBJ_SYMBOL) {
xp_lsp_assoc_t* assoc;
else if (SSE_LSP_TYPE(obj) == SSE_LSP_OBJ_SYMBOL) {
sse_lsp_assoc_t* assoc;
/*
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
printf ("lambda or macro can't be used as a normal symbol\n");
lsp->errnum = XP_LSP_ERR_BAD_SYMBOL;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_SYMBOL;
return SSE_NULL;
}
*/
assoc = xp_lsp_lookup(lsp->mem, obj);
if (assoc == XP_NULL || assoc->value == XP_NULL) {
assoc = sse_lsp_lookup(lsp->mem, obj);
if (assoc == SSE_NULL || assoc->value == SSE_NULL) {
if (lsp->opt_undef_symbol) {
lsp->errnum = XP_LSP_ERR_UNDEF_SYMBOL;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_UNDEF_SYMBOL;
return SSE_NULL;
}
return lsp->mem->nil;
}
@ -46,58 +46,58 @@ xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj)
return obj;
}
static xp_lsp_obj_t* make_func (xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro)
static sse_lsp_obj_t* make_func (sse_lsp_t* lsp, sse_lsp_obj_t* cdr, int is_macro)
{
xp_lsp_obj_t* func, * formal, * body, * p;
sse_lsp_obj_t* func, * formal, * body, * p;
if (cdr == lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS;
return SSE_NULL;
}
if (XP_LSP_TYPE(cdr) != XP_LSP_OBJ_CONS) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
if (SSE_LSP_TYPE(cdr) != SSE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
formal = XP_LSP_CAR(cdr);
body = XP_LSP_CDR(cdr);
formal = SSE_LSP_CAR(cdr);
body = SSE_LSP_CDR(cdr);
if (body == lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_EMPTY_BODY;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_EMPTY_BODY;
return SSE_NULL;
}
// TODO: more lambda expression syntax checks required???.
/* check if the lambda express has non-nil value
* at the terminating cdr */
for (p = body; XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS; p = XP_LSP_CDR(p));
for (p = body; SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS; p = SSE_LSP_CDR(p));
if (p != lsp->mem->nil) {
/* like in (lambda (x) (+ x 10) . 4) */
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
func = (is_macro)?
xp_lsp_make_macro (lsp->mem, formal, body):
xp_lsp_make_func (lsp->mem, formal, body);
if (func == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
sse_lsp_make_macro (lsp->mem, formal, body):
sse_lsp_make_func (lsp->mem, formal, body);
if (func == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return func;
}
static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
static sse_lsp_obj_t* eval_cons (sse_lsp_t* lsp, sse_lsp_obj_t* cons)
{
xp_lsp_obj_t* car, * cdr;
sse_lsp_obj_t* car, * cdr;
xp_assert (XP_LSP_TYPE(cons) == XP_LSP_OBJ_CONS);
sse_assert (SSE_LSP_TYPE(cons) == SSE_LSP_OBJ_CONS);
car = XP_LSP_CAR(cons);
cdr = XP_LSP_CDR(cons);
car = SSE_LSP_CAR(cons);
cdr = SSE_LSP_CDR(cons);
if (car == lsp->mem->lambda) {
return make_func (lsp, cdr, 0);
@ -105,92 +105,92 @@ static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
else if (car == lsp->mem->macro) {
return make_func (lsp, cdr, 1);
}
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_SYMBOL) {
xp_lsp_assoc_t* assoc;
else if (SSE_LSP_TYPE(car) == SSE_LSP_OBJ_SYMBOL) {
sse_lsp_assoc_t* assoc;
if ((assoc = xp_lsp_lookup(lsp->mem, car)) != XP_NULL) {
//xp_lsp_obj_t* func = assoc->value;
xp_lsp_obj_t* func = assoc->func;
if (func == XP_NULL) {
if ((assoc = sse_lsp_lookup(lsp->mem, car)) != SSE_NULL) {
//sse_lsp_obj_t* func = assoc->value;
sse_lsp_obj_t* func = assoc->func;
if (func == SSE_NULL) {
/* the symbol's function definition is void */
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_UNDEF_FUNC;
return SSE_NULL;
}
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_FUNC ||
XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_FUNC ||
SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO) {
return apply (lsp, func, cdr);
}
else if (XP_LSP_TYPE(func) == XP_LSP_OBJ_PRIM) {
else if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_PRIM) {
/* primitive function */
return XP_LSP_PRIM(func) (lsp, cdr);
return SSE_LSP_PRIM(func) (lsp, cdr);
}
else {
//TODO: emit the name for debugging
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_UNDEF_FUNC;
return SSE_NULL;
}
}
else {
//TODO: better error handling.
//TODO: emit the name for debugging
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_UNDEF_FUNC;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_FUNC ||
XP_LSP_TYPE(car) == XP_LSP_OBJ_MACRO) {
else if (SSE_LSP_TYPE(car) == SSE_LSP_OBJ_FUNC ||
SSE_LSP_TYPE(car) == SSE_LSP_OBJ_MACRO) {
return apply (lsp, car, cdr);
}
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_CONS) {
if (XP_LSP_CAR(car) == lsp->mem->lambda) {
xp_lsp_obj_t* func = make_func (lsp, XP_LSP_CDR(car), 0);
if (func == XP_NULL) return XP_NULL;
else if (SSE_LSP_TYPE(car) == SSE_LSP_OBJ_CONS) {
if (SSE_LSP_CAR(car) == lsp->mem->lambda) {
sse_lsp_obj_t* func = make_func (lsp, SSE_LSP_CDR(car), 0);
if (func == SSE_NULL) return SSE_NULL;
return apply (lsp, func, cdr);
}
else if (XP_LSP_CAR(car) == lsp->mem->macro) {
xp_lsp_obj_t* func = make_func (lsp, XP_LSP_CDR(car), 1);
if (func == XP_NULL) return XP_NULL;
else if (SSE_LSP_CAR(car) == lsp->mem->macro) {
sse_lsp_obj_t* func = make_func (lsp, SSE_LSP_CDR(car), 1);
if (func == SSE_NULL) return SSE_NULL;
return apply (lsp, func, cdr);
}
}
//TODO: emit the name for debugging
lsp->errnum = XP_LSP_ERR_BAD_FUNC;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_FUNC;
return SSE_NULL;
}
static xp_lsp_obj_t* apply (
xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* actual)
static sse_lsp_obj_t* apply (
sse_lsp_t* lsp, sse_lsp_obj_t* func, sse_lsp_obj_t* actual)
{
xp_lsp_frame_t* frame;
xp_lsp_obj_t* formal;
xp_lsp_obj_t* body;
xp_lsp_obj_t* value;
xp_lsp_mem_t* mem;
sse_lsp_frame_t* frame;
sse_lsp_obj_t* formal;
sse_lsp_obj_t* body;
sse_lsp_obj_t* value;
sse_lsp_mem_t* mem;
xp_assert (
XP_LSP_TYPE(func) == XP_LSP_OBJ_FUNC ||
XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO);
sse_assert (
SSE_LSP_TYPE(func) == SSE_LSP_OBJ_FUNC ||
SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO);
xp_assert (XP_LSP_TYPE(XP_LSP_CDR(func)) == XP_LSP_OBJ_CONS);
sse_assert (SSE_LSP_TYPE(SSE_LSP_CDR(func)) == SSE_LSP_OBJ_CONS);
mem = lsp->mem;
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
formal = XP_LSP_MFORMAL (func);
body = XP_LSP_MBODY (func);
if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO) {
formal = SSE_LSP_MFORMAL (func);
body = SSE_LSP_MBODY (func);
}
else {
formal = XP_LSP_FFORMAL (func);
body = XP_LSP_FBODY (func);
formal = SSE_LSP_FFORMAL (func);
body = SSE_LSP_FBODY (func);
}
// make a new frame.
frame = xp_lsp_frame_new ();
if (frame == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
frame = sse_lsp_frame_new ();
if (frame == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
// attach it to the brooding frame list to
@ -201,56 +201,56 @@ static xp_lsp_obj_t* apply (
// evaluate arguments and push them into the frame.
while (formal != mem->nil) {
if (actual == mem->nil) {
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS;
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS;
mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
value = XP_LSP_CAR(actual);
if (XP_LSP_TYPE(func) != XP_LSP_OBJ_MACRO) {
value = SSE_LSP_CAR(actual);
if (SSE_LSP_TYPE(func) != SSE_LSP_OBJ_MACRO) {
// macro doesn't evaluate actual arguments.
value = xp_lsp_eval (lsp, value);
if (value == XP_NULL) {
value = sse_lsp_eval (lsp, value);
if (value == SSE_NULL) {
mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
if (xp_lsp_frame_lookup (
frame, XP_LSP_CAR(formal)) != XP_NULL) {
if (sse_lsp_frame_lookup (
frame, SSE_LSP_CAR(formal)) != SSE_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
lsp->errnum = SSE_LSP_ERR_DUP_FORMAL;
mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (xp_lsp_frame_insert_value (
frame, XP_LSP_CAR(formal), value) == XP_NULL) {
if (sse_lsp_frame_insert_value (
frame, SSE_LSP_CAR(formal), value) == SSE_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
lsp->errnum = SSE_LSP_ERR_MEMORY;
mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
actual = XP_LSP_CDR(actual);
formal = XP_LSP_CDR(formal);
actual = SSE_LSP_CDR(actual);
formal = SSE_LSP_CDR(formal);
}
if (XP_LSP_TYPE(actual) == XP_LSP_OBJ_CONS) {
lsp->errnum = XP_LSP_ERR_TOO_MANY_ARGS;
if (SSE_LSP_TYPE(actual) == SSE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS;
mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
else if (actual != mem->nil) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
// push the frame
@ -261,25 +261,25 @@ static xp_lsp_obj_t* apply (
// do the evaluation of the body
value = mem->nil;
while (body != mem->nil) {
value = xp_lsp_eval(lsp, XP_LSP_CAR(body));
if (value == XP_NULL) {
value = sse_lsp_eval(lsp, SSE_LSP_CAR(body));
if (value == SSE_NULL) {
mem->frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
// pop the frame.
mem->frame = frame->link;
// destroy the frame.
xp_lsp_frame_free (frame);
sse_lsp_frame_free (frame);
//if (XP_LSP_CAR(func) == mem->macro) {
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
value = xp_lsp_eval(lsp, value);
if (value == XP_NULL) return XP_NULL;
//if (SSE_LSP_CAR(func) == mem->macro) {
if (SSE_LSP_TYPE(func) == SSE_LSP_OBJ_MACRO) {
value = sse_lsp_eval(lsp, value);
if (value == SSE_NULL) return SSE_NULL;
}
return value;

174
ase/lsp/init.c
View File

@ -1,51 +1,51 @@
/*
* $Id: init.c,v 1.11 2005-12-05 15:11:29 bacon Exp $
* $Id: init.c,v 1.12 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/lsp.h>
#include <xp/lsp/prim.h>
#include <xp/bas/memory.h>
#include <xp/bas/assert.h>
#include <sse/lsp/lsp.h>
#include <sse/lsp/prim.h>
#include <sse/bas/memory.h>
#include <sse/bas/assert.h>
static int __add_builtin_prims (xp_lsp_t* lsp);
static int __add_builtin_prims (sse_lsp_t* lsp);
xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
xp_size_t mem_ubound, xp_size_t mem_ubound_inc)
sse_lsp_t* sse_lsp_open (sse_lsp_t* lsp,
sse_size_t mem_ubound, sse_size_t mem_ubound_inc)
{
if (lsp == XP_NULL) {
lsp = (xp_lsp_t*)xp_malloc(xp_sizeof(xp_lsp_t));
if (lsp == XP_NULL) return lsp;
lsp->__dynamic = xp_true;
if (lsp == SSE_NULL) {
lsp = (sse_lsp_t*)sse_malloc(sse_sizeof(sse_lsp_t));
if (lsp == SSE_NULL) return lsp;
lsp->__dynamic = sse_true;
}
else lsp->__dynamic = xp_false;
else lsp->__dynamic = sse_false;
if (xp_lsp_token_open(&lsp->token, 0) == XP_NULL) {
if (lsp->__dynamic) xp_free (lsp);
return XP_NULL;
if (sse_lsp_token_open(&lsp->token, 0) == SSE_NULL) {
if (lsp->__dynamic) sse_free (lsp);
return SSE_NULL;
}
lsp->errnum = XP_LSP_ERR_NONE;
lsp->errnum = SSE_LSP_ERR_NONE;
lsp->opt_undef_symbol = 1;
//lsp->opt_undef_symbol = 0;
lsp->curc = XP_CHAR_EOF;
lsp->input_func = XP_NULL;
lsp->output_func = XP_NULL;
lsp->input_arg = XP_NULL;
lsp->output_arg = XP_NULL;
lsp->curc = SSE_CHAR_EOF;
lsp->input_func = SSE_NULL;
lsp->output_func = SSE_NULL;
lsp->input_arg = SSE_NULL;
lsp->output_arg = SSE_NULL;
lsp->mem = xp_lsp_mem_new (mem_ubound, mem_ubound_inc);
if (lsp->mem == XP_NULL) {
xp_lsp_token_close (&lsp->token);
if (lsp->__dynamic) xp_free (lsp);
return XP_NULL;
lsp->mem = sse_lsp_mem_new (mem_ubound, mem_ubound_inc);
if (lsp->mem == SSE_NULL) {
sse_lsp_token_close (&lsp->token);
if (lsp->__dynamic) sse_free (lsp);
return SSE_NULL;
}
if (__add_builtin_prims(lsp) == -1) {
xp_lsp_mem_free (lsp->mem);
xp_lsp_token_close (&lsp->token);
if (lsp->__dynamic) xp_free (lsp);
return XP_NULL;
sse_lsp_mem_free (lsp->mem);
sse_lsp_token_close (&lsp->token);
if (lsp->__dynamic) sse_free (lsp);
return SSE_NULL;
}
lsp->max_eval_depth = 0; // TODO: put restriction here....
@ -54,53 +54,53 @@ xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
return lsp;
}
void xp_lsp_close (xp_lsp_t* lsp)
void sse_lsp_close (sse_lsp_t* lsp)
{
xp_assert (lsp != XP_NULL);
xp_lsp_mem_free (lsp->mem);
xp_lsp_token_close (&lsp->token);
if (lsp->__dynamic) xp_free (lsp);
sse_assert (lsp != SSE_NULL);
sse_lsp_mem_free (lsp->mem);
sse_lsp_token_close (&lsp->token);
if (lsp->__dynamic) sse_free (lsp);
}
int xp_lsp_attach_input (xp_lsp_t* lsp, xp_lsp_io_t input, void* arg)
int sse_lsp_attach_input (sse_lsp_t* lsp, sse_lsp_io_t input, void* arg)
{
if (xp_lsp_detach_input(lsp) == -1) return -1;
if (sse_lsp_detach_input(lsp) == -1) return -1;
xp_assert (lsp->input_func == XP_NULL);
sse_assert (lsp->input_func == SSE_NULL);
if (input(XP_LSP_IO_OPEN, arg, XP_NULL, 0) == -1) {
if (input(SSE_LSP_IO_OPEN, arg, SSE_NULL, 0) == -1) {
/* TODO: set error number */
return -1;
}
lsp->input_func = input;
lsp->input_arg = arg;
lsp->curc = XP_CHAR_EOF;
lsp->curc = SSE_CHAR_EOF;
return 0;
}
int xp_lsp_detach_input (xp_lsp_t* lsp)
int sse_lsp_detach_input (sse_lsp_t* lsp)
{
if (lsp->input_func != XP_NULL) {
if (lsp->input_func(XP_LSP_IO_CLOSE, lsp->input_arg, XP_NULL, 0) == -1) {
if (lsp->input_func != SSE_NULL) {
if (lsp->input_func(SSE_LSP_IO_CLOSE, lsp->input_arg, SSE_NULL, 0) == -1) {
/* TODO: set error number */
return -1;
}
lsp->input_func = XP_NULL;
lsp->input_arg = XP_NULL;
lsp->curc = XP_CHAR_EOF;
lsp->input_func = SSE_NULL;
lsp->input_arg = SSE_NULL;
lsp->curc = SSE_CHAR_EOF;
}
return 0;
}
int xp_lsp_attach_output (xp_lsp_t* lsp, xp_lsp_io_t output, void* arg)
int sse_lsp_attach_output (sse_lsp_t* lsp, sse_lsp_io_t output, void* arg)
{
if (xp_lsp_detach_output(lsp) == -1) return -1;
if (sse_lsp_detach_output(lsp) == -1) return -1;
xp_assert (lsp->output_func == XP_NULL);
sse_assert (lsp->output_func == SSE_NULL);
if (output(XP_LSP_IO_OPEN, arg, XP_NULL, 0) == -1) {
if (output(SSE_LSP_IO_OPEN, arg, SSE_NULL, 0) == -1) {
/* TODO: set error number */
return -1;
}
@ -109,59 +109,59 @@ int xp_lsp_attach_output (xp_lsp_t* lsp, xp_lsp_io_t output, void* arg)
return 0;
}
int xp_lsp_detach_output (xp_lsp_t* lsp)
int sse_lsp_detach_output (sse_lsp_t* lsp)
{
if (lsp->output_func != XP_NULL) {
if (lsp->output_func(XP_LSP_IO_CLOSE, lsp->output_arg, XP_NULL, 0) == -1) {
if (lsp->output_func != SSE_NULL) {
if (lsp->output_func(SSE_LSP_IO_CLOSE, lsp->output_arg, SSE_NULL, 0) == -1) {
/* TODO: set error number */
return -1;
}
lsp->output_func = XP_NULL;
lsp->output_arg = XP_NULL;
lsp->output_func = SSE_NULL;
lsp->output_arg = SSE_NULL;
}
return 0;
}
static int __add_builtin_prims (xp_lsp_t* lsp)
static int __add_builtin_prims (sse_lsp_t* lsp)
{
#define ADD_PRIM(mem,name,prim) \
if (xp_lsp_add_prim(mem,name,prim) == -1) return -1;
if (sse_lsp_add_prim(mem,name,prim) == -1) return -1;
ADD_PRIM (lsp, XP_TEXT("abort"), xp_lsp_prim_abort);
ADD_PRIM (lsp, XP_TEXT("eval"), xp_lsp_prim_eval);
ADD_PRIM (lsp, XP_TEXT("prog1"), xp_lsp_prim_prog1);
ADD_PRIM (lsp, XP_TEXT("progn"), xp_lsp_prim_progn);
ADD_PRIM (lsp, XP_TEXT("gc"), xp_lsp_prim_gc);
ADD_PRIM (lsp, SSE_TEXT("abort"), sse_lsp_prim_abort);
ADD_PRIM (lsp, SSE_TEXT("eval"), sse_lsp_prim_eval);
ADD_PRIM (lsp, SSE_TEXT("prog1"), sse_lsp_prim_prog1);
ADD_PRIM (lsp, SSE_TEXT("progn"), sse_lsp_prim_progn);
ADD_PRIM (lsp, SSE_TEXT("gc"), sse_lsp_prim_gc);
ADD_PRIM (lsp, XP_TEXT("cond"), xp_lsp_prim_cond);
ADD_PRIM (lsp, XP_TEXT("if"), xp_lsp_prim_if);
ADD_PRIM (lsp, XP_TEXT("while"), xp_lsp_prim_while);
ADD_PRIM (lsp, SSE_TEXT("cond"), sse_lsp_prim_cond);
ADD_PRIM (lsp, SSE_TEXT("if"), sse_lsp_prim_if);
ADD_PRIM (lsp, SSE_TEXT("while"), sse_lsp_prim_while);
ADD_PRIM (lsp, XP_TEXT("car"), xp_lsp_prim_car);
ADD_PRIM (lsp, XP_TEXT("cdr"), xp_lsp_prim_cdr);
ADD_PRIM (lsp, XP_TEXT("cons"), xp_lsp_prim_cons);
ADD_PRIM (lsp, XP_TEXT("set"), xp_lsp_prim_set);
ADD_PRIM (lsp, XP_TEXT("setq"), xp_lsp_prim_setq);
ADD_PRIM (lsp, XP_TEXT("quote"), xp_lsp_prim_quote);
ADD_PRIM (lsp, XP_TEXT("defun"), xp_lsp_prim_defun);
ADD_PRIM (lsp, XP_TEXT("demac"), xp_lsp_prim_demac);
ADD_PRIM (lsp, XP_TEXT("let"), xp_lsp_prim_let);
ADD_PRIM (lsp, XP_TEXT("let*"), xp_lsp_prim_letx);
ADD_PRIM (lsp, SSE_TEXT("car"), sse_lsp_prim_car);
ADD_PRIM (lsp, SSE_TEXT("cdr"), sse_lsp_prim_cdr);
ADD_PRIM (lsp, SSE_TEXT("cons"), sse_lsp_prim_cons);
ADD_PRIM (lsp, SSE_TEXT("set"), sse_lsp_prim_set);
ADD_PRIM (lsp, SSE_TEXT("setq"), sse_lsp_prim_setq);
ADD_PRIM (lsp, SSE_TEXT("quote"), sse_lsp_prim_quote);
ADD_PRIM (lsp, SSE_TEXT("defun"), sse_lsp_prim_defun);
ADD_PRIM (lsp, SSE_TEXT("demac"), sse_lsp_prim_demac);
ADD_PRIM (lsp, SSE_TEXT("let"), sse_lsp_prim_let);
ADD_PRIM (lsp, SSE_TEXT("let*"), sse_lsp_prim_letx);
ADD_PRIM (lsp, XP_TEXT("="), xp_lsp_prim_eq);
ADD_PRIM (lsp, XP_TEXT("/="), xp_lsp_prim_ne);
ADD_PRIM (lsp, XP_TEXT(">"), xp_lsp_prim_gt);
ADD_PRIM (lsp, XP_TEXT("<"), xp_lsp_prim_lt);
ADD_PRIM (lsp, XP_TEXT(">="), xp_lsp_prim_ge);
ADD_PRIM (lsp, XP_TEXT("<="), xp_lsp_prim_le);
ADD_PRIM (lsp, SSE_TEXT("="), sse_lsp_prim_eq);
ADD_PRIM (lsp, SSE_TEXT("/="), sse_lsp_prim_ne);
ADD_PRIM (lsp, SSE_TEXT(">"), sse_lsp_prim_gt);
ADD_PRIM (lsp, SSE_TEXT("<"), sse_lsp_prim_lt);
ADD_PRIM (lsp, SSE_TEXT(">="), sse_lsp_prim_ge);
ADD_PRIM (lsp, SSE_TEXT("<="), sse_lsp_prim_le);
ADD_PRIM (lsp, XP_TEXT("+"), xp_lsp_prim_plus);
ADD_PRIM (lsp, XP_TEXT("-"), xp_lsp_prim_minus);
ADD_PRIM (lsp, XP_TEXT("*"), xp_lsp_prim_multiply);
ADD_PRIM (lsp, XP_TEXT("/"), xp_lsp_prim_divide);
ADD_PRIM (lsp, XP_TEXT("%"), xp_lsp_prim_modulus);
ADD_PRIM (lsp, SSE_TEXT("+"), sse_lsp_prim_plus);
ADD_PRIM (lsp, SSE_TEXT("-"), sse_lsp_prim_minus);
ADD_PRIM (lsp, SSE_TEXT("*"), sse_lsp_prim_multiply);
ADD_PRIM (lsp, SSE_TEXT("/"), sse_lsp_prim_divide);
ADD_PRIM (lsp, SSE_TEXT("%"), sse_lsp_prim_modulus);
return 0;
}

148
ase/lsp/lsp.h
View File

@ -1,9 +1,9 @@
/*
* $Id: lsp.h,v 1.20 2005-12-05 15:11:29 bacon Exp $
* $Id: lsp.h,v 1.21 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_LSP_H_
#define _XP_LSP_LSP_H_
#ifndef _SSE_LSP_LSP_H_
#define _SSE_LSP_LSP_H_
/*
* HEADER: Lisp
@ -12,86 +12,86 @@
*
*/
#include <xp/lsp/types.h>
#include <xp/lsp/token.h>
#include <xp/lsp/obj.h>
#include <xp/lsp/mem.h>
#include <sse/lsp/types.h>
#include <sse/lsp/token.h>
#include <sse/lsp/obj.h>
#include <sse/lsp/mem.h>
#define XP_LSP_ERR(lsp) ((lsp)->errnum)
#define SSE_LSP_ERR(lsp) ((lsp)->errnum)
enum
{
XP_LSP_ERR_NONE = 0,
XP_LSP_ERR_ABORT,
XP_LSP_ERR_END,
XP_LSP_ERR_MEMORY,
XP_LSP_ERR_INPUT_NOT_ATTACHED,
XP_LSP_ERR_INPUT,
XP_LSP_ERR_OUTPUT_NOT_ATTACHED,
XP_LSP_ERR_OUTPUT,
XP_LSP_ERR_SYNTAX,
XP_LSP_ERR_BAD_ARG,
XP_LSP_ERR_WRONG_ARG,
XP_LSP_ERR_TOO_FEW_ARGS,
XP_LSP_ERR_TOO_MANY_ARGS,
XP_LSP_ERR_UNDEF_FUNC,
XP_LSP_ERR_BAD_FUNC,
XP_LSP_ERR_DUP_FORMAL,
XP_LSP_ERR_BAD_SYMBOL,
XP_LSP_ERR_UNDEF_SYMBOL,
XP_LSP_ERR_EMPTY_BODY,
XP_LSP_ERR_BAD_VALUE,
XP_LSP_ERR_DIVIDE_BY_ZERO
SSE_LSP_ERR_NONE = 0,
SSE_LSP_ERR_ABORT,
SSE_LSP_ERR_END,
SSE_LSP_ERR_MEMORY,
SSE_LSP_ERR_INPUT_NOT_ATTACHED,
SSE_LSP_ERR_INPUT,
SSE_LSP_ERR_OUTPUT_NOT_ATTACHED,
SSE_LSP_ERR_OUTPUT,
SSE_LSP_ERR_SYNTAX,
SSE_LSP_ERR_BAD_ARG,
SSE_LSP_ERR_WRONG_ARG,
SSE_LSP_ERR_TOO_FEW_ARGS,
SSE_LSP_ERR_TOO_MANY_ARGS,
SSE_LSP_ERR_UNDEF_FUNC,
SSE_LSP_ERR_BAD_FUNC,
SSE_LSP_ERR_DUP_FORMAL,
SSE_LSP_ERR_BAD_SYMBOL,
SSE_LSP_ERR_UNDEF_SYMBOL,
SSE_LSP_ERR_EMPTY_BODY,
SSE_LSP_ERR_BAD_VALUE,
SSE_LSP_ERR_DIVIDE_BY_ZERO
};
/*
* TYPE: xp_lsp_t
* TYPE: sse_lsp_t
* Defines a lisp processor type
*/
typedef struct xp_lsp_t xp_lsp_t;
typedef struct sse_lsp_t sse_lsp_t;
/*
* TYPE: xp_lsp_io_t
* TYPE: sse_lsp_io_t
* Defines an IO handler type
*/
typedef xp_ssize_t (*xp_lsp_io_t) (
int cmd, void* arg, xp_char_t* data, xp_size_t count);
typedef sse_ssize_t (*sse_lsp_io_t) (
int cmd, void* arg, sse_char_t* data, sse_size_t count);
enum
{
XP_LSP_IO_OPEN,
XP_LSP_IO_CLOSE,
XP_LSP_IO_DATA
SSE_LSP_IO_OPEN,
SSE_LSP_IO_CLOSE,
SSE_LSP_IO_DATA
};
/*
* TYPEDEF: xp_lsp_prim_t
* TYPEDEF: sse_lsp_prim_t
* Defines a primitive type
*/
typedef xp_lsp_obj_t* (*xp_lsp_prim_t) (xp_lsp_t* lsp, xp_lsp_obj_t* obj);
typedef sse_lsp_obj_t* (*sse_lsp_prim_t) (sse_lsp_t* lsp, sse_lsp_obj_t* obj);
struct xp_lsp_t
struct sse_lsp_t
{
/* error number */
int errnum;
int opt_undef_symbol;
/* for read */
xp_cint_t curc;
xp_lsp_token_t token;
sse_cint_t curc;
sse_lsp_token_t token;
/* io functions */
xp_lsp_io_t input_func;
xp_lsp_io_t output_func;
sse_lsp_io_t input_func;
sse_lsp_io_t output_func;
void* input_arg;
void* output_arg;
/* security options */
xp_size_t max_eval_depth;
xp_size_t cur_eval_depth;
sse_size_t max_eval_depth;
sse_size_t cur_eval_depth;
/* memory manager */
xp_lsp_mem_t* mem;
xp_bool_t __dynamic;
sse_lsp_mem_t* mem;
sse_bool_t __dynamic;
};
#ifdef __cplusplus
@ -99,33 +99,33 @@ extern "C" {
#endif
/*
* FUNCTION: xp_lsp_open
* FUNCTION: sse_lsp_open
* Instantiates a lisp processor
*
* PARAMETERS:
* lsp - pointer to lisp processor space or XP_NULL
* lsp - pointer to lisp processor space or SSE_NULL
* mem_ubound - memory upper bound
* mem_ubound_inc - memory increment
*/
xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
xp_size_t mem_ubound, xp_size_t mem_ubound_inc);
sse_lsp_t* sse_lsp_open (sse_lsp_t* lsp,
sse_size_t mem_ubound, sse_size_t mem_ubound_inc);
/*
* FUNCTION: xp_lsp_close
* FUNCTION: sse_lsp_close
* Destroys a lisp processor
*
* PARAMETERS:
* lsp - the pointer to the lisp object
*/
void xp_lsp_close (xp_lsp_t* lsp);
void sse_lsp_close (sse_lsp_t* lsp);
/*
* FUNCTION: xp_lsp_error
* FUNCTION: sse_lsp_error
*/
int xp_lsp_error (xp_lsp_t* lsp, xp_char_t* buf, xp_size_t size);
int sse_lsp_error (sse_lsp_t* lsp, sse_char_t* buf, sse_size_t size);
/*
* FUNCTION: xp_lsp_attach_input
* FUNCTION: sse_lsp_attach_input
* Attaches an input handler function
*
* PARAMETERS:
@ -136,19 +136,19 @@ int xp_lsp_error (xp_lsp_t* lsp, xp_char_t* buf, xp_size_t size);
* RETURNS:
* 0 on success, -1 on failure
*/
int xp_lsp_attach_input (xp_lsp_t* lsp, xp_lsp_io_t input, void* arg);
int sse_lsp_attach_input (sse_lsp_t* lsp, sse_lsp_io_t input, void* arg);
/*
* FUNCTION: xp_lsp_detach_input
* FUNCTION: sse_lsp_detach_input
* Detaches an input handler function
*
* RETURNS:
* 0 on success, -1 on failure
*/
int xp_lsp_detach_input (xp_lsp_t* lsp);
int sse_lsp_detach_input (sse_lsp_t* lsp);
/*
* FUNCTION: xp_lsp_attach_output
* FUNCTION: sse_lsp_attach_output
* Attaches an output handler function
*
* PARAMETERS:
@ -159,46 +159,46 @@ int xp_lsp_detach_input (xp_lsp_t* lsp);
* RETURNS:
* 0 on success, -1 on failure
*/
int xp_lsp_attach_output (xp_lsp_t* lsp, xp_lsp_io_t output, void* arg);
int sse_lsp_attach_output (sse_lsp_t* lsp, sse_lsp_io_t output, void* arg);
/*
* FUNCTION: xp_lsp_detach_output
* FUNCTION: sse_lsp_detach_output
* Detaches an output handler function
*
* RETURNS:
* 0 on success, -1 on failure
*/
int xp_lsp_detach_output (xp_lsp_t* lsp);
int sse_lsp_detach_output (sse_lsp_t* lsp);
/*
* FUNCTION: xp_lsp_read
* FUNCTION: sse_lsp_read
* Reads a lisp expression
*/
xp_lsp_obj_t* xp_lsp_read (xp_lsp_t* lsp);
sse_lsp_obj_t* sse_lsp_read (sse_lsp_t* lsp);
/*
* FUNCTION: xp_lsp_eval
* FUNCTION: sse_lsp_eval
* Evaluates a lisp object
*/
xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj);
sse_lsp_obj_t* sse_lsp_eval (sse_lsp_t* lsp, sse_lsp_obj_t* obj);
/*
* FUNCTION: xp_lsp_print
* FUNCTION: sse_lsp_print
* Prints a lisp object
*/
int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj);
int sse_lsp_print (sse_lsp_t* lsp, const sse_lsp_obj_t* obj);
/*
* FUNCTION: xp_lsp_add_prim
* FUNCTION: sse_lsp_add_prim
* Adds a user-defined primitive
*/
int xp_lsp_add_prim (xp_lsp_t* lsp, const xp_char_t* name, xp_lsp_prim_t prim);
int sse_lsp_add_prim (sse_lsp_t* lsp, const sse_char_t* name, sse_lsp_prim_t prim);
/*
* FUNCTION: xp_lsp_remove_prim
* FUNCTION: sse_lsp_remove_prim
* Removes a user-defined primitive
*/
int xp_lsp_remove_prim (xp_lsp_t* lsp, const xp_char_t* name);
int sse_lsp_remove_prim (sse_lsp_t* lsp, const sse_char_t* name);
#ifdef __cplusplus
}

2
ase/lsp/makefile.in
View File

@ -6,7 +6,7 @@ OUT = libxplsp.a
CC = @CC@
RANLIB = @RANLIB@
CFLAGS = @CFLAGS@ -I@abs_top_builddir@
CFLAGS = @CFLAGS@ -I@abs_top_builddir@/..
LDFLAGS = @LDFLAGS@
LIBS = @LIBS@

644
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.6 2005-09-20 11:19:15 bacon Exp $
* $Id: mem.h,v 1.7 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_MEM_H_
#define _XP_LSP_MEM_H_
#ifndef _SSE_LSP_MEM_H_
#define _SSE_LSP_MEM_H_
#include <xp/lsp/obj.h>
#include <xp/lsp/env.h>
#include <xp/lsp/array.h>
#include <sse/lsp/obj.h>
#include <sse/lsp/env.h>
#include <sse/lsp/array.h>
struct xp_lsp_mem_t
struct sse_lsp_mem_t
{
/*
* object allocation list
*/
xp_size_t ubound; // upper bounds of the maximum number of objects
xp_size_t ubound_inc; // increment of the upper bounds
xp_size_t count; // the number of objects currently allocated
xp_lsp_obj_t* used[XP_LSP_TYPE_COUNT];
xp_lsp_obj_t* free[XP_LSP_TYPE_COUNT];
xp_lsp_obj_t* locked;
sse_size_t ubound; // upper bounds of the maximum number of objects
sse_size_t ubound_inc; // increment of the upper bounds
sse_size_t count; // the number of objects currently allocated
sse_lsp_obj_t* used[SSE_LSP_TYPE_COUNT];
sse_lsp_obj_t* free[SSE_LSP_TYPE_COUNT];
sse_lsp_obj_t* locked;
/*
* commonly accessed objects
*/
xp_lsp_obj_t* nil; // xp_lsp_obj_nil_t
xp_lsp_obj_t* t; // xp_lsp_obj_true_t
xp_lsp_obj_t* quote; // xp_lsp_obj_symbol_t
xp_lsp_obj_t* lambda; // xp_lsp_obj_symbol_t
xp_lsp_obj_t* macro; // xp_lsp_obj_symbol_t
sse_lsp_obj_t* nil; // sse_lsp_obj_nil_t
sse_lsp_obj_t* t; // sse_lsp_obj_true_t
sse_lsp_obj_t* quote; // sse_lsp_obj_symbol_t
sse_lsp_obj_t* lambda; // sse_lsp_obj_symbol_t
sse_lsp_obj_t* macro; // sse_lsp_obj_symbol_t
/*
* run-time environment frame
*/
xp_lsp_frame_t* frame;
sse_lsp_frame_t* frame;
// pointer to a global-level frame
xp_lsp_frame_t* root_frame;
sse_lsp_frame_t* root_frame;
// pointer to an interim frame not yet added to "frame"
xp_lsp_frame_t* brooding_frame;
sse_lsp_frame_t* brooding_frame;
/*
* temporary objects
*/
xp_lsp_array_t* temp_array;
sse_lsp_array_t* temp_array;
};
typedef struct xp_lsp_mem_t xp_lsp_mem_t;
typedef struct sse_lsp_mem_t sse_lsp_mem_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_mem_t* xp_lsp_mem_new (xp_size_t ubound, xp_size_t ubound_inc);
void xp_lsp_mem_free (xp_lsp_mem_t* mem);
sse_lsp_mem_t* sse_lsp_mem_new (sse_size_t ubound, sse_size_t ubound_inc);
void sse_lsp_mem_free (sse_lsp_mem_t* mem);
int xp_lsp_add_builtin_prims (xp_lsp_mem_t* mem);
int sse_lsp_add_builtin_prims (sse_lsp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_alloc (xp_lsp_mem_t* mem, int type, xp_size_t size);
void xp_lsp_dispose (xp_lsp_mem_t* mem, xp_lsp_obj_t* prev, xp_lsp_obj_t* obj);
void xp_lsp_dispose_all (xp_lsp_mem_t* mem);
void xp_lsp_garbage_collect (xp_lsp_mem_t* mem);
sse_lsp_obj_t* sse_lsp_alloc (sse_lsp_mem_t* mem, int type, sse_size_t size);
void sse_lsp_dispose (sse_lsp_mem_t* mem, sse_lsp_obj_t* prev, sse_lsp_obj_t* obj);
void sse_lsp_dispose_all (sse_lsp_mem_t* mem);
void sse_lsp_garbage_collect (sse_lsp_mem_t* mem);
void xp_lsp_lock (xp_lsp_obj_t* obj);
void xp_lsp_unlock (xp_lsp_obj_t* obj);
void xp_lsp_unlock_all (xp_lsp_obj_t* obj);
void sse_lsp_lock (sse_lsp_obj_t* obj);
void sse_lsp_unlock (sse_lsp_obj_t* obj);
void sse_lsp_unlock_all (sse_lsp_obj_t* obj);
// object creation of standard types
xp_lsp_obj_t* xp_lsp_make_nil (xp_lsp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_make_true (xp_lsp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_make_int (xp_lsp_mem_t* mem, xp_lsp_int_t value);
xp_lsp_obj_t* xp_lsp_make_real (xp_lsp_mem_t* mem, xp_lsp_real_t value);
sse_lsp_obj_t* sse_lsp_make_nil (sse_lsp_mem_t* mem);
sse_lsp_obj_t* sse_lsp_make_true (sse_lsp_mem_t* mem);
sse_lsp_obj_t* sse_lsp_make_int (sse_lsp_mem_t* mem, sse_lsp_int_t value);
sse_lsp_obj_t* sse_lsp_make_real (sse_lsp_mem_t* mem, sse_lsp_real_t value);
xp_lsp_obj_t* xp_lsp_make_symbol (
xp_lsp_mem_t* mem, const xp_char_t* str);
xp_lsp_obj_t* xp_lsp_make_symbolx (
xp_lsp_mem_t* mem, const xp_char_t* str, xp_size_t len);
xp_lsp_obj_t* xp_lsp_make_string (
xp_lsp_mem_t* mem, const xp_char_t* str);
xp_lsp_obj_t* xp_lsp_make_stringx (
xp_lsp_mem_t* mem, const xp_char_t* str, xp_size_t len);
xp_lsp_obj_t* xp_lsp_make_cons (
xp_lsp_mem_t* mem, xp_lsp_obj_t* car, xp_lsp_obj_t* cdr);
xp_lsp_obj_t* xp_lsp_make_func (
xp_lsp_mem_t* mem, xp_lsp_obj_t* formal, xp_lsp_obj_t* body);
xp_lsp_obj_t* xp_lsp_make_macro (
xp_lsp_mem_t* mem, xp_lsp_obj_t* formal, xp_lsp_obj_t* body);
sse_lsp_obj_t* sse_lsp_make_symbol (
sse_lsp_mem_t* mem, const sse_char_t* str);
sse_lsp_obj_t* sse_lsp_make_symbolx (
sse_lsp_mem_t* mem, const sse_char_t* str, sse_size_t len);
sse_lsp_obj_t* sse_lsp_make_string (
sse_lsp_mem_t* mem, const sse_char_t* str);
sse_lsp_obj_t* sse_lsp_make_stringx (
sse_lsp_mem_t* mem, const sse_char_t* str, sse_size_t len);
sse_lsp_obj_t* sse_lsp_make_cons (
sse_lsp_mem_t* mem, sse_lsp_obj_t* car, sse_lsp_obj_t* cdr);
sse_lsp_obj_t* sse_lsp_make_func (
sse_lsp_mem_t* mem, sse_lsp_obj_t* formal, sse_lsp_obj_t* body);
sse_lsp_obj_t* sse_lsp_make_macro (
sse_lsp_mem_t* mem, sse_lsp_obj_t* formal, sse_lsp_obj_t* body);
xp_lsp_obj_t* xp_lsp_make_prim (xp_lsp_mem_t* mem, void* impl);
sse_lsp_obj_t* sse_lsp_make_prim (sse_lsp_mem_t* mem, void* impl);
// frame lookup
xp_lsp_assoc_t* xp_lsp_lookup (xp_lsp_mem_t* mem, xp_lsp_obj_t* name);
xp_lsp_assoc_t* xp_lsp_set_value (
xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* value);
xp_lsp_assoc_t* xp_lsp_set_func (
xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* func);
sse_lsp_assoc_t* sse_lsp_lookup (sse_lsp_mem_t* mem, sse_lsp_obj_t* name);
sse_lsp_assoc_t* sse_lsp_set_value (
sse_lsp_mem_t* mem, sse_lsp_obj_t* name, sse_lsp_obj_t* value);
sse_lsp_assoc_t* sse_lsp_set_func (
sse_lsp_mem_t* mem, sse_lsp_obj_t* name, sse_lsp_obj_t* func);
// cons operations
xp_size_t xp_lsp_cons_len (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj);
int xp_lsp_probe_args (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj, xp_size_t* len);
sse_size_t sse_lsp_cons_len (sse_lsp_mem_t* mem, sse_lsp_obj_t* obj);
int sse_lsp_probe_args (sse_lsp_mem_t* mem, sse_lsp_obj_t* obj, sse_size_t* len);
// symbol and string operations
int xp_lsp_comp_symbol (xp_lsp_obj_t* obj, const xp_char_t* str);
int xp_lsp_comp_symbol2 (xp_lsp_obj_t* obj, const xp_char_t* str, xp_size_t len);
int xp_lsp_comp_string (xp_lsp_obj_t* obj, const xp_char_t* str);
int xp_lsp_comp_string2 (xp_lsp_obj_t* obj, const xp_char_t* str, xp_size_t len);
void xp_lsp_copy_string (xp_char_t* dst, const xp_char_t* str);
void xp_lsp_copy_string2 (xp_char_t* dst, const xp_char_t* str, xp_size_t len);
int sse_lsp_comp_symbol (sse_lsp_obj_t* obj, const sse_char_t* str);
int sse_lsp_comp_symbol2 (sse_lsp_obj_t* obj, const sse_char_t* str, sse_size_t len);
int sse_lsp_comp_string (sse_lsp_obj_t* obj, const sse_char_t* str);
int sse_lsp_comp_string2 (sse_lsp_obj_t* obj, const sse_char_t* str, sse_size_t len);
void sse_lsp_copy_string (sse_char_t* dst, const sse_char_t* str);
void sse_lsp_copy_string2 (sse_char_t* dst, const sse_char_t* str, sse_size_t len);
#ifdef __cplusplus
}

124
ase/lsp/name.c
View File

@ -1,75 +1,75 @@
/*
* $Id: name.c,v 1.3 2005-12-05 15:11:29 bacon Exp $
* $Id: name.c,v 1.4 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/name.h>
#include <xp/bas/memory.h>
#include <xp/bas/assert.h>
#include <sse/lsp/name.h>
#include <sse/bas/memory.h>
#include <sse/bas/assert.h>
xp_lsp_name_t* xp_lsp_name_open (
xp_lsp_name_t* name, xp_word_t capacity)
sse_lsp_name_t* sse_lsp_name_open (
sse_lsp_name_t* name, sse_word_t capacity)
{
if (capacity == 0)
capacity = xp_countof(name->static_buffer) - 1;
capacity = sse_countof(name->static_buffer) - 1;
if (name == XP_NULL) {
name = (xp_lsp_name_t*)
xp_malloc (xp_sizeof(xp_lsp_name_t));
if (name == XP_NULL) return XP_NULL;
name->__dynamic = xp_true;
if (name == SSE_NULL) {
name = (sse_lsp_name_t*)
sse_malloc (sse_sizeof(sse_lsp_name_t));
if (name == SSE_NULL) return SSE_NULL;
name->__dynamic = sse_true;
}
else name->__dynamic = xp_false;
else name->__dynamic = sse_false;
if (capacity < xp_countof(name->static_buffer)) {
if (capacity < sse_countof(name->static_buffer)) {
name->buffer = name->static_buffer;
}
else {
name->buffer = (xp_char_t*)
xp_malloc ((capacity + 1) * xp_sizeof(xp_char_t));
if (name->buffer == XP_NULL) {
if (name->__dynamic) xp_free (name);
return XP_NULL;
name->buffer = (sse_char_t*)
sse_malloc ((capacity + 1) * sse_sizeof(sse_char_t));
if (name->buffer == SSE_NULL) {
if (name->__dynamic) sse_free (name);
return SSE_NULL;
}
}
name->size = 0;
name->capacity = capacity;
name->buffer[0] = XP_CHAR('\0');
name->buffer[0] = SSE_CHAR('\0');
return name;
}
void xp_lsp_name_close (xp_lsp_name_t* name)
void sse_lsp_name_close (sse_lsp_name_t* name)
{
if (name->capacity >= xp_countof(name->static_buffer)) {
xp_assert (name->buffer != name->static_buffer);
xp_free (name->buffer);
if (name->capacity >= sse_countof(name->static_buffer)) {
sse_assert (name->buffer != name->static_buffer);
sse_free (name->buffer);
}
if (name->__dynamic) xp_free (name);
if (name->__dynamic) sse_free (name);
}
int xp_lsp_name_addc (xp_lsp_name_t* name, xp_cint_t c)
int sse_lsp_name_addc (sse_lsp_name_t* name, sse_cint_t c)
{
if (name->size >= name->capacity) {
/* double the capacity. */
xp_size_t new_capacity = name->capacity * 2;
sse_size_t new_capacity = name->capacity * 2;
if (new_capacity >= xp_countof(name->static_buffer)) {
xp_char_t* space;
if (new_capacity >= sse_countof(name->static_buffer)) {
sse_char_t* space;
if (name->capacity < xp_countof(name->static_buffer)) {
space = (xp_char_t*)xp_malloc (
(new_capacity + 1) * xp_sizeof(xp_char_t));
if (space == XP_NULL) return -1;
if (name->capacity < sse_countof(name->static_buffer)) {
space = (sse_char_t*)sse_malloc (
(new_capacity + 1) * sse_sizeof(sse_char_t));
if (space == SSE_NULL) return -1;
/* don't need to copy up to the terminating null */
xp_memcpy (space, name->buffer,
name->capacity * xp_sizeof(xp_char_t));
sse_memcpy (space, name->buffer,
name->capacity * sse_sizeof(sse_char_t));
}
else {
space = (xp_char_t*)xp_realloc (name->buffer,
(new_capacity + 1) * xp_sizeof(xp_char_t));
if (space == XP_NULL) return -1;
space = (sse_char_t*)sse_realloc (name->buffer,
(new_capacity + 1) * sse_sizeof(sse_char_t));
if (space == SSE_NULL) return -1;
}
name->buffer = space;
@ -79,63 +79,63 @@ int xp_lsp_name_addc (xp_lsp_name_t* name, xp_cint_t c)
}
name->buffer[name->size++] = c;
name->buffer[name->size] = XP_CHAR('\0');
name->buffer[name->size] = SSE_CHAR('\0');
return 0;
}
int xp_lsp_name_adds (xp_lsp_name_t* name, const xp_char_t* s)
int sse_lsp_name_adds (sse_lsp_name_t* name, const sse_char_t* s)
{
while (*s != XP_CHAR('\0')) {
if (xp_lsp_name_addc(name, *s) == -1) return -1;
while (*s != SSE_CHAR('\0')) {
if (sse_lsp_name_addc(name, *s) == -1) return -1;
s++;
}
return 0;
}
void xp_lsp_name_clear (xp_lsp_name_t* name)
void sse_lsp_name_clear (sse_lsp_name_t* name)
{
name->size = 0;
name->buffer[0] = XP_CHAR('\0');
name->buffer[0] = SSE_CHAR('\0');
}
xp_char_t* xp_lsp_name_yield (xp_lsp_name_t* name, xp_word_t capacity)
sse_char_t* sse_lsp_name_yield (sse_lsp_name_t* name, sse_word_t capacity)
{
xp_char_t* old_buffer, * new_buffer;
sse_char_t* old_buffer, * new_buffer;
if (capacity == 0)
capacity = xp_countof(name->static_buffer) - 1;
capacity = sse_countof(name->static_buffer) - 1;
if (name->capacity < xp_countof(name->static_buffer)) {
old_buffer = (xp_char_t*)
xp_malloc((name->capacity + 1) * xp_sizeof(xp_char_t));
if (old_buffer == XP_NULL) return XP_NULL;
xp_memcpy (old_buffer, name->buffer,
(name->capacity + 1) * xp_sizeof(xp_char_t));
if (name->capacity < sse_countof(name->static_buffer)) {
old_buffer = (sse_char_t*)
sse_malloc((name->capacity + 1) * sse_sizeof(sse_char_t));
if (old_buffer == SSE_NULL) return SSE_NULL;
sse_memcpy (old_buffer, name->buffer,
(name->capacity + 1) * sse_sizeof(sse_char_t));
}
else old_buffer = name->buffer;
if (capacity < xp_countof(name->static_buffer)) {
if (capacity < sse_countof(name->static_buffer)) {
new_buffer = name->static_buffer;
}
else {
new_buffer = (xp_char_t*)
xp_malloc((capacity + 1) * xp_sizeof(xp_char_t));
if (new_buffer == XP_NULL) return XP_NULL;
new_buffer = (sse_char_t*)
sse_malloc((capacity + 1) * sse_sizeof(sse_char_t));
if (new_buffer == SSE_NULL) return SSE_NULL;
}
name->buffer = new_buffer;
name->size = 0;
name->capacity = capacity;
name->buffer[0] = XP_CHAR('\0');
name->buffer[0] = SSE_CHAR('\0');
return old_buffer;
}
int xp_lsp_name_compare (xp_lsp_name_t* name, const xp_char_t* str)
int sse_lsp_name_compare (sse_lsp_name_t* name, const sse_char_t* str)
{
xp_char_t* p = name->buffer;
xp_word_t index = 0;
sse_char_t* p = name->buffer;
sse_word_t index = 0;
while (index < name->size) {
if (*p > *str) return 1;
@ -143,5 +143,5 @@ int xp_lsp_name_compare (xp_lsp_name_t* name, const xp_char_t* str)
index++; p++; str++;
}
return (*str == XP_CHAR('\0'))? 0: -1;
return (*str == SSE_CHAR('\0'))? 0: -1;
}

40
ase/lsp/name.h
View File

@ -1,37 +1,37 @@
/*
* $Id: name.h,v 1.3 2005-12-05 15:11:29 bacon Exp $
* $Id: name.h,v 1.4 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_NAME_H_
#define _XP_LSP_NAME_H_
#ifndef _SSE_LSP_NAME_H_
#define _SSE_LSP_NAME_H_
#include <xp/types.h>
#include <xp/macros.h>
#include <sse/types.h>
#include <sse/macros.h>
struct xp_lsp_name_t
struct sse_lsp_name_t
{
xp_word_t capacity;
xp_word_t size;
xp_char_t* buffer;
xp_char_t static_buffer[128];
xp_bool_t __dynamic;
sse_word_t capacity;
sse_word_t size;
sse_char_t* buffer;
sse_char_t static_buffer[128];
sse_bool_t __dynamic;
};
typedef struct xp_lsp_name_t xp_lsp_name_t;
typedef struct sse_lsp_name_t sse_lsp_name_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_name_t* xp_lsp_name_open (
xp_lsp_name_t* name, xp_word_t capacity);
void xp_lsp_name_close (xp_lsp_name_t* name);
sse_lsp_name_t* sse_lsp_name_open (
sse_lsp_name_t* name, sse_word_t capacity);
void sse_lsp_name_close (sse_lsp_name_t* name);
int xp_lsp_name_addc (xp_lsp_name_t* name, xp_cint_t c);
int xp_lsp_name_adds (xp_lsp_name_t* name, const xp_char_t* s);
void xp_lsp_name_clear (xp_lsp_name_t* name);
xp_char_t* xp_lsp_name_yield (xp_lsp_name_t* name, xp_word_t capacity);
int xp_lsp_name_compare (xp_lsp_name_t* name, const xp_char_t* str);
int sse_lsp_name_addc (sse_lsp_name_t* name, sse_cint_t c);
int sse_lsp_name_adds (sse_lsp_name_t* name, const sse_char_t* s);
void sse_lsp_name_clear (sse_lsp_name_t* name);
sse_char_t* sse_lsp_name_yield (sse_lsp_name_t* name, sse_word_t capacity);
int sse_lsp_name_compare (sse_lsp_name_t* name, const sse_char_t* str);
#ifdef __cplusplus
}

172
ase/lsp/obj.h
View File

@ -1,154 +1,154 @@
/*
* $Id: obj.h,v 1.4 2005-09-21 15:53:55 bacon Exp $
* $Id: obj.h,v 1.5 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_OBJ_H_
#define _XP_LSP_OBJ_H_
#ifndef _SSE_LSP_OBJ_H_
#define _SSE_LSP_OBJ_H_
#include <xp/lsp/types.h>
#include <sse/lsp/types.h>
/* object types */
enum
{
XP_LSP_OBJ_NIL = 0,
XP_LSP_OBJ_TRUE,
XP_LSP_OBJ_INT,
XP_LSP_OBJ_REAL,
XP_LSP_OBJ_SYMBOL,
XP_LSP_OBJ_STRING,
XP_LSP_OBJ_CONS,
XP_LSP_OBJ_FUNC,
XP_LSP_OBJ_MACRO,
XP_LSP_OBJ_PRIM,
SSE_LSP_OBJ_NIL = 0,
SSE_LSP_OBJ_TRUE,
SSE_LSP_OBJ_INT,
SSE_LSP_OBJ_REAL,
SSE_LSP_OBJ_SYMBOL,
SSE_LSP_OBJ_STRING,
SSE_LSP_OBJ_CONS,
SSE_LSP_OBJ_FUNC,
SSE_LSP_OBJ_MACRO,
SSE_LSP_OBJ_PRIM,
XP_LSP_TYPE_COUNT // the number of lsp object types
SSE_LSP_TYPE_COUNT // the number of lsp object types
};
typedef struct xp_lsp_objhdr_t xp_lsp_objhdr_t;
typedef struct xp_lsp_obj_t xp_lsp_obj_t;
typedef struct xp_lsp_obj_nil_t xp_lsp_obj_nil_t;
typedef struct xp_lsp_obj_true_t xp_lsp_obj_true_t;
typedef struct xp_lsp_obj_int_t xp_lsp_obj_int_t;
typedef struct xp_lsp_obj_real_t xp_lsp_obj_real_t;
typedef struct xp_lsp_obj_symbol_t xp_lsp_obj_symbol_t;
typedef struct xp_lsp_obj_string_t xp_lsp_obj_string_t;
typedef struct xp_lsp_obj_cons_t xp_lsp_obj_cons_t;
typedef struct xp_lsp_obj_func_t xp_lsp_obj_func_t;
typedef struct xp_lsp_obj_macro_t xp_lsp_obj_macro_t;
typedef struct xp_lsp_obj_prim_t xp_lsp_obj_prim_t;
typedef struct sse_lsp_objhdr_t sse_lsp_objhdr_t;
typedef struct sse_lsp_obj_t sse_lsp_obj_t;
typedef struct sse_lsp_obj_nil_t sse_lsp_obj_nil_t;
typedef struct sse_lsp_obj_true_t sse_lsp_obj_true_t;
typedef struct sse_lsp_obj_int_t sse_lsp_obj_int_t;
typedef struct sse_lsp_obj_real_t sse_lsp_obj_real_t;
typedef struct sse_lsp_obj_symbol_t sse_lsp_obj_symbol_t;
typedef struct sse_lsp_obj_string_t sse_lsp_obj_string_t;
typedef struct sse_lsp_obj_cons_t sse_lsp_obj_cons_t;
typedef struct sse_lsp_obj_func_t sse_lsp_obj_func_t;
typedef struct sse_lsp_obj_macro_t sse_lsp_obj_macro_t;
typedef struct sse_lsp_obj_prim_t sse_lsp_obj_prim_t;
struct xp_lsp_objhdr_t
struct sse_lsp_objhdr_t
{
xp_uint32_t type: 24;
xp_uint32_t mark: 4;
xp_uint32_t lock: 4;
xp_size_t size;
xp_lsp_obj_t* link;
sse_uint32_t type: 24;
sse_uint32_t mark: 4;
sse_uint32_t lock: 4;
sse_size_t size;
sse_lsp_obj_t* link;
};
struct xp_lsp_obj_t
struct sse_lsp_obj_t
{
xp_lsp_objhdr_t hdr;
sse_lsp_objhdr_t hdr;
};
struct xp_lsp_obj_nil_t
struct sse_lsp_obj_nil_t
{
xp_lsp_objhdr_t hdr;
sse_lsp_objhdr_t hdr;
};
struct xp_lsp_obj_true_t
struct sse_lsp_obj_true_t
{
xp_lsp_objhdr_t hdr;
sse_lsp_objhdr_t hdr;
};
struct xp_lsp_obj_int_t
struct sse_lsp_obj_int_t
{
xp_lsp_objhdr_t hdr;
xp_lsp_int_t value;
sse_lsp_objhdr_t hdr;
sse_lsp_int_t value;
};
struct xp_lsp_obj_real_t
struct sse_lsp_obj_real_t
{
xp_lsp_objhdr_t hdr;
xp_lsp_real_t value;
sse_lsp_objhdr_t hdr;
sse_lsp_real_t value;
};
struct xp_lsp_obj_symbol_t
struct sse_lsp_obj_symbol_t
{
xp_lsp_objhdr_t hdr;
sse_lsp_objhdr_t hdr;
#ifdef __BORLANDC__
#else
xp_char_t buffer[0];
sse_char_t buffer[0];
#endif
};
struct xp_lsp_obj_string_t
struct sse_lsp_obj_string_t
{
xp_lsp_objhdr_t hdr;
sse_lsp_objhdr_t hdr;
#ifdef __BORLANDC__
#else
xp_char_t buffer[0];
sse_char_t buffer[0];
#endif
};
struct xp_lsp_obj_cons_t
struct sse_lsp_obj_cons_t
{
xp_lsp_objhdr_t hdr;
struct xp_lsp_obj_t* car;
struct xp_lsp_obj_t* cdr;
sse_lsp_objhdr_t hdr;
struct sse_lsp_obj_t* car;
struct sse_lsp_obj_t* cdr;
};
struct xp_lsp_obj_func_t
struct sse_lsp_obj_func_t
{
xp_lsp_objhdr_t hdr;
struct xp_lsp_obj_t* formal;
struct xp_lsp_obj_t* body;
sse_lsp_objhdr_t hdr;
struct sse_lsp_obj_t* formal;
struct sse_lsp_obj_t* body;
};
struct xp_lsp_obj_macro_t
struct sse_lsp_obj_macro_t
{
xp_lsp_objhdr_t hdr;
struct xp_lsp_obj_t* formal;
struct xp_lsp_obj_t* body;
sse_lsp_objhdr_t hdr;
struct sse_lsp_obj_t* formal;
struct sse_lsp_obj_t* body;
};
struct xp_lsp_obj_prim_t
struct sse_lsp_obj_prim_t
{
xp_lsp_objhdr_t hdr;
void* impl; /* xp_lsp_prim_t */
sse_lsp_objhdr_t hdr;
void* impl; /* sse_lsp_prim_t */
};
/* header access */
#define XP_LSP_TYPE(x) (((xp_lsp_obj_t*)x)->hdr.type)
#define XP_LSP_SIZE(x) (((xp_lsp_obj_t*)x)->hdr.size)
#define XP_LSP_MARK(x) (((xp_lsp_obj_t*)x)->hdr.mark)
#define XP_LSP_LOCK(x) (((xp_lsp_obj_t*)x)->hdr.lock)
#define XP_LSP_LINK(x) (((xp_lsp_obj_t*)x)->hdr.link)
#define SSE_LSP_TYPE(x) (((sse_lsp_obj_t*)x)->hdr.type)
#define SSE_LSP_SIZE(x) (((sse_lsp_obj_t*)x)->hdr.size)
#define SSE_LSP_MARK(x) (((sse_lsp_obj_t*)x)->hdr.mark)
#define SSE_LSP_LOCK(x) (((sse_lsp_obj_t*)x)->hdr.lock)
#define SSE_LSP_LINK(x) (((sse_lsp_obj_t*)x)->hdr.link)
/* value access */
#define XP_LSP_IVALUE(x) (((xp_lsp_obj_int_t*)x)->value)
#define XP_LSP_RVALUE(x) (((xp_lsp_obj_real_t*)x)->value)
#define SSE_LSP_IVALUE(x) (((sse_lsp_obj_int_t*)x)->value)
#define SSE_LSP_RVALUE(x) (((sse_lsp_obj_real_t*)x)->value)
#ifdef __BORLANDC__
#define XP_LSP_SYMVALUE(x) ((xp_char_t*)(((xp_lsp_obj_symbol_t*)x) + 1))
#define SSE_LSP_SYMVALUE(x) ((sse_char_t*)(((sse_lsp_obj_symbol_t*)x) + 1))
#else
#define XP_LSP_SYMVALUE(x) (((xp_lsp_obj_symbol_t*)x)->buffer)
#define SSE_LSP_SYMVALUE(x) (((sse_lsp_obj_symbol_t*)x)->buffer)
#endif
#define XP_LSP_SYMLEN(x) ((((xp_lsp_obj_symbol_t*)x)->hdr.size - sizeof(xp_lsp_obj_t)) / sizeof(xp_char_t) - 1)
#define SSE_LSP_SYMLEN(x) ((((sse_lsp_obj_symbol_t*)x)->hdr.size - sizeof(sse_lsp_obj_t)) / sizeof(sse_char_t) - 1)
#ifdef __BORLANDC__
#define XP_LSP_STRVALUE(x) ((xp_char_t*)(((xp_lsp_obj_string_t*)x) + 1))
#define SSE_LSP_STRVALUE(x) ((sse_char_t*)(((sse_lsp_obj_string_t*)x) + 1))
#else
#define XP_LSP_STRVALUE(x) (((xp_lsp_obj_string_t*)x)->buffer)
#define SSE_LSP_STRVALUE(x) (((sse_lsp_obj_string_t*)x)->buffer)
#endif
#define XP_LSP_STRLEN(x) ((((xp_lsp_obj_string_t*)x)->hdr.size - sizeof(xp_lsp_obj_t)) / sizeof(xp_char_t) - 1)
#define SSE_LSP_STRLEN(x) ((((sse_lsp_obj_string_t*)x)->hdr.size - sizeof(sse_lsp_obj_t)) / sizeof(sse_char_t) - 1)
#define XP_LSP_CAR(x) (((xp_lsp_obj_cons_t*)x)->car)
#define XP_LSP_CDR(x) (((xp_lsp_obj_cons_t*)x)->cdr)
#define XP_LSP_FFORMAL(x) (((xp_lsp_obj_func_t*)x)->formal)
#define XP_LSP_FBODY(x) (((xp_lsp_obj_func_t*)x)->body)
#define XP_LSP_MFORMAL(x) (((xp_lsp_obj_macro_t*)x)->formal)
#define XP_LSP_MBODY(x) (((xp_lsp_obj_macro_t*)x)->body)
#define XP_LSP_PRIM(x) ((xp_lsp_prim_t)(((xp_lsp_obj_prim_t*)x)->impl))
#define SSE_LSP_CAR(x) (((sse_lsp_obj_cons_t*)x)->car)
#define SSE_LSP_CDR(x) (((sse_lsp_obj_cons_t*)x)->cdr)
#define SSE_LSP_FFORMAL(x) (((sse_lsp_obj_func_t*)x)->formal)
#define SSE_LSP_FBODY(x) (((sse_lsp_obj_func_t*)x)->body)
#define SSE_LSP_MFORMAL(x) (((sse_lsp_obj_macro_t*)x)->formal)
#define SSE_LSP_MBODY(x) (((sse_lsp_obj_macro_t*)x)->body)
#define SSE_LSP_PRIM(x) ((sse_lsp_prim_t)(((sse_lsp_obj_prim_t*)x)->impl))
#endif

350
ase/lsp/prim.c
View File

@ -1,80 +1,80 @@
/*
* $Id: prim.c,v 1.8 2005-09-24 08:16:02 bacon Exp $
* $Id: prim.c,v 1.9 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/lsp.h>
#include <xp/lsp/mem.h>
#include <xp/lsp/prim.h>
#include <sse/lsp/lsp.h>
#include <sse/lsp/mem.h>
#include <sse/lsp/prim.h>
#include <xp/bas/string.h>
#include <xp/bas/assert.h>
#include <sse/bas/string.h>
#include <sse/bas/assert.h>
static int __add_prim (xp_lsp_mem_t* mem,
const xp_char_t* name, xp_size_t len, xp_lsp_prim_t prim);
static int __add_prim (sse_lsp_mem_t* mem,
const sse_char_t* name, sse_size_t len, sse_lsp_prim_t prim);
int xp_lsp_add_prim (
xp_lsp_t* lsp, const xp_char_t* name, xp_lsp_prim_t prim)
int sse_lsp_add_prim (
sse_lsp_t* lsp, const sse_char_t* name, sse_lsp_prim_t prim)
{
return __add_prim (lsp->mem, name, xp_strlen(name), prim);
return __add_prim (lsp->mem, name, sse_strlen(name), prim);
}
int xp_lsp_remove_prim (xp_lsp_t* lsp, const xp_char_t* name)
int sse_lsp_remove_prim (sse_lsp_t* lsp, const sse_char_t* name)
{
// TODO:
return -1;
}
static int __add_prim (xp_lsp_mem_t* mem,
const xp_char_t* name, xp_size_t len, xp_lsp_prim_t prim)
static int __add_prim (sse_lsp_mem_t* mem,
const sse_char_t* name, sse_size_t len, sse_lsp_prim_t prim)
{
xp_lsp_obj_t* n, * p;
sse_lsp_obj_t* n, * p;
n = xp_lsp_make_symbolx (mem, name, len);
if (n == XP_NULL) return -1;
n = sse_lsp_make_symbolx (mem, name, len);
if (n == SSE_NULL) return -1;
xp_lsp_lock (n);
sse_lsp_lock (n);
p = xp_lsp_make_prim (mem, prim);
if (p == XP_NULL) return -1;
p = sse_lsp_make_prim (mem, prim);
if (p == SSE_NULL) return -1;
xp_lsp_unlock (n);
sse_lsp_unlock (n);
if (xp_lsp_set_func(mem, n, p) == XP_NULL) return -1;
if (sse_lsp_set_func(mem, n, p) == SSE_NULL) return -1;
return 0;
}
xp_lsp_obj_t* xp_lsp_prim_abort (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_abort (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
lsp->errnum = XP_LSP_ERR_ABORT;
return XP_NULL;
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
lsp->errnum = SSE_LSP_ERR_ABORT;
return SSE_NULL;
}
xp_lsp_obj_t* xp_lsp_prim_eval (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_eval (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* tmp;
sse_lsp_obj_t* tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
tmp = xp_lsp_eval (lsp, tmp);
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, tmp);
if (tmp == SSE_NULL) return SSE_NULL;
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_gc (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_gc (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
xp_lsp_garbage_collect (lsp->mem);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
sse_lsp_garbage_collect (lsp->mem);
return lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_cond (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_cond (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (cond
@ -84,181 +84,181 @@ xp_lsp_obj_t* xp_lsp_prim_cond (xp_lsp_t* lsp, xp_lsp_obj_t* args)
* (t resultN))
*/
xp_lsp_obj_t* tmp, * ret;
sse_lsp_obj_t* tmp, * ret;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, SSE_LSP_PRIM_MAX_ARG_COUNT);
while (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS) {
if (XP_LSP_TYPE(XP_LSP_CAR(args)) != XP_LSP_OBJ_CONS) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
while (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS) {
if (SSE_LSP_TYPE(SSE_LSP_CAR(args)) != SSE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CAR(args)));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CAR(args)));
if (tmp == SSE_NULL) return SSE_NULL;
if (tmp != lsp->mem->nil) {
tmp = XP_LSP_CDR(XP_LSP_CAR(args));
tmp = SSE_LSP_CDR(SSE_LSP_CAR(args));
ret = lsp->mem->nil;
while (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_CONS) {
ret = xp_lsp_eval (lsp, XP_LSP_CAR(tmp));
if (ret == XP_NULL) return XP_NULL;
tmp = XP_LSP_CDR(tmp);
while (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_CONS) {
ret = sse_lsp_eval (lsp, SSE_LSP_CAR(tmp));
if (ret == SSE_NULL) return SSE_NULL;
tmp = SSE_LSP_CDR(tmp);
}
if (tmp != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
return ret;
}
args = XP_LSP_CDR(args);
args = SSE_LSP_CDR(args);
}
return lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_if (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_if (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* tmp;
sse_lsp_obj_t* tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
if (tmp != lsp->mem->nil) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (tmp == SSE_NULL) return SSE_NULL;
return tmp;
}
else {
xp_lsp_obj_t* res = lsp->mem->nil;
sse_lsp_obj_t* res = lsp->mem->nil;
tmp = XP_LSP_CDR(XP_LSP_CDR(args));
tmp = SSE_LSP_CDR(SSE_LSP_CDR(args));
while (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_CONS) {
res = xp_lsp_eval (lsp, XP_LSP_CAR(tmp));
if (res == XP_NULL) return XP_NULL;
tmp = XP_LSP_CDR(tmp);
while (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_CONS) {
res = sse_lsp_eval (lsp, SSE_LSP_CAR(tmp));
if (res == SSE_NULL) return SSE_NULL;
tmp = SSE_LSP_CDR(tmp);
}
if (tmp != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
return res;
}
}
xp_lsp_obj_t* xp_lsp_prim_while (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_while (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (setq a 1)
* (while (< a 100) (setq a (+ a 1)))
*/
xp_lsp_obj_t* tmp;
sse_lsp_obj_t* tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
for (;;) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
if (tmp == lsp->mem->nil) break;
tmp = XP_LSP_CDR(args);
while (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_CONS) {
if (xp_lsp_eval(lsp, XP_LSP_CAR(tmp)) == XP_NULL)
return XP_NULL;
tmp = XP_LSP_CDR(tmp);
tmp = SSE_LSP_CDR(args);
while (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_CONS) {
if (sse_lsp_eval(lsp, SSE_LSP_CAR(tmp)) == SSE_NULL)
return SSE_NULL;
tmp = SSE_LSP_CDR(tmp);
}
if (tmp != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
}
return lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_car (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_car (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (car '(10 20 30))
*/
xp_lsp_obj_t* tmp;
sse_lsp_obj_t* tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
if (tmp == lsp->mem->nil) return lsp->mem->nil;
if (XP_LSP_TYPE(tmp) != XP_LSP_OBJ_CONS) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
if (SSE_LSP_TYPE(tmp) != SSE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
return XP_LSP_CAR(tmp);
return SSE_LSP_CAR(tmp);
}
xp_lsp_obj_t* xp_lsp_prim_cdr (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_cdr (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (cdr '(10 20 30))
*/
xp_lsp_obj_t* tmp;
sse_lsp_obj_t* tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
if (tmp == lsp->mem->nil) return lsp->mem->nil;
if (XP_LSP_TYPE(tmp) != XP_LSP_OBJ_CONS) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
if (SSE_LSP_TYPE(tmp) != SSE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
return XP_LSP_CDR(tmp);
return SSE_LSP_CDR(tmp);
}
xp_lsp_obj_t* xp_lsp_prim_cons (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_cons (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (cons 10 20)
* (cons '(10 20) 30)
*/
xp_lsp_obj_t* car, * cdr, * cons;
sse_lsp_obj_t* car, * cdr, * cons;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
car = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (car == XP_NULL) return XP_NULL;
car = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (car == SSE_NULL) return SSE_NULL;
cdr = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (cdr == XP_NULL) return XP_NULL;
cdr = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (cdr == SSE_NULL) return SSE_NULL;
cons = xp_lsp_make_cons (lsp->mem, car, cdr);
if (cons == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
cons = sse_lsp_make_cons (lsp->mem, car, cdr);
if (cons == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return cons;
}
xp_lsp_obj_t* xp_lsp_prim_set (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_set (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (set 'flowers 'rose)
@ -266,79 +266,79 @@ xp_lsp_obj_t* xp_lsp_prim_set (xp_lsp_t* lsp, xp_lsp_obj_t* args)
* (rose)
*/
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) != XP_LSP_OBJ_SYMBOL) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
if (SSE_LSP_TYPE(p1) != SSE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (xp_lsp_set_value (lsp->mem, p1, p2) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
if (sse_lsp_set_value (lsp->mem, p1, p2) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return p2;
}
xp_lsp_obj_t* xp_lsp_prim_setq (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_setq (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (setq x 10)
* (setq x "stirng")
*/
xp_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
sse_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
while (p != lsp->mem->nil) {
xp_assert (XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS);
sse_assert (SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS);
p1 = XP_LSP_CAR(p);
if (XP_LSP_TYPE(p1) != XP_LSP_OBJ_SYMBOL) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
p1 = SSE_LSP_CAR(p);
if (SSE_LSP_TYPE(p1) != SSE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
if (XP_LSP_TYPE(XP_LSP_CDR(p)) != XP_LSP_OBJ_CONS) {
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS;
return XP_NULL;
if (SSE_LSP_TYPE(SSE_LSP_CDR(p)) != SSE_LSP_OBJ_CONS) {
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS;
return SSE_NULL;
}
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(p)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(p)));
if (p2 == SSE_NULL) return SSE_NULL;
if (xp_lsp_set_value (lsp->mem, p1, p2) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
if (sse_lsp_set_value (lsp->mem, p1, p2) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
p = XP_LSP_CDR(XP_LSP_CDR(p));
p = SSE_LSP_CDR(SSE_LSP_CDR(p));
}
return p2;
}
xp_lsp_obj_t* xp_lsp_prim_quote (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_quote (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (quote (10 20 30 50))
*/
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
return XP_LSP_CAR(args);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
return SSE_LSP_CAR(args);
}
xp_lsp_obj_t* xp_lsp_prim_defun (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_defun (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (defun x (a b) (+ a b 100))
@ -349,51 +349,51 @@ xp_lsp_obj_t* xp_lsp_prim_defun (xp_lsp_t* lsp, xp_lsp_obj_t* args)
* temp
*/
xp_lsp_obj_t* name, * fun;
sse_lsp_obj_t* name, * fun;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, SSE_LSP_PRIM_MAX_ARG_COUNT);
name = XP_LSP_CAR(args);
if (XP_LSP_TYPE(name) != XP_LSP_OBJ_SYMBOL) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
name = SSE_LSP_CAR(args);
if (SSE_LSP_TYPE(name) != SSE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
fun = xp_lsp_make_func (lsp->mem,
XP_LSP_CAR(XP_LSP_CDR(args)), XP_LSP_CDR(XP_LSP_CDR(args)));
if (fun == XP_NULL) return XP_NULL;
fun = sse_lsp_make_func (lsp->mem,
SSE_LSP_CAR(SSE_LSP_CDR(args)), SSE_LSP_CDR(SSE_LSP_CDR(args)));
if (fun == SSE_NULL) return SSE_NULL;
if (xp_lsp_set_func (lsp->mem, XP_LSP_CAR(args), fun) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
if (sse_lsp_set_func (lsp->mem, SSE_LSP_CAR(args), fun) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return fun;
}
xp_lsp_obj_t* xp_lsp_prim_demac (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_demac (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (demac x (abc) x y z)
*(setq x (macro (abc) x y z))
*/
xp_lsp_obj_t* name, * mac;
sse_lsp_obj_t* name, * mac;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 3, SSE_LSP_PRIM_MAX_ARG_COUNT);
name = XP_LSP_CAR(args);
if (XP_LSP_TYPE(name) != XP_LSP_OBJ_SYMBOL) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
name = SSE_LSP_CAR(args);
if (SSE_LSP_TYPE(name) != SSE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
return SSE_NULL;
}
mac = xp_lsp_make_macro (lsp->mem,
XP_LSP_CAR(XP_LSP_CDR(args)), XP_LSP_CDR(XP_LSP_CDR(args)));
if (mac == XP_NULL) return XP_NULL;
mac = sse_lsp_make_macro (lsp->mem,
SSE_LSP_CAR(SSE_LSP_CDR(args)), SSE_LSP_CDR(SSE_LSP_CDR(args)));
if (mac == SSE_NULL) return SSE_NULL;
if (xp_lsp_set_func (lsp->mem, XP_LSP_CAR(args), mac) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
if (sse_lsp_set_func (lsp->mem, SSE_LSP_CAR(args), mac) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return mac;
}

88
ase/lsp/prim.h
View File

@ -1,77 +1,77 @@
/*
* $Id: prim.h,v 1.5 2005-09-21 11:52:36 bacon Exp $
* $Id: prim.h,v 1.6 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_PRIM_H_
#define _XP_LSP_PRIM_H_
#ifndef _SSE_LSP_PRIM_H_
#define _SSE_LSP_PRIM_H_
#include <xp/lsp/types.h>
#include <xp/lsp/lsp.h>
#include <sse/lsp/types.h>
#include <sse/lsp/lsp.h>
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_obj_t* xp_lsp_prim_abort (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_eval (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_prog1 (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_progn (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_gc (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cond (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_if (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_while (xp_lsp_t* lsp, xp_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_abort (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_eval (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_prog1 (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_progn (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_gc (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_cond (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_if (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_while (sse_lsp_t* lsp, sse_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_car (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cdr (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_cons (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_set (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_setq (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_quote (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_defun (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_demac (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_letx (xp_lsp_t* lsp, xp_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_car (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_cdr (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_cons (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_set (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_setq (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_quote (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_defun (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_demac (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_let (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_letx (sse_lsp_t* lsp, sse_lsp_obj_t* args);
/*---------------------
prim_compar.c
---------------------*/
xp_lsp_obj_t* xp_lsp_prim_eq (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_ne (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_gt (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_lt (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_ge (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_le (xp_lsp_t* lsp, xp_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_eq (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_ne (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_gt (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_lt (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_ge (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_le (sse_lsp_t* lsp, sse_lsp_obj_t* args);
/*---------------------
prim_math.c
---------------------*/
xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_minus (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_multiply (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_divide (xp_lsp_t* lsp, xp_lsp_obj_t* args);
xp_lsp_obj_t* xp_lsp_prim_modulus (xp_lsp_t* lsp, xp_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_plus (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_minus (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_multiply (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_divide (sse_lsp_t* lsp, sse_lsp_obj_t* args);
sse_lsp_obj_t* sse_lsp_prim_modulus (sse_lsp_t* lsp, sse_lsp_obj_t* args);
#ifdef __cplusplus
}
#endif
#define XP_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \
#define SSE_LSP_PRIM_CHECK_ARG_COUNT(lsp,args,min,max) \
{ \
xp_size_t count; \
if (xp_lsp_probe_args(lsp->mem, args, &count) == -1) { \
lsp->errnum = XP_LSP_ERR_BAD_ARG; \
return XP_NULL; \
sse_size_t count; \
if (sse_lsp_probe_args(lsp->mem, args, &count) == -1) { \
lsp->errnum = SSE_LSP_ERR_BAD_ARG; \
return SSE_NULL; \
} \
if (count < min) { \
lsp->errnum = XP_LSP_ERR_TOO_FEW_ARGS; \
return XP_NULL; \
lsp->errnum = SSE_LSP_ERR_TOO_FEW_ARGS; \
return SSE_NULL; \
} \
if (count > max) { \
lsp->errnum = XP_LSP_ERR_TOO_MANY_ARGS; \
return XP_NULL; \
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS; \
return SSE_NULL; \
} \
}
#define XP_LSP_PRIM_MAX_ARG_COUNT ((xp_size_t)~(xp_size_t)0)
#define SSE_LSP_PRIM_MAX_ARG_COUNT ((sse_size_t)~(sse_size_t)0)
#endif

438
ase/lsp/prim_compar.c
View File

@ -1,407 +1,407 @@
/*
* $Id: prim_compar.c,v 1.2 2005-09-21 11:52:36 bacon Exp $
* $Id: prim_compar.c,v 1.3 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/prim.h>
#include <xp/bas/assert.h>
#include <sse/lsp/prim.h>
#include <sse/bas/assert.h>
xp_lsp_obj_t* xp_lsp_prim_eq (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_eq (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
int res;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
// TODO: lock p1....
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_INT) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_IVALUE(p1) == XP_LSP_IVALUE(p2);
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) == SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_IVALUE(p1) == XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) == SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_REAL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_RVALUE(p1) == XP_LSP_IVALUE(p2);
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) == SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_RVALUE(p1) == XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) == SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_SYMBOL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_SYMBOL) {
res = xp_lsp_comp_symbol2 (
p1, XP_LSP_SYMVALUE(p2), XP_LSP_SYMLEN(p2)) == 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) == 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_STRING) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_STRING) {
res = xp_lsp_comp_string2 (
p1, XP_LSP_STRVALUE(p2), XP_LSP_STRLEN(p2)) == 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) == 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_ne (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_ne (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
int res;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
// TODO: lock p1....
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_INT) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_IVALUE(p1) != XP_LSP_IVALUE(p2);
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) != SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_IVALUE(p1) != XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) != SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_REAL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_RVALUE(p1) != XP_LSP_IVALUE(p2);
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) != SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_RVALUE(p1) != XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) != SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_SYMBOL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_SYMBOL) {
res = xp_lsp_comp_symbol2 (
p1, XP_LSP_SYMVALUE(p2), XP_LSP_SYMLEN(p2)) != 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) != 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_STRING) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_STRING) {
res = xp_lsp_comp_string2 (
p1, XP_LSP_STRVALUE(p2), XP_LSP_STRLEN(p2)) != 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) != 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_gt (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_gt (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
int res;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
// TODO: lock p1....
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_INT) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_IVALUE(p1) > XP_LSP_IVALUE(p2);
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) > SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_IVALUE(p1) > XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) > SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_REAL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_RVALUE(p1) > XP_LSP_IVALUE(p2);
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) > SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_RVALUE(p1) > XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) > SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_SYMBOL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_SYMBOL) {
res = xp_lsp_comp_symbol2 (
p1, XP_LSP_SYMVALUE(p2), XP_LSP_SYMLEN(p2)) > 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) > 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_STRING) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_STRING) {
res = xp_lsp_comp_string2 (
p1, XP_LSP_STRVALUE(p2), XP_LSP_STRLEN(p2)) > 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) > 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_lt (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_lt (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
int res;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
// TODO: lock p1....
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_INT) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_IVALUE(p1) < XP_LSP_IVALUE(p2);
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) < SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_IVALUE(p1) < XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) < SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_REAL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_RVALUE(p1) < XP_LSP_IVALUE(p2);
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) < SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_RVALUE(p1) < XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) < SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_SYMBOL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_SYMBOL) {
res = xp_lsp_comp_symbol2 (
p1, XP_LSP_SYMVALUE(p2), XP_LSP_SYMLEN(p2)) < 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) < 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_STRING) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_STRING) {
res = xp_lsp_comp_string2 (
p1, XP_LSP_STRVALUE(p2), XP_LSP_STRLEN(p2)) < 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) < 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_ge (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_ge (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
int res;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
// TODO: lock p1....
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_INT) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_IVALUE(p1) >= XP_LSP_IVALUE(p2);
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) >= SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_IVALUE(p1) >= XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) >= SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_REAL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_RVALUE(p1) >= XP_LSP_IVALUE(p2);
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) >= SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_RVALUE(p1) >= XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) >= SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_SYMBOL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_SYMBOL) {
res = xp_lsp_comp_symbol2 (
p1, XP_LSP_SYMVALUE(p2), XP_LSP_SYMLEN(p2)) >= 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) >= 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_STRING) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_STRING) {
res = xp_lsp_comp_string2 (
p1, XP_LSP_STRVALUE(p2), XP_LSP_STRLEN(p2)) >= 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) >= 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
return (res)? lsp->mem->t: lsp->mem->nil;
}
xp_lsp_obj_t* xp_lsp_prim_le (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_le (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* p1, * p2;
sse_lsp_obj_t* p1, * p2;
int res;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
p1 = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (p1 == XP_NULL) return XP_NULL;
p1 = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (p1 == SSE_NULL) return SSE_NULL;
// TODO: lock p1....
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL;
p2 = sse_lsp_eval (lsp, SSE_LSP_CAR(SSE_LSP_CDR(args)));
if (p2 == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_INT) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_IVALUE(p1) <= XP_LSP_IVALUE(p2);
if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_IVALUE(p1) <= SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_IVALUE(p1) <= XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_IVALUE(p1) <= SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_REAL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_INT) {
res = XP_LSP_RVALUE(p1) <= XP_LSP_IVALUE(p2);
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_REAL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_INT) {
res = SSE_LSP_RVALUE(p1) <= SSE_LSP_IVALUE(p2);
}
else if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_REAL) {
res = XP_LSP_RVALUE(p1) <= XP_LSP_RVALUE(p2);
else if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_REAL) {
res = SSE_LSP_RVALUE(p1) <= SSE_LSP_RVALUE(p2);
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_SYMBOL) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_SYMBOL) {
res = xp_lsp_comp_symbol2 (
p1, XP_LSP_SYMVALUE(p2), XP_LSP_SYMLEN(p2)) <= 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_SYMBOL) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_SYMBOL) {
res = sse_lsp_comp_symbol2 (
p1, SSE_LSP_SYMVALUE(p2), SSE_LSP_SYMLEN(p2)) <= 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(p1) == XP_LSP_OBJ_STRING) {
if (XP_LSP_TYPE(p2) == XP_LSP_OBJ_STRING) {
res = xp_lsp_comp_string2 (
p1, XP_LSP_STRVALUE(p2), XP_LSP_STRLEN(p2)) <= 0;
else if (SSE_LSP_TYPE(p1) == SSE_LSP_OBJ_STRING) {
if (SSE_LSP_TYPE(p2) == SSE_LSP_OBJ_STRING) {
res = sse_lsp_comp_string2 (
p1, SSE_LSP_STRVALUE(p2), SSE_LSP_STRLEN(p2)) <= 0;
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
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.3 2005-09-24 08:16:02 bacon Exp $
* $Id: prim_let.c,v 1.4 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/prim.h>
#include <sse/lsp/prim.h>
static xp_lsp_obj_t* __prim_let (
xp_lsp_t* lsp, xp_lsp_obj_t* args, int sequential)
static sse_lsp_obj_t* __prim_let (
sse_lsp_t* lsp, sse_lsp_obj_t* args, int sequential)
{
xp_lsp_frame_t* frame;
xp_lsp_obj_t* assoc;
xp_lsp_obj_t* body;
xp_lsp_obj_t* value;
sse_lsp_frame_t* frame;
sse_lsp_obj_t* assoc;
sse_lsp_obj_t* body;
sse_lsp_obj_t* value;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
// create a new frame
frame = xp_lsp_frame_new ();
if (frame == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
frame = sse_lsp_frame_new ();
if (frame == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
//frame->link = lsp->mem->frame;
@ -31,87 +31,87 @@ static xp_lsp_obj_t* __prim_let (
lsp->mem->brooding_frame = frame;
}
assoc = XP_LSP_CAR(args);
assoc = SSE_LSP_CAR(args);
//while (assoc != lsp->mem->nil) {
while (XP_LSP_TYPE(assoc) == XP_LSP_OBJ_CONS) {
xp_lsp_obj_t* ass = XP_LSP_CAR(assoc);
if (XP_LSP_TYPE(ass) == XP_LSP_OBJ_CONS) {
xp_lsp_obj_t* n = XP_LSP_CAR(ass);
xp_lsp_obj_t* v = XP_LSP_CDR(ass);
while (SSE_LSP_TYPE(assoc) == SSE_LSP_OBJ_CONS) {
sse_lsp_obj_t* ass = SSE_LSP_CAR(assoc);
if (SSE_LSP_TYPE(ass) == SSE_LSP_OBJ_CONS) {
sse_lsp_obj_t* n = SSE_LSP_CAR(ass);
sse_lsp_obj_t* v = SSE_LSP_CDR(ass);
if (XP_LSP_TYPE(n) != XP_LSP_OBJ_SYMBOL) {
lsp->errnum = XP_LSP_ERR_BAD_ARG; // must be a symbol
if (SSE_LSP_TYPE(n) != SSE_LSP_OBJ_SYMBOL) {
lsp->errnum = SSE_LSP_ERR_BAD_ARG; // must be a symbol
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (v != lsp->mem->nil) {
if (XP_LSP_CDR(v) != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_TOO_MANY_ARGS; // must be a symbol
if (SSE_LSP_CDR(v) != lsp->mem->nil) {
lsp->errnum = SSE_LSP_ERR_TOO_MANY_ARGS; // must be a symbol
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if ((v = xp_lsp_eval(lsp, XP_LSP_CAR(v))) == XP_NULL) {
if ((v = sse_lsp_eval(lsp, SSE_LSP_CAR(v))) == SSE_NULL) {
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
if (xp_lsp_frame_lookup (frame, n) != XP_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
if (sse_lsp_frame_lookup (frame, n) != SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (xp_lsp_frame_insert_value(frame, n, v) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
if (sse_lsp_frame_insert_value(frame, n, v) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
else if (XP_LSP_TYPE(ass) == XP_LSP_OBJ_SYMBOL) {
if (xp_lsp_frame_lookup(frame, ass) != XP_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
else if (SSE_LSP_TYPE(ass) == SSE_LSP_OBJ_SYMBOL) {
if (sse_lsp_frame_lookup(frame, ass) != SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
if (xp_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
if (sse_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
assoc = XP_LSP_CDR(assoc);
assoc = SSE_LSP_CDR(assoc);
}
if (assoc != lsp->mem->nil) {
lsp->errnum = XP_LSP_ERR_BAD_ARG;
lsp->errnum = SSE_LSP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
// push the frame
@ -123,26 +123,26 @@ static xp_lsp_obj_t* __prim_let (
// evaluate forms in the body
value = lsp->mem->nil;
body = XP_LSP_CDR(args);
body = SSE_LSP_CDR(args);
while (body != lsp->mem->nil) {
value = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (value == XP_NULL) {
value = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (value == SSE_NULL) {
lsp->mem->frame = frame->link;
xp_lsp_frame_free (frame);
return XP_NULL;
sse_lsp_frame_free (frame);
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
// pop the frame
lsp->mem->frame = frame->link;
// destroy the frame
xp_lsp_frame_free (frame);
sse_lsp_frame_free (frame);
return value;
}
xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_let (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
/*
* (defun x (x y)
@ -154,7 +154,7 @@ xp_lsp_obj_t* xp_lsp_prim_let (xp_lsp_t* lsp, xp_lsp_obj_t* args)
return __prim_let (lsp, args, 0);
}
xp_lsp_obj_t* xp_lsp_prim_letx (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_letx (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
return __prim_let (lsp, args, 1);
}

318
ase/lsp/prim_math.c
View File

@ -1,331 +1,331 @@
/*
* $Id: prim_math.c,v 1.6 2005-09-24 08:16:02 bacon Exp $
* $Id: prim_math.c,v 1.7 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/prim.h>
#include <xp/bas/assert.h>
#include <sse/lsp/prim.h>
#include <sse/bas/assert.h>
xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_plus (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t ivalue = 0;
xp_lsp_real_t rvalue = .0;
xp_bool_t realnum = xp_false;
sse_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) {
/*lsp->errnum = XP_LSP_ERR_BAD_VALUE; */
return XP_NULL;
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (tmp == SSE_NULL) {
/*lsp->errnum = SSE_LSP_ERR_BAD_VALUE; */
return SSE_NULL;
}
if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) {
if (body == args) {
xp_assert (realnum == xp_false);
ivalue = XP_LSP_IVALUE(tmp);
sse_assert (realnum == sse_false);
ivalue = SSE_LSP_IVALUE(tmp);
}
else {
if (!realnum)
ivalue = ivalue + XP_LSP_IVALUE(tmp);
ivalue = ivalue + SSE_LSP_IVALUE(tmp);
else
rvalue = rvalue + XP_LSP_IVALUE(tmp);
rvalue = rvalue + SSE_LSP_IVALUE(tmp);
}
}
else if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_REAL) {
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) {
if (body == args) {
xp_assert (realnum == xp_false);
realnum = xp_true;
rvalue = XP_LSP_RVALUE(tmp);
sse_assert (realnum == sse_false);
realnum = sse_true;
rvalue = SSE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
realnum = xp_true;
rvalue = (xp_lsp_real_t)ivalue;
realnum = sse_true;
rvalue = (sse_lsp_real_t)ivalue;
}
rvalue = rvalue + XP_LSP_RVALUE(tmp);
rvalue = rvalue + SSE_LSP_RVALUE(tmp);
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
xp_assert (body == lsp->mem->nil);
sse_assert (body == lsp->mem->nil);
tmp = (realnum)?
xp_lsp_make_real (lsp->mem, rvalue):
xp_lsp_make_int (lsp->mem, ivalue);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
sse_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_minus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_minus (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t ivalue = 0;
xp_lsp_real_t rvalue = .0;
xp_bool_t realnum = xp_false;
sse_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) {
if (body == args) {
xp_assert (realnum == xp_false);
ivalue = XP_LSP_IVALUE(tmp);
sse_assert (realnum == sse_false);
ivalue = SSE_LSP_IVALUE(tmp);
}
else {
if (!realnum)
ivalue = ivalue - XP_LSP_IVALUE(tmp);
ivalue = ivalue - SSE_LSP_IVALUE(tmp);
else
rvalue = rvalue - XP_LSP_IVALUE(tmp);
rvalue = rvalue - SSE_LSP_IVALUE(tmp);
}
}
else if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_REAL) {
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) {
if (body == args) {
xp_assert (realnum == xp_false);
realnum = xp_true;
rvalue = XP_LSP_RVALUE(tmp);
sse_assert (realnum == sse_false);
realnum = sse_true;
rvalue = SSE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
realnum = xp_true;
rvalue = (xp_lsp_real_t)ivalue;
realnum = sse_true;
rvalue = (sse_lsp_real_t)ivalue;
}
rvalue = rvalue - XP_LSP_RVALUE(tmp);
rvalue = rvalue - SSE_LSP_RVALUE(tmp);
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
xp_assert (body == lsp->mem->nil);
sse_assert (body == lsp->mem->nil);
tmp = (realnum)?
xp_lsp_make_real (lsp->mem, rvalue):
xp_lsp_make_int (lsp->mem, ivalue);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
sse_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_multiply (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_multiply (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t ivalue = 0;
xp_lsp_real_t rvalue = .0;
xp_bool_t realnum = xp_false;
sse_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) {
if (body == args) {
xp_assert (realnum == xp_false);
ivalue = XP_LSP_IVALUE(tmp);
sse_assert (realnum == sse_false);
ivalue = SSE_LSP_IVALUE(tmp);
}
else {
if (!realnum)
ivalue = ivalue * XP_LSP_IVALUE(tmp);
ivalue = ivalue * SSE_LSP_IVALUE(tmp);
else
rvalue = rvalue * XP_LSP_IVALUE(tmp);
rvalue = rvalue * SSE_LSP_IVALUE(tmp);
}
}
else if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_REAL) {
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) {
if (body == args) {
xp_assert (realnum == xp_false);
realnum = xp_true;
rvalue = XP_LSP_RVALUE(tmp);
sse_assert (realnum == sse_false);
realnum = sse_true;
rvalue = SSE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
realnum = xp_true;
rvalue = (xp_lsp_real_t)ivalue;
realnum = sse_true;
rvalue = (sse_lsp_real_t)ivalue;
}
rvalue = rvalue * XP_LSP_RVALUE(tmp);
rvalue = rvalue * SSE_LSP_RVALUE(tmp);
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
xp_assert (body == lsp->mem->nil);
sse_assert (body == lsp->mem->nil);
tmp = (realnum)?
xp_lsp_make_real (lsp->mem, rvalue):
xp_lsp_make_int (lsp->mem, ivalue);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
sse_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_divide (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_divide (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t ivalue = 0;
xp_lsp_real_t rvalue = .0;
xp_bool_t realnum = xp_false;
sse_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = .0;
sse_bool_t realnum = sse_false;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) {
if (body == args) {
xp_assert (realnum == xp_false);
ivalue = XP_LSP_IVALUE(tmp);
sse_assert (realnum == sse_false);
ivalue = SSE_LSP_IVALUE(tmp);
}
else {
if (!realnum) {
if (XP_LSP_IVALUE(tmp) == 0) {
lsp->errnum = XP_LSP_ERR_DIVIDE_BY_ZERO;
return XP_NULL;
if (SSE_LSP_IVALUE(tmp) == 0) {
lsp->errnum = SSE_LSP_ERR_DIVIDE_BY_ZERO;
return SSE_NULL;
}
ivalue = ivalue / XP_LSP_IVALUE(tmp);
ivalue = ivalue / SSE_LSP_IVALUE(tmp);
}
else
rvalue = rvalue / XP_LSP_IVALUE(tmp);
rvalue = rvalue / SSE_LSP_IVALUE(tmp);
}
}
else if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_REAL) {
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) {
if (body == args) {
xp_assert (realnum == xp_false);
realnum = xp_true;
rvalue = XP_LSP_RVALUE(tmp);
sse_assert (realnum == sse_false);
realnum = sse_true;
rvalue = SSE_LSP_RVALUE(tmp);
}
else {
if (!realnum) {
realnum = xp_true;
rvalue = (xp_lsp_real_t)ivalue;
realnum = sse_true;
rvalue = (sse_lsp_real_t)ivalue;
}
rvalue = rvalue / XP_LSP_RVALUE(tmp);
rvalue = rvalue / SSE_LSP_RVALUE(tmp);
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
xp_assert (body == lsp->mem->nil);
sse_assert (body == lsp->mem->nil);
tmp = (realnum)?
xp_lsp_make_real (lsp->mem, rvalue):
xp_lsp_make_int (lsp->mem, ivalue);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
sse_lsp_make_real (lsp->mem, rvalue):
sse_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return tmp;
}
xp_lsp_obj_t* xp_lsp_prim_modulus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_modulus (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* body, * tmp;
xp_lsp_int_t ivalue = 0;
sse_lsp_obj_t* body, * tmp;
sse_lsp_int_t ivalue = 0;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
xp_assert (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
sse_assert (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS);
body = args;
//while (body != lsp->mem->nil) {
while (XP_LSP_TYPE(body) == XP_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(body));
if (tmp == XP_NULL) return XP_NULL;
while (SSE_LSP_TYPE(body) == SSE_LSP_OBJ_CONS) {
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(body));
if (tmp == SSE_NULL) return SSE_NULL;
if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_INT) {
if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_INT) {
if (body == args) {
ivalue = XP_LSP_IVALUE(tmp);
ivalue = SSE_LSP_IVALUE(tmp);
}
else {
if (XP_LSP_IVALUE(tmp) == 0) {
lsp->errnum = XP_LSP_ERR_DIVIDE_BY_ZERO;
return XP_NULL;
if (SSE_LSP_IVALUE(tmp) == 0) {
lsp->errnum = SSE_LSP_ERR_DIVIDE_BY_ZERO;
return SSE_NULL;
}
ivalue = ivalue % XP_LSP_IVALUE(tmp);
ivalue = ivalue % SSE_LSP_IVALUE(tmp);
}
}
else if (XP_LSP_TYPE(tmp) == XP_LSP_OBJ_REAL) {
else if (SSE_LSP_TYPE(tmp) == SSE_LSP_OBJ_REAL) {
if (body == args) {
ivalue = (xp_lsp_int_t)XP_LSP_RVALUE(tmp);
ivalue = (sse_lsp_int_t)SSE_LSP_RVALUE(tmp);
}
else {
xp_lsp_int_t tmpi = (xp_lsp_int_t)XP_LSP_RVALUE(tmp);
sse_lsp_int_t tmpi = (sse_lsp_int_t)SSE_LSP_RVALUE(tmp);
if (tmpi == 0) {
lsp->errnum = XP_LSP_ERR_DIVIDE_BY_ZERO;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_DIVIDE_BY_ZERO;
return SSE_NULL;
}
ivalue = ivalue % tmpi;
}
}
else {
lsp->errnum = XP_LSP_ERR_BAD_VALUE;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_BAD_VALUE;
return SSE_NULL;
}
body = XP_LSP_CDR(body);
body = SSE_LSP_CDR(body);
}
xp_assert (body == lsp->mem->nil);
sse_assert (body == lsp->mem->nil);
tmp = xp_lsp_make_int (lsp->mem, ivalue);
if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
tmp = sse_lsp_make_int (lsp->mem, ivalue);
if (tmp == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
return tmp;

38
ase/lsp/prim_prog.c
View File

@ -1,49 +1,49 @@
/*
* $Id: prim_prog.c,v 1.1 2005-09-19 12:04:00 bacon Exp $
* $Id: prim_prog.c,v 1.2 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/prim.h>
#include <sse/lsp/prim.h>
xp_lsp_obj_t* xp_lsp_prim_prog1 (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_prog1 (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* res = XP_NULL, * tmp;
sse_lsp_obj_t* res = SSE_NULL, * tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
//while (args != lsp->mem->nil) {
while (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS) {
while (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
if (res == XP_NULL) {
if (res == SSE_NULL) {
/*
xp_lsp_array_t* ta = lsp->mem->temp_array;
xp_lsp_array_insert (ta, ta->size, tmp);
sse_lsp_array_t* ta = lsp->mem->temp_array;
sse_lsp_array_insert (ta, ta->size, tmp);
*/
res = tmp;
}
args = XP_LSP_CDR(args);
args = SSE_LSP_CDR(args);
}
return res;
}
xp_lsp_obj_t* xp_lsp_prim_progn (xp_lsp_t* lsp, xp_lsp_obj_t* args)
sse_lsp_obj_t* sse_lsp_prim_progn (sse_lsp_t* lsp, sse_lsp_obj_t* args)
{
xp_lsp_obj_t* res, * tmp;
sse_lsp_obj_t* res, * tmp;
XP_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LSP_PRIM_MAX_ARG_COUNT);
SSE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, SSE_LSP_PRIM_MAX_ARG_COUNT);
res = lsp->mem->nil;
//while (args != lsp->mem->nil) {
while (XP_LSP_TYPE(args) == XP_LSP_OBJ_CONS) {
while (SSE_LSP_TYPE(args) == SSE_LSP_OBJ_CONS) {
tmp = xp_lsp_eval (lsp, XP_LSP_CAR(args));
if (tmp == XP_NULL) return XP_NULL;
tmp = sse_lsp_eval (lsp, SSE_LSP_CAR(args));
if (tmp == SSE_NULL) return SSE_NULL;
res = tmp;
args = XP_LSP_CDR(args);
args = SSE_LSP_CDR(args);
}
return res;

198
ase/lsp/print.c
View File

@ -1,174 +1,174 @@
/*
* $Id: print.c,v 1.12 2005-09-20 11:19:15 bacon Exp $
* $Id: print.c,v 1.13 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/lsp.h>
#include <xp/bas/stdio.h>
#include <xp/bas/string.h>
#include <sse/lsp/lsp.h>
#include <sse/bas/stdio.h>
#include <sse/bas/string.h>
void xp_lsp_print_debug (xp_lsp_obj_t* obj)
void sse_lsp_print_debug (sse_lsp_obj_t* obj)
{
switch (XP_LSP_TYPE(obj)) {
case XP_LSP_OBJ_NIL:
xp_printf (XP_TEXT("nil"));
switch (SSE_LSP_TYPE(obj)) {
case SSE_LSP_OBJ_NIL:
sse_printf (SSE_TEXT("nil"));
break;
case XP_LSP_OBJ_TRUE:
xp_printf (XP_TEXT("t"));
case SSE_LSP_OBJ_TRUE:
sse_printf (SSE_TEXT("t"));
break;
case XP_LSP_OBJ_INT:
xp_printf (XP_TEXT("%d"), XP_LSP_IVALUE(obj));
case SSE_LSP_OBJ_INT:
sse_printf (SSE_TEXT("%d"), SSE_LSP_IVALUE(obj));
break;
case XP_LSP_OBJ_REAL:
xp_printf (XP_TEXT("%f"), XP_LSP_RVALUE(obj));
case SSE_LSP_OBJ_REAL:
sse_printf (SSE_TEXT("%f"), SSE_LSP_RVALUE(obj));
break;
case XP_LSP_OBJ_SYMBOL:
xp_printf (XP_TEXT("%s"), XP_LSP_SYMVALUE(obj));
case SSE_LSP_OBJ_SYMBOL:
sse_printf (SSE_TEXT("%s"), SSE_LSP_SYMVALUE(obj));
break;
case XP_LSP_OBJ_STRING:
xp_printf (XP_TEXT("%s"), XP_LSP_STRVALUE(obj));
case SSE_LSP_OBJ_STRING:
sse_printf (SSE_TEXT("%s"), SSE_LSP_STRVALUE(obj));
break;
case XP_LSP_OBJ_CONS:
case SSE_LSP_OBJ_CONS:
{
xp_lsp_obj_t* p = obj;
xp_printf (XP_TEXT("("));
sse_lsp_obj_t* p = obj;
sse_printf (SSE_TEXT("("));
do {
xp_lsp_print_debug (XP_LSP_CAR(p));
p = XP_LSP_CDR(p);
if (XP_LSP_TYPE(p) != XP_LSP_OBJ_NIL) {
xp_printf (XP_TEXT(" "));
if (XP_LSP_TYPE(p) != XP_LSP_OBJ_CONS) {
xp_printf (XP_TEXT(". "));
xp_lsp_print_debug (p);
sse_lsp_print_debug (SSE_LSP_CAR(p));
p = SSE_LSP_CDR(p);
if (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_NIL) {
sse_printf (SSE_TEXT(" "));
if (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_CONS) {
sse_printf (SSE_TEXT(". "));
sse_lsp_print_debug (p);
}
}
} while (XP_LSP_TYPE(p) != XP_LSP_OBJ_NIL && XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS);
xp_printf (XP_TEXT(")"));
} while (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_NIL && SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS);
sse_printf (SSE_TEXT(")"));
}
break;
case XP_LSP_OBJ_FUNC:
xp_printf (XP_TEXT("func"));
case SSE_LSP_OBJ_FUNC:
sse_printf (SSE_TEXT("func"));
break;
case XP_LSP_OBJ_MACRO:
xp_printf (XP_TEXT("macro"));
case SSE_LSP_OBJ_MACRO:
sse_printf (SSE_TEXT("macro"));
break;
case XP_LSP_OBJ_PRIM:
xp_printf (XP_TEXT("prim"));
case SSE_LSP_OBJ_PRIM:
sse_printf (SSE_TEXT("prim"));
break;
default:
xp_printf (XP_TEXT("unknown object type: %d"), XP_LSP_TYPE(obj));
sse_printf (SSE_TEXT("unknown object type: %d"), SSE_LSP_TYPE(obj));
}
}
#define OUTPUT_STR(lsp,str) \
do { \
if (lsp->output_func(XP_LSP_IO_DATA, lsp->output_arg, (xp_char_t*)str, xp_strlen(str)) == -1) { \
lsp->errnum = XP_LSP_ERR_OUTPUT; \
if (lsp->output_func(SSE_LSP_IO_DATA, lsp->output_arg, (sse_char_t*)str, sse_strlen(str)) == -1) { \
lsp->errnum = SSE_LSP_ERR_OUTPUT; \
return -1; \
} \
} while (0)
#define OUTPUT_STRX(lsp,str,len) \
do { \
if (lsp->output_func(XP_LSP_IO_DATA, lsp->output_arg, (xp_char_t*)str, len) == -1) { \
lsp->errnum = XP_LSP_ERR_OUTPUT; \
if (lsp->output_func(SSE_LSP_IO_DATA, lsp->output_arg, (sse_char_t*)str, len) == -1) { \
lsp->errnum = SSE_LSP_ERR_OUTPUT; \
return -1; \
} \
} while (0)
static int __print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj, xp_bool_t prt_cons_par)
static int __print (sse_lsp_t* lsp, const sse_lsp_obj_t* obj, sse_bool_t prt_cons_par)
{
xp_char_t buf[256];
sse_char_t buf[256];
if (lsp->output_func == XP_NULL) {
lsp->errnum = XP_LSP_ERR_OUTPUT_NOT_ATTACHED;
if (lsp->output_func == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_OUTPUT_NOT_ATTACHED;
return -1;
}
switch (XP_LSP_TYPE(obj)) {
case XP_LSP_OBJ_NIL:
OUTPUT_STR (lsp, XP_TEXT("nil"));
switch (SSE_LSP_TYPE(obj)) {
case SSE_LSP_OBJ_NIL:
OUTPUT_STR (lsp, SSE_TEXT("nil"));
break;
case XP_LSP_OBJ_TRUE:
OUTPUT_STR (lsp, XP_TEXT("t"));
case SSE_LSP_OBJ_TRUE:
OUTPUT_STR (lsp, SSE_TEXT("t"));
break;
case XP_LSP_OBJ_INT:
if (xp_sizeof(xp_lsp_int_t) == xp_sizeof(int)) {
xp_sprintf (buf, xp_countof(buf), XP_TEXT("%d"), XP_LSP_IVALUE(obj));
case SSE_LSP_OBJ_INT:
if (sse_sizeof(sse_lsp_int_t) == sse_sizeof(int)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%d"), SSE_LSP_IVALUE(obj));
}
else if (xp_sizeof(xp_lsp_int_t) == xp_sizeof(long)) {
xp_sprintf (buf, xp_countof(buf), XP_TEXT("%ld"), XP_LSP_IVALUE(obj));
else if (sse_sizeof(sse_lsp_int_t) == sse_sizeof(long)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%ld"), SSE_LSP_IVALUE(obj));
}
else if (xp_sizeof(xp_lsp_int_t) == xp_sizeof(long long)) {
xp_sprintf (buf, xp_countof(buf), XP_TEXT("%lld"), XP_LSP_IVALUE(obj));
else if (sse_sizeof(sse_lsp_int_t) == sse_sizeof(long long)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%lld"), SSE_LSP_IVALUE(obj));
}
OUTPUT_STR (lsp, buf);
break;
case XP_LSP_OBJ_REAL:
if (xp_sizeof(xp_lsp_real_t) == xp_sizeof(double)) {
xp_sprintf (buf, xp_countof(buf), XP_TEXT("%f"),
(double)XP_LSP_RVALUE(obj));
case SSE_LSP_OBJ_REAL:
if (sse_sizeof(sse_lsp_real_t) == sse_sizeof(double)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%f"),
(double)SSE_LSP_RVALUE(obj));
}
else if (xp_sizeof(xp_lsp_real_t) == xp_sizeof(long double)) {
xp_sprintf (buf, xp_countof(buf), XP_TEXT("%Lf"),
(long double)XP_LSP_RVALUE(obj));
else if (sse_sizeof(sse_lsp_real_t) == sse_sizeof(long double)) {
sse_sprintf (buf, sse_countof(buf), SSE_TEXT("%Lf"),
(long double)SSE_LSP_RVALUE(obj));
}
OUTPUT_STR (lsp, buf);
break;
case XP_LSP_OBJ_SYMBOL:
OUTPUT_STR (lsp, XP_LSP_SYMVALUE(obj));
case SSE_LSP_OBJ_SYMBOL:
OUTPUT_STR (lsp, SSE_LSP_SYMVALUE(obj));
break;
case XP_LSP_OBJ_STRING:
OUTPUT_STR (lsp, XP_LSP_STRVALUE(obj));
case SSE_LSP_OBJ_STRING:
OUTPUT_STR (lsp, SSE_LSP_STRVALUE(obj));
break;
case XP_LSP_OBJ_CONS:
case SSE_LSP_OBJ_CONS:
{
const xp_lsp_obj_t* p = obj;
if (prt_cons_par) OUTPUT_STR (lsp, XP_TEXT("("));
const sse_lsp_obj_t* p = obj;
if (prt_cons_par) OUTPUT_STR (lsp, SSE_TEXT("("));
do {
xp_lsp_print (lsp, XP_LSP_CAR(p));
p = XP_LSP_CDR(p);
sse_lsp_print (lsp, SSE_LSP_CAR(p));
p = SSE_LSP_CDR(p);
if (p != lsp->mem->nil) {
OUTPUT_STR (lsp, XP_TEXT(" "));
if (XP_LSP_TYPE(p) != XP_LSP_OBJ_CONS) {
OUTPUT_STR (lsp, XP_TEXT(". "));
xp_lsp_print (lsp, p);
OUTPUT_STR (lsp, SSE_TEXT(" "));
if (SSE_LSP_TYPE(p) != SSE_LSP_OBJ_CONS) {
OUTPUT_STR (lsp, SSE_TEXT(". "));
sse_lsp_print (lsp, p);
}
}
} while (p != lsp->mem->nil && XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS);
if (prt_cons_par) OUTPUT_STR (lsp, XP_TEXT(")"));
} while (p != lsp->mem->nil && SSE_LSP_TYPE(p) == SSE_LSP_OBJ_CONS);
if (prt_cons_par) OUTPUT_STR (lsp, SSE_TEXT(")"));
}
break;
case XP_LSP_OBJ_FUNC:
/*OUTPUT_STR (lsp, XP_TEXT("func"));*/
OUTPUT_STR (lsp, XP_TEXT("(lambda "));
if (__print (lsp, XP_LSP_FFORMAL(obj), xp_true) == -1) return -1;
OUTPUT_STR (lsp, XP_TEXT(" "));
if (__print (lsp, XP_LSP_FBODY(obj), xp_false) == -1) return -1;
OUTPUT_STR (lsp, XP_TEXT(")"));
case SSE_LSP_OBJ_FUNC:
/*OUTPUT_STR (lsp, SSE_TEXT("func"));*/
OUTPUT_STR (lsp, SSE_TEXT("(lambda "));
if (__print (lsp, SSE_LSP_FFORMAL(obj), sse_true) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(" "));
if (__print (lsp, SSE_LSP_FBODY(obj), sse_false) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(")"));
break;
case XP_LSP_OBJ_MACRO:
/*OUTPUT_STR (lsp, XP_TEXT("macro"));*/
OUTPUT_STR (lsp, XP_TEXT("(macro "));
if (__print (lsp, XP_LSP_FFORMAL(obj), xp_true) == -1) return -1;
OUTPUT_STR (lsp, XP_TEXT(" "));
if (__print (lsp, XP_LSP_FBODY(obj), xp_false) == -1) return -1;
OUTPUT_STR (lsp, XP_TEXT(")"));
case SSE_LSP_OBJ_MACRO:
/*OUTPUT_STR (lsp, SSE_TEXT("macro"));*/
OUTPUT_STR (lsp, SSE_TEXT("(macro "));
if (__print (lsp, SSE_LSP_FFORMAL(obj), sse_true) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(" "));
if (__print (lsp, SSE_LSP_FBODY(obj), sse_false) == -1) return -1;
OUTPUT_STR (lsp, SSE_TEXT(")"));
break;
case XP_LSP_OBJ_PRIM:
OUTPUT_STR (lsp, XP_TEXT("prim"));
case SSE_LSP_OBJ_PRIM:
OUTPUT_STR (lsp, SSE_TEXT("prim"));
break;
default:
xp_sprintf (buf, xp_countof(buf),
XP_TEXT("unknown object type: %d"), XP_LSP_TYPE(obj));
sse_sprintf (buf, sse_countof(buf),
SSE_TEXT("unknown object type: %d"), SSE_LSP_TYPE(obj));
OUTPUT_STR (lsp, buf);
}
return 0;
}
int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj)
int sse_lsp_print (sse_lsp_t* lsp, const sse_lsp_obj_t* obj)
{
return __print (lsp, obj, xp_true);
return __print (lsp, obj, sse_true);
}

292
ase/lsp/read.c
View File

@ -1,26 +1,26 @@
/*
* $Id: read.c,v 1.17 2005-11-18 17:58:47 bacon Exp $
* $Id: read.c,v 1.18 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/lsp.h>
#include <xp/lsp/token.h>
#include <xp/bas/assert.h>
#include <xp/bas/ctype.h>
#include <sse/lsp/lsp.h>
#include <sse/lsp/token.h>
#include <sse/bas/assert.h>
#include <sse/bas/ctype.h>
#define IS_SPACE(x) xp_isspace(x)
#define IS_DIGIT(x) xp_isdigit(x)
#define IS_ALPHA(x) xp_isalpha(x)
#define IS_ALNUM(x) xp_isalnum(x)
#define IS_SPACE(x) sse_isspace(x)
#define IS_DIGIT(x) sse_isdigit(x)
#define IS_ALPHA(x) sse_isalpha(x)
#define IS_ALNUM(x) sse_isalnum(x)
#define IS_IDENT(c) \
((c) == XP_CHAR('+') || (c) == XP_CHAR('-') || \
(c) == XP_CHAR('*') || (c) == XP_CHAR('/') || \
(c) == XP_CHAR('%') || (c) == XP_CHAR('&') || \
(c) == XP_CHAR('<') || (c) == XP_CHAR('>') || \
(c) == XP_CHAR('=') || (c) == XP_CHAR('_') || \
(c) == XP_CHAR('?'))
((c) == SSE_CHAR('+') || (c) == SSE_CHAR('-') || \
(c) == SSE_CHAR('*') || (c) == SSE_CHAR('/') || \
(c) == SSE_CHAR('%') || (c) == SSE_CHAR('&') || \
(c) == SSE_CHAR('<') || (c) == SSE_CHAR('>') || \
(c) == SSE_CHAR('=') || (c) == SSE_CHAR('_') || \
(c) == SSE_CHAR('?'))
#define TOKEN_CLEAR(lsp) xp_lsp_token_clear (&(lsp)->token)
#define TOKEN_CLEAR(lsp) sse_lsp_token_clear (&(lsp)->token)
#define TOKEN_TYPE(lsp) (lsp)->token.type
#define TOKEN_IVALUE(lsp) (lsp)->token.ivalue
#define TOKEN_RVALUE(lsp) (lsp)->token.rvalue
@ -28,13 +28,13 @@
#define TOKEN_SLENGTH(lsp) (lsp)->token.name.size
#define TOKEN_ADD_CHAR(lsp,ch) do { \
if (xp_lsp_token_addc(&(lsp)->token, ch) == -1) { \
lsp->errnum = XP_LSP_ERR_MEMORY; \
if (sse_lsp_token_addc(&(lsp)->token, ch) == -1) { \
lsp->errnum = SSE_LSP_ERR_MEMORY; \
return -1; \
} \
} while (0)
#define TOKEN_COMPARE(lsp,str) xp_lsp_token_compare_name (&(lsp)->token, str)
#define TOKEN_COMPARE(lsp,str) sse_lsp_token_compare_name (&(lsp)->token, str)
#define TOKEN_END 0
#define TOKEN_INT 1
@ -52,42 +52,42 @@
do { if (read_char(lsp) == -1) return -1;} while (0)
#define NEXT_TOKEN(lsp) \
do { if (read_token(lsp) == -1) return XP_NULL; } while (0)
do { if (read_token(lsp) == -1) return SSE_NULL; } while (0)
static xp_lsp_obj_t* read_obj (xp_lsp_t* lsp);
static xp_lsp_obj_t* read_list (xp_lsp_t* lsp);
static xp_lsp_obj_t* read_quote (xp_lsp_t* lsp);
static sse_lsp_obj_t* read_obj (sse_lsp_t* lsp);
static sse_lsp_obj_t* read_list (sse_lsp_t* lsp);
static sse_lsp_obj_t* read_quote (sse_lsp_t* lsp);
static int read_char (xp_lsp_t* lsp);
static int read_token (xp_lsp_t* lsp);
static int read_number (xp_lsp_t* lsp, int negative);
static int read_ident (xp_lsp_t* lsp);
static int read_string (xp_lsp_t* lsp);
static int read_char (sse_lsp_t* lsp);
static int read_token (sse_lsp_t* lsp);
static int read_number (sse_lsp_t* lsp, int negative);
static int read_ident (sse_lsp_t* lsp);
static int read_string (sse_lsp_t* lsp);
xp_lsp_obj_t* xp_lsp_read (xp_lsp_t* lsp)
sse_lsp_obj_t* sse_lsp_read (sse_lsp_t* lsp)
{
if (lsp->curc == XP_CHAR_EOF &&
read_char(lsp) == -1) return XP_NULL;
if (lsp->curc == SSE_CHAR_EOF &&
read_char(lsp) == -1) return SSE_NULL;
lsp->errnum = XP_LSP_ERR_NONE;
lsp->errnum = SSE_LSP_ERR_NONE;
NEXT_TOKEN (lsp);
if (lsp->mem->locked != XP_NULL) {
xp_lsp_unlock_all (lsp->mem->locked);
lsp->mem->locked = XP_NULL;
if (lsp->mem->locked != SSE_NULL) {
sse_lsp_unlock_all (lsp->mem->locked);
lsp->mem->locked = SSE_NULL;
}
lsp->mem->locked = read_obj (lsp);
return lsp->mem->locked;
}
static xp_lsp_obj_t* read_obj (xp_lsp_t* lsp)
static sse_lsp_obj_t* read_obj (sse_lsp_t* lsp)
{
xp_lsp_obj_t* obj;
sse_lsp_obj_t* obj;
switch (TOKEN_TYPE(lsp)) {
case TOKEN_END:
lsp->errnum = XP_LSP_ERR_END;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_END;
return SSE_NULL;
case TOKEN_LPAREN:
NEXT_TOKEN (lsp);
return read_list (lsp);
@ -95,94 +95,94 @@ static xp_lsp_obj_t* read_obj (xp_lsp_t* lsp)
NEXT_TOKEN (lsp);
return read_quote (lsp);
case TOKEN_INT:
obj = xp_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp));
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
xp_lsp_lock (obj);
obj = sse_lsp_make_int (lsp->mem, TOKEN_IVALUE(lsp));
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY;
sse_lsp_lock (obj);
return obj;
case TOKEN_REAL:
obj = xp_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp));
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
xp_lsp_lock (obj);
obj = sse_lsp_make_real (lsp->mem, TOKEN_RVALUE(lsp));
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY;
sse_lsp_lock (obj);
return obj;
case TOKEN_STRING:
obj = xp_lsp_make_stringx (
obj = sse_lsp_make_stringx (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
xp_lsp_lock (obj);
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY;
sse_lsp_lock (obj);
return obj;
case TOKEN_IDENT:
xp_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL);
if (TOKEN_COMPARE(lsp,XP_TEXT("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,XP_TEXT("t")) == 0) obj = lsp->mem->t;
sse_assert (lsp->mem->nil != SSE_NULL && lsp->mem->t != SSE_NULL);
if (TOKEN_COMPARE(lsp,SSE_TEXT("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,SSE_TEXT("t")) == 0) obj = lsp->mem->t;
else {
obj = xp_lsp_make_symbolx (
obj = sse_lsp_make_symbolx (
lsp->mem, TOKEN_SVALUE(lsp), TOKEN_SLENGTH(lsp));
if (obj == XP_NULL) lsp->errnum = XP_LSP_ERR_MEMORY;
xp_lsp_lock (obj);
if (obj == SSE_NULL) lsp->errnum = SSE_LSP_ERR_MEMORY;
sse_lsp_lock (obj);
}
return obj;
}
lsp->errnum = XP_LSP_ERR_SYNTAX;
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_SYNTAX;
return SSE_NULL;
}
static xp_lsp_obj_t* read_list (xp_lsp_t* lsp)
static sse_lsp_obj_t* read_list (sse_lsp_t* lsp)
{
xp_lsp_obj_t* obj;
xp_lsp_obj_cons_t* p, * first = XP_NULL, * prev = XP_NULL;
sse_lsp_obj_t* obj;
sse_lsp_obj_cons_t* p, * first = SSE_NULL, * prev = SSE_NULL;
while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
if (TOKEN_TYPE(lsp) == TOKEN_END) {
lsp->errnum = XP_LSP_ERR_SYNTAX; // unexpected end of input
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_SYNTAX; // unexpected end of input
return SSE_NULL;
}
if (TOKEN_TYPE(lsp) == TOKEN_DOT) {
if (prev == XP_NULL) {
lsp->errnum = XP_LSP_ERR_SYNTAX; // unexpected .
return XP_NULL;
if (prev == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_SYNTAX; // unexpected .
return SSE_NULL;
}
NEXT_TOKEN (lsp);
obj = read_obj (lsp);
if (obj == XP_NULL) {
if (lsp->errnum == XP_LSP_ERR_END) {
if (obj == SSE_NULL) {
if (lsp->errnum == SSE_LSP_ERR_END) {
//unexpected end of input
lsp->errnum = XP_LSP_ERR_SYNTAX;
lsp->errnum = SSE_LSP_ERR_SYNTAX;
}
return XP_NULL;
return SSE_NULL;
}
prev->cdr = obj;
NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) {
lsp->errnum = XP_LSP_ERR_SYNTAX; // ) expected
return XP_NULL;
lsp->errnum = SSE_LSP_ERR_SYNTAX; // ) expected
return SSE_NULL;
}
break;
}
obj = read_obj (lsp);
if (obj == XP_NULL) {
if (lsp->errnum == XP_LSP_ERR_END) {
if (obj == SSE_NULL) {
if (lsp->errnum == SSE_LSP_ERR_END) {
// unexpected end of input
lsp->errnum = XP_LSP_ERR_SYNTAX;
lsp->errnum = SSE_LSP_ERR_SYNTAX;
}
return XP_NULL;
return SSE_NULL;
}
p = (xp_lsp_obj_cons_t*)xp_lsp_make_cons (
p = (sse_lsp_obj_cons_t*)sse_lsp_make_cons (
lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
if (p == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
xp_lsp_lock ((xp_lsp_obj_t*)p);
sse_lsp_lock ((sse_lsp_obj_t*)p);
if (first == XP_NULL) first = p;
if (prev != XP_NULL) prev->cdr = (xp_lsp_obj_t*)p;
if (first == SSE_NULL) first = p;
if (prev != SSE_NULL) prev->cdr = (sse_lsp_obj_t*)p;
p->car = obj;
prev = p;
@ -190,61 +190,61 @@ static xp_lsp_obj_t* read_list (xp_lsp_t* lsp)
NEXT_TOKEN (lsp);
}
return (first == XP_NULL)? lsp->mem->nil: (xp_lsp_obj_t*)first;
return (first == SSE_NULL)? lsp->mem->nil: (sse_lsp_obj_t*)first;
}
static xp_lsp_obj_t* read_quote (xp_lsp_t* lsp)
static sse_lsp_obj_t* read_quote (sse_lsp_t* lsp)
{
xp_lsp_obj_t* cons, * tmp;
sse_lsp_obj_t* cons, * tmp;
tmp = read_obj (lsp);
if (tmp == XP_NULL) {
if (lsp->errnum == XP_LSP_ERR_END) {
if (tmp == SSE_NULL) {
if (lsp->errnum == SSE_LSP_ERR_END) {
// unexpected end of input
lsp->errnum = XP_LSP_ERR_SYNTAX;
lsp->errnum = SSE_LSP_ERR_SYNTAX;
}
return XP_NULL;
return SSE_NULL;
}
cons = xp_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil);
if (cons == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
cons = sse_lsp_make_cons (lsp->mem, tmp, lsp->mem->nil);
if (cons == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
xp_lsp_lock (cons);
sse_lsp_lock (cons);
cons = xp_lsp_make_cons (lsp->mem, lsp->mem->quote, cons);
if (cons == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEMORY;
return XP_NULL;
cons = sse_lsp_make_cons (lsp->mem, lsp->mem->quote, cons);
if (cons == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_MEMORY;
return SSE_NULL;
}
xp_lsp_lock (cons);
sse_lsp_lock (cons);
return cons;
}
static int read_char (xp_lsp_t* lsp)
static int read_char (sse_lsp_t* lsp)
{
xp_ssize_t n;
sse_ssize_t n;
if (lsp->input_func == XP_NULL) {
lsp->errnum = XP_LSP_ERR_INPUT_NOT_ATTACHED;
if (lsp->input_func == SSE_NULL) {
lsp->errnum = SSE_LSP_ERR_INPUT_NOT_ATTACHED;
return -1;
}
n = lsp->input_func(XP_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1);
n = lsp->input_func(SSE_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1);
if (n == -1) {
lsp->errnum = XP_LSP_ERR_INPUT;
lsp->errnum = SSE_LSP_ERR_INPUT;
return -1;
}
if (n == 0) lsp->curc = XP_CHAR_EOF;
if (n == 0) lsp->curc = SSE_CHAR_EOF;
return 0;
}
static int read_token (xp_lsp_t* lsp)
static int read_token (sse_lsp_t* lsp)
{
xp_assert (lsp->input_func != XP_NULL);
sse_assert (lsp->input_func != SSE_NULL);
TOKEN_CLEAR (lsp);
@ -253,43 +253,43 @@ static int read_token (xp_lsp_t* lsp)
while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here
if (lsp->curc == XP_CHAR(';')) {
if (lsp->curc == SSE_CHAR(';')) {
do {
NEXT_CHAR (lsp);
} while (lsp->curc != XP_CHAR('\n') && lsp->curc != XP_CHAR_EOF);
} while (lsp->curc != SSE_CHAR('\n') && lsp->curc != SSE_CHAR_EOF);
}
else break;
}
if (lsp->curc == XP_CHAR_EOF) {
if (lsp->curc == SSE_CHAR_EOF) {
TOKEN_TYPE(lsp) = TOKEN_END;
return 0;
}
else if (lsp->curc == XP_CHAR('(')) {
else if (lsp->curc == SSE_CHAR('(')) {
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_LPAREN;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == XP_CHAR(')')) {
else if (lsp->curc == SSE_CHAR(')')) {
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_RPAREN;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == XP_CHAR('\'')) {
else if (lsp->curc == SSE_CHAR('\'')) {
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_QUOTE;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == XP_CHAR('.')) {
else if (lsp->curc == SSE_CHAR('.')) {
TOKEN_ADD_CHAR (lsp, lsp->curc);
TOKEN_TYPE(lsp) = TOKEN_DOT;
NEXT_CHAR (lsp);
return 0;
}
else if (lsp->curc == XP_CHAR('-')) {
else if (lsp->curc == SSE_CHAR('-')) {
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
if (IS_DIGIT(lsp->curc)) {
@ -309,7 +309,7 @@ static int read_token (xp_lsp_t* lsp)
else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) {
return read_ident (lsp);
}
else if (lsp->curc == XP_CHAR('\"')) {
else if (lsp->curc == SSE_CHAR('\"')) {
NEXT_CHAR (lsp);
return read_string (lsp);
}
@ -319,26 +319,26 @@ static int read_token (xp_lsp_t* lsp)
return 0;
}
static int read_number (xp_lsp_t* lsp, int negative)
static int read_number (sse_lsp_t* lsp, int negative)
{
xp_lsp_int_t ivalue = 0;
xp_lsp_real_t rvalue = 0.;
sse_lsp_int_t ivalue = 0;
sse_lsp_real_t rvalue = 0.;
do {
ivalue = ivalue * 10 + (lsp->curc - XP_CHAR('0'));
ivalue = ivalue * 10 + (lsp->curc - SSE_CHAR('0'));
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
} while (IS_DIGIT(lsp->curc));
/* TODO: extend parsing floating point number */
if (lsp->curc == XP_CHAR('.')) {
xp_lsp_real_t fraction = 0.1;
if (lsp->curc == SSE_CHAR('.')) {
sse_lsp_real_t fraction = 0.1;
NEXT_CHAR (lsp);
rvalue = (xp_lsp_real_t)ivalue;
rvalue = (sse_lsp_real_t)ivalue;
while (IS_DIGIT(lsp->curc)) {
rvalue += (xp_lsp_real_t)(lsp->curc - XP_CHAR('0')) * fraction;
rvalue += (sse_lsp_real_t)(lsp->curc - SSE_CHAR('0')) * fraction;
fraction *= 0.1;
NEXT_CHAR (lsp);
}
@ -356,7 +356,7 @@ static int read_number (xp_lsp_t* lsp, int negative)
return 0;
}
static int read_ident (xp_lsp_t* lsp)
static int read_ident (sse_lsp_t* lsp)
{
do {
TOKEN_ADD_CHAR (lsp, lsp->curc);
@ -366,13 +366,13 @@ static int read_ident (xp_lsp_t* lsp)
return 0;
}
static int read_string (xp_lsp_t* lsp)
static int read_string (sse_lsp_t* lsp)
{
int escaped = 0;
xp_cint_t code = 0;
sse_cint_t code = 0;
do {
if (lsp->curc == XP_CHAR_EOF) {
if (lsp->curc == SSE_CHAR_EOF) {
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0;
}
@ -386,34 +386,34 @@ static int read_string (xp_lsp_t* lsp)
}
else if (escaped == 1) {
/* backslash + character */
if (lsp->curc == XP_CHAR('a'))
lsp->curc = XP_CHAR('\a');
else if (lsp->curc == XP_CHAR('b'))
lsp->curc = XP_CHAR('\b');
else if (lsp->curc == XP_CHAR('f'))
lsp->curc = XP_CHAR('\f');
else if (lsp->curc == XP_CHAR('n'))
lsp->curc = XP_CHAR('\n');
else if (lsp->curc == XP_CHAR('r'))
lsp->curc = XP_CHAR('\r');
else if (lsp->curc == XP_CHAR('t'))
lsp->curc = XP_CHAR('\t');
else if (lsp->curc == XP_CHAR('v'))
lsp->curc = XP_CHAR('\v');
else if (lsp->curc == XP_CHAR('0')) {
if (lsp->curc == SSE_CHAR('a'))
lsp->curc = SSE_CHAR('\a');
else if (lsp->curc == SSE_CHAR('b'))
lsp->curc = SSE_CHAR('\b');
else if (lsp->curc == SSE_CHAR('f'))
lsp->curc = SSE_CHAR('\f');
else if (lsp->curc == SSE_CHAR('n'))
lsp->curc = SSE_CHAR('\n');
else if (lsp->curc == SSE_CHAR('r'))
lsp->curc = SSE_CHAR('\r');
else if (lsp->curc == SSE_CHAR('t'))
lsp->curc = SSE_CHAR('\t');
else if (lsp->curc == SSE_CHAR('v'))
lsp->curc = SSE_CHAR('\v');
else if (lsp->curc == SSE_CHAR('0')) {
escaped = 2;
code = 0;
NEXT_CHAR (lsp);
continue;
}
else if (lsp->curc == XP_CHAR('x')) {
else if (lsp->curc == SSE_CHAR('x')) {
escaped = 3;
code = 0;
NEXT_CHAR (lsp);
continue;
}
}
else if (lsp->curc == XP_CHAR('\\')) {
else if (lsp->curc == SSE_CHAR('\\')) {
escaped = 1;
NEXT_CHAR (lsp);
continue;
@ -421,7 +421,7 @@ static int read_string (xp_lsp_t* lsp)
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
} while (lsp->curc != XP_CHAR('\"'));
} while (lsp->curc != SSE_CHAR('\"'));
TOKEN_TYPE(lsp) = TOKEN_STRING;
NEXT_CHAR (lsp);

64
ase/lsp/token.c
View File

@ -1,77 +1,77 @@
/*
* $Id: token.c,v 1.12 2005-12-05 15:11:29 bacon Exp $
* $Id: token.c,v 1.13 2006-10-22 13:10:46 bacon Exp $
*/
#include <xp/lsp/token.h>
#include <xp/bas/memory.h>
#include <sse/lsp/token.h>
#include <sse/bas/memory.h>
xp_lsp_token_t* xp_lsp_token_open (
xp_lsp_token_t* token, xp_word_t capacity)
sse_lsp_token_t* sse_lsp_token_open (
sse_lsp_token_t* token, sse_word_t capacity)
{
if (token == XP_NULL) {
token = (xp_lsp_token_t*)
xp_malloc (xp_sizeof(xp_lsp_token_t));
if (token == XP_NULL) return XP_NULL;
token->__dynamic = xp_true;
if (token == SSE_NULL) {
token = (sse_lsp_token_t*)
sse_malloc (sse_sizeof(sse_lsp_token_t));
if (token == SSE_NULL) return SSE_NULL;
token->__dynamic = sse_true;
}
else token->__dynamic = xp_false;
else token->__dynamic = sse_false;
if (xp_lsp_name_open(&token->name, capacity) == XP_NULL) {
if (token->__dynamic) xp_free (token);
return XP_NULL;
if (sse_lsp_name_open(&token->name, capacity) == SSE_NULL) {
if (token->__dynamic) sse_free (token);
return SSE_NULL;
}
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = XP_LSP_TOKEN_END;
token->type = SSE_LSP_TOKEN_END;
return token;
}
void xp_lsp_token_close (xp_lsp_token_t* token)
void sse_lsp_token_close (sse_lsp_token_t* token)
{
xp_lsp_name_close (&token->name);
if (token->__dynamic) xp_free (token);
sse_lsp_name_close (&token->name);
if (token->__dynamic) sse_free (token);
}
int xp_lsp_token_addc (xp_lsp_token_t* token, xp_cint_t c)
int sse_lsp_token_addc (sse_lsp_token_t* token, sse_cint_t c)
{
return xp_lsp_name_addc (&token->name, c);
return sse_lsp_name_addc (&token->name, c);
}
int xp_lsp_token_adds (xp_lsp_token_t* token, const xp_char_t* s)
int sse_lsp_token_adds (sse_lsp_token_t* token, const sse_char_t* s)
{
return xp_lsp_name_adds (&token->name, s);
return sse_lsp_name_adds (&token->name, s);
}
void xp_lsp_token_clear (xp_lsp_token_t* token)
void sse_lsp_token_clear (sse_lsp_token_t* token)
{
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = XP_LSP_TOKEN_END;
xp_lsp_name_clear (&token->name);
token->type = SSE_LSP_TOKEN_END;
sse_lsp_name_clear (&token->name);
}
xp_char_t* xp_lsp_token_yield (xp_lsp_token_t* token, xp_word_t capacity)
sse_char_t* sse_lsp_token_yield (sse_lsp_token_t* token, sse_word_t capacity)
{
xp_char_t* p;
sse_char_t* p;
p = xp_lsp_name_yield (&token->name, capacity);
if (p == XP_NULL) return XP_NULL;
p = sse_lsp_name_yield (&token->name, capacity);
if (p == SSE_NULL) return SSE_NULL;
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = XP_LSP_TOKEN_END;
token->type = SSE_LSP_TOKEN_END;
return p;
}
int xp_lsp_token_compare_name (xp_lsp_token_t* token, const xp_char_t* str)
int sse_lsp_token_compare_name (sse_lsp_token_t* token, const sse_char_t* str)
{
return xp_lsp_name_compare (&token->name, str);
return sse_lsp_name_compare (&token->name, str);
}

40
ase/lsp/token.h
View File

@ -1,44 +1,44 @@
/*
* $Id: token.h,v 1.11 2005-12-05 15:11:29 bacon Exp $
* $Id: token.h,v 1.12 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_TOKEN_H_
#define _XP_LSP_TOKEN_H_
#ifndef _SSE_LSP_TOKEN_H_
#define _SSE_LSP_TOKEN_H_
#include <xp/lsp/types.h>
#include <xp/lsp/name.h>
#include <sse/lsp/types.h>
#include <sse/lsp/name.h>
enum
{
XP_LSP_TOKEN_END
SSE_LSP_TOKEN_END
};
struct xp_lsp_token_t
struct sse_lsp_token_t
{
int type;
xp_lsp_int_t ivalue;
xp_lsp_real_t rvalue;
sse_lsp_int_t ivalue;
sse_lsp_real_t rvalue;
xp_lsp_name_t name;
xp_bool_t __dynamic;
sse_lsp_name_t name;
sse_bool_t __dynamic;
};
typedef struct xp_lsp_token_t xp_lsp_token_t;
typedef struct sse_lsp_token_t sse_lsp_token_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_token_t* xp_lsp_token_open (
xp_lsp_token_t* token, xp_word_t capacity);
void xp_lsp_token_close (xp_lsp_token_t* token);
sse_lsp_token_t* sse_lsp_token_open (
sse_lsp_token_t* token, sse_word_t capacity);
void sse_lsp_token_close (sse_lsp_token_t* token);
int xp_lsp_token_addc (xp_lsp_token_t* token, xp_cint_t c);
int xp_lsp_token_adds (xp_lsp_token_t* token, const xp_char_t* s);
void xp_lsp_token_clear (xp_lsp_token_t* token);
xp_char_t* xp_lsp_token_yield (xp_lsp_token_t* token, xp_word_t capacity);
int xp_lsp_token_compare_name (xp_lsp_token_t* token, const xp_char_t* str);
int sse_lsp_token_addc (sse_lsp_token_t* token, sse_cint_t c);
int sse_lsp_token_adds (sse_lsp_token_t* token, const sse_char_t* s);
void sse_lsp_token_clear (sse_lsp_token_t* token);
sse_char_t* sse_lsp_token_yield (sse_lsp_token_t* token, sse_word_t capacity);
int sse_lsp_token_compare_name (sse_lsp_token_t* token, const sse_char_t* str);
#ifdef __cplusplus
}

14
ase/lsp/types.h
View File

@ -1,14 +1,14 @@
/*
* $Id: types.h,v 1.7 2005-09-18 08:10:50 bacon Exp $
* $Id: types.h,v 1.8 2006-10-22 13:10:46 bacon Exp $
*/
#ifndef _XP_LSP_TYPES_H_
#define _XP_LSP_TYPES_H_
#ifndef _SSE_LSP_TYPES_H_
#define _SSE_LSP_TYPES_H_
#include <xp/types.h>
#include <xp/macros.h>
#include <sse/types.h>
#include <sse/macros.h>
typedef xp_long_t xp_lsp_int_t;
typedef xp_real_t xp_lsp_real_t;
typedef sse_long_t sse_lsp_int_t;
typedef sse_real_t sse_lsp_real_t;
#endif

2
ase/stx/makefile.in
View File

@ -6,7 +6,7 @@ OUT = libxpstx.a
CC = @CC@
RANLIB = @RANLIB@
CFLAGS = @CFLAGS@ -I@abs_top_builddir@
CFLAGS = @CFLAGS@ -I@abs_top_builddir@/..
LDFLAGS = @LDFLAGS@
LIBS = @LIBS@