*** empty log message ***
This commit is contained in:
parent
fd9839e424
commit
b472d0006a
@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: env.c,v 1.2 2005-02-04 16:00:37 bacon Exp $
|
* $Id: env.c,v 1.3 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <xp/lisp/env.h>
|
#include <xp/lisp/env.h>
|
||||||
@ -56,7 +56,7 @@ xp_lisp_assoc_t* xp_lisp_frame_lookup (xp_lisp_frame_t* frame, xp_lisp_obj_t* na
|
|||||||
{
|
{
|
||||||
xp_lisp_assoc_t* assoc;
|
xp_lisp_assoc_t* assoc;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
|
xp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
|
||||||
|
|
||||||
assoc = frame->assoc;
|
assoc = frame->assoc;
|
||||||
while (assoc != XP_NULL) {
|
while (assoc != XP_NULL) {
|
||||||
@ -71,7 +71,7 @@ xp_lisp_assoc_t* xp_lisp_frame_insert (
|
|||||||
{
|
{
|
||||||
xp_lisp_assoc_t* assoc;
|
xp_lisp_assoc_t* assoc;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
|
xp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
|
||||||
|
|
||||||
assoc = xp_lisp_assoc_new (name, value);
|
assoc = xp_lisp_assoc_new (name, value);
|
||||||
if (assoc == XP_NULL) return XP_NULL;
|
if (assoc == XP_NULL) return XP_NULL;
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: eval.c,v 1.3 2005-02-04 16:23:34 bacon Exp $
|
* $Id: eval.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <xp/lisp/lisp.h>
|
#include <xp/lisp/lisp.h>
|
||||||
@ -89,7 +89,7 @@ static xp_lisp_obj_t* eval_cons (xp_lisp_t* lsp, xp_lisp_obj_t* cons)
|
|||||||
{
|
{
|
||||||
xp_lisp_obj_t* car, * cdr;
|
xp_lisp_obj_t* car, * cdr;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(cons) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(cons) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
car = XP_LISP_CAR(cons);
|
car = XP_LISP_CAR(cons);
|
||||||
cdr = XP_LISP_CDR(cons);
|
cdr = XP_LISP_CDR(cons);
|
||||||
@ -162,11 +162,11 @@ static xp_lisp_obj_t* apply (xp_lisp_t* lsp, xp_lisp_obj_t* func, xp_lisp_obj_t*
|
|||||||
xp_lisp_obj_t* value;
|
xp_lisp_obj_t* value;
|
||||||
xp_lisp_mem_t* mem;
|
xp_lisp_mem_t* mem;
|
||||||
|
|
||||||
xp_lisp_assert (
|
xp_assert (
|
||||||
XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
|
XP_LISP_TYPE(func) == XP_LISP_OBJ_FUNC ||
|
||||||
XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO);
|
XP_LISP_TYPE(func) == XP_LISP_OBJ_MACRO);
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(XP_LISP_CDR(func)) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(XP_LISP_CDR(func)) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
mem = lsp->mem;
|
mem = lsp->mem;
|
||||||
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: lisp.c,v 1.3 2005-02-04 16:23:34 bacon Exp $
|
* $Id: lisp.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <xp/lisp/lisp.h>
|
#include <xp/lisp/lisp.h>
|
||||||
@ -47,7 +47,7 @@ xp_lisp_t* xp_lisp_new (xp_size_t mem_ubound, xp_size_t mem_ubound_inc)
|
|||||||
|
|
||||||
void xp_lisp_free (xp_lisp_t* lsp)
|
void xp_lisp_free (xp_lisp_t* lsp)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (lsp != XP_NULL);
|
xp_assert (lsp != XP_NULL);
|
||||||
|
|
||||||
xp_lisp_mem_free (lsp->mem);
|
xp_lisp_mem_free (lsp->mem);
|
||||||
xp_lisp_token_free (lsp->token);
|
xp_lisp_token_free (lsp->token);
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: memory.c,v 1.3 2005-02-04 16:23:34 bacon Exp $
|
* $Id: memory.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <xp/lisp/memory.h>
|
#include <xp/lisp/memory.h>
|
||||||
@ -74,7 +74,7 @@ xp_lisp_mem_t* xp_lisp_mem_new (xp_size_t ubound, xp_size_t ubound_inc)
|
|||||||
|
|
||||||
void xp_lisp_mem_free (xp_lisp_mem_t* mem)
|
void xp_lisp_mem_free (xp_lisp_mem_t* mem)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (mem != XP_NULL);
|
xp_assert (mem != XP_NULL);
|
||||||
|
|
||||||
// dispose of the allocated objects
|
// dispose of the allocated objects
|
||||||
xp_lisp_dispose_all (mem);
|
xp_lisp_dispose_all (mem);
|
||||||
@ -179,9 +179,9 @@ xp_lisp_obj_t* xp_lisp_allocate (xp_lisp_mem_t* mem, int type, xp_size_t size)
|
|||||||
|
|
||||||
void xp_lisp_dispose (xp_lisp_mem_t* mem, xp_lisp_obj_t* prev, xp_lisp_obj_t* obj)
|
void xp_lisp_dispose (xp_lisp_mem_t* mem, xp_lisp_obj_t* prev, xp_lisp_obj_t* obj)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (mem != XP_NULL);
|
xp_assert (mem != XP_NULL);
|
||||||
xp_lisp_assert (obj != XP_NULL);
|
xp_assert (obj != XP_NULL);
|
||||||
xp_lisp_assert (mem->count > 0);
|
xp_assert (mem->count > 0);
|
||||||
|
|
||||||
// TODO: push the object to the free list for more
|
// TODO: push the object to the free list for more
|
||||||
// efficient memory management
|
// efficient memory management
|
||||||
@ -214,7 +214,7 @@ void xp_lisp_dispose_all (xp_lisp_mem_t* mem)
|
|||||||
|
|
||||||
static void xp_lisp_mark_obj (xp_lisp_obj_t* obj)
|
static void xp_lisp_mark_obj (xp_lisp_obj_t* obj)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (obj != XP_NULL);
|
xp_assert (obj != XP_NULL);
|
||||||
|
|
||||||
// TODO:....
|
// TODO:....
|
||||||
// can it be recursive?
|
// can it be recursive?
|
||||||
@ -241,20 +241,20 @@ static void xp_lisp_mark_obj (xp_lisp_obj_t* obj)
|
|||||||
*/
|
*/
|
||||||
void xp_lisp_lock (xp_lisp_obj_t* obj)
|
void xp_lisp_lock (xp_lisp_obj_t* obj)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (obj != XP_NULL);
|
xp_assert (obj != XP_NULL);
|
||||||
XP_LISP_LOCK(obj) = 1;
|
XP_LISP_LOCK(obj) = 1;
|
||||||
//XP_LISP_MARK(obj) = 1;
|
//XP_LISP_MARK(obj) = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
void xp_lisp_unlock (xp_lisp_obj_t* obj)
|
void xp_lisp_unlock (xp_lisp_obj_t* obj)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (obj != XP_NULL);
|
xp_assert (obj != XP_NULL);
|
||||||
XP_LISP_LOCK(obj) = 0;
|
XP_LISP_LOCK(obj) = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
void xp_lisp_unlock_all (xp_lisp_obj_t* obj)
|
void xp_lisp_unlock_all (xp_lisp_obj_t* obj)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (obj != XP_NULL);
|
xp_assert (obj != XP_NULL);
|
||||||
|
|
||||||
XP_LISP_LOCK(obj) = 0;
|
XP_LISP_LOCK(obj) = 0;
|
||||||
|
|
||||||
@ -499,7 +499,7 @@ xp_lisp_assoc_t* xp_lisp_lookup (xp_lisp_mem_t* mem, xp_lisp_obj_t* name)
|
|||||||
xp_lisp_frame_t* frame;
|
xp_lisp_frame_t* frame;
|
||||||
xp_lisp_assoc_t* assoc;
|
xp_lisp_assoc_t* assoc;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
|
xp_assert (XP_LISP_TYPE(name) == XP_LISP_OBJ_SYMBOL);
|
||||||
|
|
||||||
frame = mem->frame;
|
frame = mem->frame;
|
||||||
|
|
||||||
@ -530,7 +530,7 @@ xp_size_t xp_lisp_cons_len (xp_lisp_mem_t* mem, xp_lisp_obj_t* obj)
|
|||||||
{
|
{
|
||||||
xp_size_t count;
|
xp_size_t count;
|
||||||
|
|
||||||
xp_lisp_assert (obj == mem->nil || XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS);
|
xp_assert (obj == mem->nil || XP_LISP_TYPE(obj) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
count = 0;
|
count = 0;
|
||||||
//while (obj != mem->nil) {
|
//while (obj != mem->nil) {
|
||||||
@ -562,7 +562,7 @@ int xp_lisp_comp_symbol (xp_lisp_obj_t* obj, const xp_lisp_char* str)
|
|||||||
xp_lisp_char* p;
|
xp_lisp_char* p;
|
||||||
xp_size_t index, length;
|
xp_size_t index, length;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL);
|
xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL);
|
||||||
|
|
||||||
index = 0;
|
index = 0;
|
||||||
length = XP_LISP_SYMLEN(obj);
|
length = XP_LISP_SYMLEN(obj);
|
||||||
@ -582,7 +582,7 @@ int xp_lisp_comp_symbol2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t
|
|||||||
xp_lisp_char* p;
|
xp_lisp_char* p;
|
||||||
xp_size_t index, length;
|
xp_size_t index, length;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL);
|
xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_SYMBOL);
|
||||||
|
|
||||||
index = 0;
|
index = 0;
|
||||||
length = XP_LISP_SYMLEN(obj);
|
length = XP_LISP_SYMLEN(obj);
|
||||||
@ -603,7 +603,7 @@ int xp_lisp_comp_string (xp_lisp_obj_t* obj, const xp_lisp_char* str)
|
|||||||
xp_lisp_char* p;
|
xp_lisp_char* p;
|
||||||
xp_size_t index, length;
|
xp_size_t index, length;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING);
|
xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING);
|
||||||
|
|
||||||
index = 0;
|
index = 0;
|
||||||
length = XP_LISP_STRLEN(obj);
|
length = XP_LISP_STRLEN(obj);
|
||||||
@ -623,7 +623,7 @@ int xp_lisp_comp_string2 (xp_lisp_obj_t* obj, const xp_lisp_char* str, xp_size_t
|
|||||||
xp_lisp_char* p;
|
xp_lisp_char* p;
|
||||||
xp_size_t index, length;
|
xp_size_t index, length;
|
||||||
|
|
||||||
xp_lisp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING);
|
xp_assert (XP_LISP_TYPE(obj) == XP_LISP_OBJ_STRING);
|
||||||
|
|
||||||
index = 0;
|
index = 0;
|
||||||
length = XP_LISP_STRLEN(obj);
|
length = XP_LISP_STRLEN(obj);
|
||||||
|
@ -1,10 +1,10 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: primitive.c,v 1.2 2005-02-04 16:00:37 bacon Exp $
|
* $Id: primitive.c,v 1.3 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include "lisp.h"
|
#include <xp/lisp/lisp.h>
|
||||||
#include "memory.h"
|
#include <xp/lisp/memory.h>
|
||||||
#include "primitive.h"
|
#include <xp/lisp/primitive.h>
|
||||||
|
|
||||||
xp_lisp_obj_t* xp_lisp_prim_abort (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
xp_lisp_obj_t* xp_lisp_prim_abort (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
||||||
{
|
{
|
||||||
@ -18,7 +18,7 @@ xp_lisp_obj_t* xp_lisp_prim_eval (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* tmp;
|
xp_lisp_obj_t* tmp;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (tmp == XP_NULL) return XP_NULL;
|
if (tmp == XP_NULL) return XP_NULL;
|
||||||
@ -130,7 +130,7 @@ xp_lisp_obj_t* xp_lisp_prim_if (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* tmp;
|
xp_lisp_obj_t* tmp;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LISP_PRIM_MAX_ARG_COUNT);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, XP_LISP_PRIM_MAX_ARG_COUNT);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (tmp == XP_NULL) return XP_NULL;
|
if (tmp == XP_NULL) return XP_NULL;
|
||||||
@ -169,7 +169,7 @@ xp_lisp_obj_t* xp_lisp_prim_while (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* tmp;
|
xp_lisp_obj_t* tmp;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
for (;;) {
|
for (;;) {
|
||||||
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
@ -195,7 +195,7 @@ xp_lisp_obj_t* xp_lisp_prim_car (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* tmp;
|
xp_lisp_obj_t* tmp;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (tmp == XP_NULL) return XP_NULL;
|
if (tmp == XP_NULL) return XP_NULL;
|
||||||
@ -214,7 +214,7 @@ xp_lisp_obj_t* xp_lisp_prim_cdr (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* tmp;
|
xp_lisp_obj_t* tmp;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
tmp = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (tmp == XP_NULL) return XP_NULL;
|
if (tmp == XP_NULL) return XP_NULL;
|
||||||
@ -233,7 +233,7 @@ xp_lisp_obj_t* xp_lisp_prim_cons (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* car, * cdr, * cons;
|
xp_lisp_obj_t* car, * cdr, * cons;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
car = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
car = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (car == XP_NULL) return XP_NULL;
|
if (car == XP_NULL) return XP_NULL;
|
||||||
@ -255,7 +255,7 @@ xp_lisp_obj_t* xp_lisp_prim_set (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* p1, * p2;
|
xp_lisp_obj_t* p1, * p2;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (p1 == XP_NULL) return XP_NULL;
|
if (p1 == XP_NULL) return XP_NULL;
|
||||||
@ -281,7 +281,7 @@ xp_lisp_obj_t* xp_lisp_prim_setq (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
|
xp_lisp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
|
||||||
|
|
||||||
while (p != lsp->mem->nil) {
|
while (p != lsp->mem->nil) {
|
||||||
xp_lisp_assert (XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(p) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
p1 = XP_LISP_CAR(p);
|
p1 = XP_LISP_CAR(p);
|
||||||
if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) {
|
if (XP_LISP_TYPE(p1) != XP_LISP_OBJ_SYMBOL) {
|
||||||
@ -311,7 +311,7 @@ xp_lisp_obj_t* xp_lisp_prim_setq (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_obj_t* xp_lisp_prim_quote (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
xp_lisp_obj_t* xp_lisp_prim_quote (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
||||||
{
|
{
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
return XP_LISP_CAR(args);
|
return XP_LISP_CAR(args);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -525,7 +525,7 @@ xp_lisp_obj_t* xp_lisp_prim_plus (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
xp_lisp_int value = 0;
|
xp_lisp_int value = 0;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, XP_LISP_PRIM_MAX_ARG_COUNT);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
body = args;
|
body = args;
|
||||||
//while (body != lsp->mem->nil) {
|
//while (body != lsp->mem->nil) {
|
||||||
@ -557,7 +557,7 @@ xp_lisp_obj_t* xp_lisp_prim_gt (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
int res;
|
int res;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (p1 == XP_NULL) return XP_NULL;
|
if (p1 == XP_NULL) return XP_NULL;
|
||||||
@ -624,7 +624,7 @@ xp_lisp_obj_t* xp_lisp_prim_lt (xp_lisp_t* lsp, xp_lisp_obj_t* args)
|
|||||||
int res;
|
int res;
|
||||||
|
|
||||||
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
XP_LISP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
|
||||||
xp_lisp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
xp_assert (XP_LISP_TYPE(args) == XP_LISP_OBJ_CONS);
|
||||||
|
|
||||||
p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
p1 = xp_lisp_eval (lsp, XP_LISP_CAR(args));
|
||||||
if (p1 == XP_NULL) return XP_NULL;
|
if (p1 == XP_NULL) return XP_NULL;
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: read.c,v 1.3 2005-02-04 16:23:34 bacon Exp $
|
* $Id: read.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <xp/lisp/lisp.h>
|
#include <xp/lisp/lisp.h>
|
||||||
@ -79,7 +79,7 @@ static int read_string (xp_lisp_t* lsp);
|
|||||||
|
|
||||||
void xp_lisp_set_creader (xp_lisp_t* lsp, xp_lisp_creader_t func, void* extra)
|
void xp_lisp_set_creader (xp_lisp_t* lsp, xp_lisp_creader_t func, void* extra)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (lsp != XP_NULL);
|
xp_assert (lsp != XP_NULL);
|
||||||
|
|
||||||
lsp->creader = func;
|
lsp->creader = func;
|
||||||
lsp->creader_extra = extra;
|
lsp->creader_extra = extra;
|
||||||
@ -88,7 +88,7 @@ void xp_lisp_set_creader (xp_lisp_t* lsp, xp_lisp_creader_t func, void* extra)
|
|||||||
|
|
||||||
xp_lisp_obj_t* xp_lisp_read (xp_lisp_t* lsp)
|
xp_lisp_obj_t* xp_lisp_read (xp_lisp_t* lsp)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (lsp != XP_NULL && lsp->creader != XP_NULL);
|
xp_assert (lsp != XP_NULL && lsp->creader != XP_NULL);
|
||||||
|
|
||||||
if (lsp->creader_just_set) {
|
if (lsp->creader_just_set) {
|
||||||
// NEXT_CHAR (lsp);
|
// NEXT_CHAR (lsp);
|
||||||
@ -141,7 +141,7 @@ static xp_lisp_obj_t* read_obj (xp_lisp_t* lsp)
|
|||||||
xp_lisp_lock (obj);
|
xp_lisp_lock (obj);
|
||||||
return obj;
|
return obj;
|
||||||
case TOKEN_IDENT:
|
case TOKEN_IDENT:
|
||||||
xp_lisp_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL);
|
xp_assert (lsp->mem->nil != XP_NULL && lsp->mem->t != XP_NULL);
|
||||||
if (TOKEN_COMPARE(lsp,XP_TEXT("nil")) == 0) obj = lsp->mem->nil;
|
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;
|
else if (TOKEN_COMPARE(lsp,XP_TEXT("t")) == 0) obj = lsp->mem->t;
|
||||||
else {
|
else {
|
||||||
@ -255,7 +255,7 @@ static xp_lisp_obj_t* read_quote (xp_lisp_t* lsp)
|
|||||||
|
|
||||||
static int read_token (xp_lisp_t* lsp)
|
static int read_token (xp_lisp_t* lsp)
|
||||||
{
|
{
|
||||||
xp_lisp_assert (lsp->creader != XP_NULL);
|
xp_assert (lsp->creader != XP_NULL);
|
||||||
|
|
||||||
TOKEN_CLEAR (lsp);
|
TOKEN_CLEAR (lsp);
|
||||||
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* $Id: token.c,v 1.3 2005-02-04 16:23:34 bacon Exp $
|
* $Id: token.c,v 1.4 2005-02-05 05:18:20 bacon Exp $
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include "token.h"
|
#include "token.h"
|
||||||
@ -9,7 +9,7 @@ xp_lisp_token_t* xp_lisp_token_new (xp_size_t capacity)
|
|||||||
{
|
{
|
||||||
xp_lisp_token_t* token;
|
xp_lisp_token_t* token;
|
||||||
|
|
||||||
xp_lisp_assert (capacity > 0);
|
xp_assert (capacity > 0);
|
||||||
|
|
||||||
token = (xp_lisp_token_t*)malloc (sizeof(xp_lisp_token_t));
|
token = (xp_lisp_token_t*)malloc (sizeof(xp_lisp_token_t));
|
||||||
if (token == XP_NULL) return XP_NULL;
|
if (token == XP_NULL) return XP_NULL;
|
||||||
|
@ -1,7 +1,98 @@
|
|||||||
#include <xp/lisp/lisp.h>
|
#include <xp/lisp/lisp.h>
|
||||||
|
#include <xp/c/stdio.h>
|
||||||
|
|
||||||
int xp_main ()
|
#ifdef LINUX
|
||||||
|
#include <mcheck.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
static int get_char (xp_lisp_cint* ch, void* arg)
|
||||||
{
|
{
|
||||||
|
xp_lisp_cint c;
|
||||||
|
|
||||||
|
c = fgetc(stdin);
|
||||||
|
if (c == XP_EOF) {
|
||||||
|
if (ferror(stdin)) return -1;
|
||||||
|
c = XP_EOF;
|
||||||
|
}
|
||||||
|
|
||||||
|
*ch = c;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int to_int (const xp_char_t* str)
|
||||||
|
{
|
||||||
|
int r = 0;
|
||||||
|
|
||||||
|
while (*str != XP_CHAR('\0')) {
|
||||||
|
if (!xp_isdigit(*str)) break;
|
||||||
|
r = r * 10 + (*str - XP_CHAR('0'));
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
int xp_main (int argc, xp_char_t* argv[])
|
||||||
|
{
|
||||||
|
xp_lisp_t* lisp;
|
||||||
|
xp_lisp_obj_t* obj;
|
||||||
|
|
||||||
|
#ifdef LINUX
|
||||||
|
mtrace ();
|
||||||
|
#endif
|
||||||
|
if (argc != 3) {
|
||||||
|
xp_fprintf (xp_stderr, XP_TEXT("usage: %s mem_ubound mem_ubound_inc\n"), argv[0]);
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
lisp = xp_lisp_new (to_int(argv[1]), to_int(argv[2]));
|
||||||
|
if (lisp == NULL) {
|
||||||
|
xp_fprintf (xp_stderr, XP_TEXT("can't create a lisp instance\n"));
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
xp_printf (XP_TEXT("LISP 0.0001\n"));
|
||||||
|
|
||||||
|
xp_lisp_set_creader (lisp, get_char, NULL);
|
||||||
|
|
||||||
|
for (;;) {
|
||||||
|
xp_printf (XP_TEXT("%s> "), argv[0]);
|
||||||
|
|
||||||
|
obj = xp_lisp_read (lisp);
|
||||||
|
if (obj == NULL) {
|
||||||
|
if (lisp->error != XP_LISP_ERR_END &&
|
||||||
|
lisp->error != XP_LISP_ERR_ABORT) {
|
||||||
|
xp_fprintf (xp_stderr,
|
||||||
|
XP_TEXT("error while reading: %d\n"), lisp->error);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (lisp->error < XP_LISP_ERR_SYNTAX) break;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ((obj = xp_lisp_eval (lisp, obj)) != NULL) {
|
||||||
|
xp_lisp_print (lisp, obj);
|
||||||
|
xp_printf (XP_TEXT("\n"));
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if (lisp->error == XP_LISP_ERR_ABORT) break;
|
||||||
|
xp_fprintf (xp_stderr,
|
||||||
|
XP_TEXT("error while reading: %d\n"), lisp->error);
|
||||||
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
printf ("-----------\n");
|
||||||
|
xp_lisp_print (lisp, obj);
|
||||||
|
printf ("\n-----------\n");
|
||||||
|
*/
|
||||||
|
}
|
||||||
|
|
||||||
|
xp_lisp_free (lisp);
|
||||||
|
|
||||||
|
#ifdef LINUX
|
||||||
|
muntrace ();
|
||||||
|
#endif
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -3,8 +3,8 @@ OUTS = $(SRCS:.c=.x)
|
|||||||
|
|
||||||
CC = @CC@
|
CC = @CC@
|
||||||
CFLAGS = @CFLAGS@ -I@abs_top_builddir@
|
CFLAGS = @CFLAGS@ -I@abs_top_builddir@
|
||||||
LDFLAGS = @LDFLAGS@ -L@abs_top_builddir@/xp/c
|
LDFLAGS = @LDFLAGS@ -L@abs_top_builddir@/xp/c -L@abs_top_builddir@/xp/lisp
|
||||||
LIBS = @LIBS@ -lxpc
|
LIBS = @LIBS@ -lxpc -lxplisp
|
||||||
|
|
||||||
all: $(OUTS)
|
all: $(OUTS)
|
||||||
|
|
||||||
|
16
ase/test/lsp/t1.lsp
Normal file
16
ase/test/lsp/t1.lsp
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
(setq x (lambda (x) (car x)))
|
||||||
|
((lambda (x) (+ x 99)) (x '(10 20 30)))
|
||||||
|
|
||||||
|
((lambda (x) ((lambda (y) (+ y 1)) x)) 10)
|
||||||
|
; lisp....
|
||||||
|
((lambda (x) ((macro (y) (+ y 1)) x)) 10)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;;;;;;
|
||||||
|
(setq init-rand (macro (seed) (lambda () (setq seed (+ seed 1)))))
|
||||||
|
(setq init-rand (lambda (seed) (lambda () (setq seed (+ seed 1)))))
|
||||||
|
(setq rand (init-rand 1))
|
||||||
|
(rand)
|
||||||
|
|
169
ase/test/lsp/t2.lsp
Normal file
169
ase/test/lsp/t2.lsp
Normal file
@ -0,0 +1,169 @@
|
|||||||
|
(setq x (lambda (x) (+ x 20 30 40)))
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 100)
|
||||||
|
(x 200)
|
||||||
|
(x 200)
|
||||||
|
(x 200)
|
||||||
|
(x 200)
|
||||||
|
(x 200)
|
Loading…
Reference in New Issue
Block a user