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 2005-09-20 09:17:06 +00:00
parent f50849c274
commit fe556e6bbc
9 changed files with 100 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
ase/lsp/env.c
View File

@ -1,12 +1,15 @@
/* /*
* $Id: env.c,v 1.7 2005-09-18 11:34:35 bacon Exp $ * $Id: env.c,v 1.8 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/env.h> #include <xp/lsp/env.h>
#include <xp/bas/memory.h> #include <xp/bas/memory.h>
#include <xp/bas/assert.h> #include <xp/bas/assert.h>
xp_lsp_assoc_t* xp_lsp_assoc_new (xp_lsp_obj_t* name, xp_lsp_obj_t* value) // 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)
{ {
xp_lsp_assoc_t* assoc; xp_lsp_assoc_t* assoc;
@ -15,6 +18,7 @@ xp_lsp_assoc_t* xp_lsp_assoc_new (xp_lsp_obj_t* name, xp_lsp_obj_t* value)
assoc->name = name; assoc->name = name;
assoc->value = value; assoc->value = value;
assoc->func = func;
assoc->link = XP_NULL; assoc->link = XP_NULL;
return assoc; return assoc;
@ -67,17 +71,30 @@ xp_lsp_assoc_t* xp_lsp_frame_lookup (xp_lsp_frame_t* frame, xp_lsp_obj_t* name)
return XP_NULL; return XP_NULL;
} }
xp_lsp_assoc_t* xp_lsp_frame_insert ( 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_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* value)
{ {
xp_lsp_assoc_t* assoc; xp_lsp_assoc_t* assoc;
xp_assert (XP_LSP_TYPE(name) == XP_LSP_OBJ_SYMBOL); xp_assert (XP_LSP_TYPE(name) == XP_LSP_OBJ_SYMBOL);
assoc = xp_lsp_assoc_new (name, value); assoc = xp_lsp_assoc_new (name, value, XP_NULL);
if (assoc == XP_NULL) return XP_NULL; if (assoc == XP_NULL) return XP_NULL;
assoc->link = frame->assoc; assoc->link = frame->assoc;
frame->assoc = assoc; frame->assoc = assoc;
return 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)
{
xp_lsp_assoc_t* assoc;
xp_assert (XP_LSP_TYPE(name) == XP_LSP_OBJ_SYMBOL);
assoc = xp_lsp_assoc_new (name, XP_NULL, func);
if (assoc == XP_NULL) return XP_NULL;
assoc->link = frame->assoc;
frame->assoc = assoc;
return assoc;
}

17
ase/lsp/env.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: env.h,v 1.6 2005-09-18 11:54:23 bacon Exp $ * $Id: env.h,v 1.7 2005-09-20 09:17:06 bacon Exp $
*/ */
#ifndef _XP_LSP_ENV_H_ #ifndef _XP_LSP_ENV_H_
@ -9,8 +9,10 @@
struct xp_lsp_assoc_t struct xp_lsp_assoc_t
{ {
xp_lsp_obj_t* name; // xp_lsp_obj_symbol_t xp_lsp_obj_t* name; // xp_lsp_obj_symbol_t
xp_lsp_obj_t* value; /*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; struct xp_lsp_assoc_t* link;
}; };
@ -27,13 +29,18 @@ typedef struct xp_lsp_frame_t xp_lsp_frame_t;
extern "C" { extern "C" {
#endif #endif
xp_lsp_assoc_t* xp_lsp_assoc_new (xp_lsp_obj_t* name, xp_lsp_obj_t* value); 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); void xp_lsp_assoc_free (xp_lsp_assoc_t* assoc);
xp_lsp_frame_t* xp_lsp_frame_new (void); xp_lsp_frame_t* xp_lsp_frame_new (void);
void xp_lsp_frame_free (xp_lsp_frame_t* frame); 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); xp_lsp_assoc_t* xp_lsp_frame_lookup (xp_lsp_frame_t* frame, xp_lsp_obj_t* name);
xp_lsp_assoc_t* xp_lsp_frame_insert (xp_lsp_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* value);
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);
#ifdef __cplusplus #ifdef __cplusplus
} }

26
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: eval.c,v 1.10 2005-09-20 08:05:32 bacon Exp $ * $Id: eval.c,v 1.11 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/lsp.h> #include <xp/lsp/lsp.h>
@ -31,7 +31,7 @@ xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj)
} }
*/ */
if ((assoc = xp_lsp_lookup (lsp->mem, obj)) == XP_NULL) { if ((assoc = xp_lsp_lookup(lsp->mem, obj)) == XP_NULL) {
if (lsp->opt_undef_symbol) { if (lsp->opt_undef_symbol) {
lsp->errnum = XP_LSP_ERR_UNDEF_SYMBOL; lsp->errnum = XP_LSP_ERR_UNDEF_SYMBOL;
return XP_NULL; return XP_NULL;
@ -107,8 +107,15 @@ static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_SYMBOL) { else if (XP_LSP_TYPE(car) == XP_LSP_OBJ_SYMBOL) {
xp_lsp_assoc_t* assoc; xp_lsp_assoc_t* assoc;
if ((assoc = xp_lsp_lookup (lsp->mem, car)) != XP_NULL) { if ((assoc = xp_lsp_lookup(lsp->mem, car)) != XP_NULL) {
xp_lsp_obj_t* func = assoc->value; //xp_lsp_obj_t* func = assoc->value;
xp_lsp_obj_t* func = assoc->func;
if (func == XP_NULL) {
/* the symbol's function definition is void */
lsp->errnum = XP_LSP_ERR_UNDEF_FUNC;
return XP_NULL;
}
if (XP_LSP_TYPE(func) == XP_LSP_OBJ_FUNC || if (XP_LSP_TYPE(func) == XP_LSP_OBJ_FUNC ||
XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) { XP_LSP_TYPE(func) == XP_LSP_OBJ_MACRO) {
return apply (lsp, func, cdr); return apply (lsp, func, cdr);
@ -152,7 +159,8 @@ static xp_lsp_obj_t* eval_cons (xp_lsp_t* lsp, xp_lsp_obj_t* cons)
return XP_NULL; return XP_NULL;
} }
static xp_lsp_obj_t* apply (xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* actual) static xp_lsp_obj_t* apply (
xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* actual)
{ {
xp_lsp_frame_t* frame; xp_lsp_frame_t* frame;
xp_lsp_obj_t* formal; xp_lsp_obj_t* formal;
@ -209,14 +217,18 @@ static xp_lsp_obj_t* apply (xp_lsp_t* lsp, xp_lsp_obj_t* func, xp_lsp_obj_t* act
} }
} }
if (xp_lsp_frame_lookup(frame, XP_LSP_CAR(formal)) != XP_NULL) { if (xp_lsp_frame_lookup (
frame, XP_LSP_CAR(formal)) != XP_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL; lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame); xp_lsp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
if (xp_lsp_frame_insert(frame, XP_LSP_CAR(formal), value) == XP_NULL) { if (xp_lsp_frame_insert_value (
frame, XP_LSP_CAR(formal), value) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame); xp_lsp_frame_free (frame);

6
ase/lsp/init.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: init.c,v 1.6 2005-09-20 08:05:32 bacon Exp $ * $Id: init.c,v 1.7 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/lsp.h> #include <xp/lsp/lsp.h>
@ -22,8 +22,8 @@ xp_lsp_t* xp_lsp_open (xp_lsp_t* lsp,
} }
lsp->errnum = XP_LSP_ERR_NONE; lsp->errnum = XP_LSP_ERR_NONE;
//lsp->opt_undef_symbol = 1; lsp->opt_undef_symbol = 1;
lsp->opt_undef_symbol = 0; //lsp->opt_undef_symbol = 0;
lsp->curc = XP_CHAR_EOF; lsp->curc = XP_CHAR_EOF;
lsp->input_func = XP_NULL; lsp->input_func = XP_NULL;

24
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: mem.c,v 1.4 2005-09-20 08:05:32 bacon Exp $ * $Id: mem.c,v 1.5 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/mem.h> #include <xp/lsp/mem.h>
@ -107,7 +107,7 @@ static int __add_prim (xp_lsp_mem_t* mem,
xp_lsp_unlock (n); xp_lsp_unlock (n);
if (xp_lsp_set (mem, n, p) == XP_NULL) return -1; if (xp_lsp_set_func(mem, n, p) == XP_NULL) return -1;
return 0; return 0;
} }
@ -521,14 +521,15 @@ xp_lsp_assoc_t* xp_lsp_lookup (xp_lsp_mem_t* mem, xp_lsp_obj_t* name)
return XP_NULL; return XP_NULL;
} }
xp_lsp_assoc_t* xp_lsp_set ( 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_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* value)
{ {
xp_lsp_assoc_t* assoc; xp_lsp_assoc_t* assoc;
assoc = xp_lsp_lookup (mem, name); assoc = xp_lsp_lookup (mem, name);
if (assoc == XP_NULL) { if (assoc == XP_NULL) {
assoc = xp_lsp_frame_insert (mem->root_frame, name, value); assoc = xp_lsp_frame_insert_value (
mem->root_frame, name, value);
if (assoc == XP_NULL) return XP_NULL; if (assoc == XP_NULL) return XP_NULL;
} }
else assoc->value = value; else assoc->value = value;
@ -536,6 +537,21 @@ xp_lsp_assoc_t* xp_lsp_set (
return assoc; return assoc;
} }
xp_lsp_assoc_t* xp_lsp_set_func (
xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* func)
{
xp_lsp_assoc_t* assoc;
assoc = xp_lsp_lookup (mem, name);
if (assoc == XP_NULL) {
assoc = xp_lsp_frame_insert_func (mem->root_frame, name, func);
if (assoc == XP_NULL) return XP_NULL;
}
else assoc->func = func;
return assoc;
}
xp_size_t xp_lsp_cons_len (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj) xp_size_t xp_lsp_cons_len (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj)
{ {
xp_size_t count; xp_size_t count;

11
ase/lsp/mem.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: mem.h,v 1.4 2005-09-20 08:05:32 bacon Exp $ * $Id: mem.h,v 1.5 2005-09-20 09:17:06 bacon Exp $
*/ */
#ifndef _XP_LSP_MEM_H_ #ifndef _XP_LSP_MEM_H_
@ -79,11 +79,14 @@ xp_lsp_obj_t* xp_lsp_make_prim (xp_lsp_mem_t* mem, void* impl);
// frame lookup // 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_lookup (xp_lsp_mem_t* mem, xp_lsp_obj_t* name);
xp_lsp_assoc_t* xp_lsp_set (xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* value); 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);
// cons operations // cons operations
xp_size_t xp_lsp_cons_len (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj); 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); int xp_lsp_probe_args (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj, xp_size_t* len);
// symbol and string operations // symbol and string operations
int xp_lsp_comp_symbol (xp_lsp_obj_t* obj, const xp_char_t* str); int xp_lsp_comp_symbol (xp_lsp_obj_t* obj, const xp_char_t* str);

10
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim.c,v 1.4 2005-09-20 08:05:32 bacon Exp $ * $Id: prim.c,v 1.5 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/lsp.h> #include <xp/lsp/lsp.h>
@ -243,7 +243,7 @@ xp_lsp_obj_t* xp_lsp_prim_set (xp_lsp_t* lsp, xp_lsp_obj_t* args)
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args))); p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(args)));
if (p2 == XP_NULL) return XP_NULL; if (p2 == XP_NULL) return XP_NULL;
if (xp_lsp_set (lsp->mem, p1, p2) == XP_NULL) { if (xp_lsp_set_value (lsp->mem, p1, p2) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
@ -277,7 +277,7 @@ xp_lsp_obj_t* xp_lsp_prim_setq (xp_lsp_t* lsp, xp_lsp_obj_t* args)
p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(p))); p2 = xp_lsp_eval (lsp, XP_LSP_CAR(XP_LSP_CDR(p)));
if (p2 == XP_NULL) return XP_NULL; if (p2 == XP_NULL) return XP_NULL;
if (xp_lsp_set (lsp->mem, p1, p2) == XP_NULL) { if (xp_lsp_set_value (lsp->mem, p1, p2) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
@ -324,7 +324,7 @@ xp_lsp_obj_t* xp_lsp_prim_defun (xp_lsp_t* lsp, xp_lsp_obj_t* args)
XP_LSP_CAR(XP_LSP_CDR(args)), XP_LSP_CDR(XP_LSP_CDR(args))); XP_LSP_CAR(XP_LSP_CDR(args)), XP_LSP_CDR(XP_LSP_CDR(args)));
if (fun == XP_NULL) return XP_NULL; if (fun == XP_NULL) return XP_NULL;
if (xp_lsp_set (lsp->mem, XP_LSP_CAR(args), fun) == XP_NULL) { if (xp_lsp_set_func (lsp->mem, XP_LSP_CAR(args), fun) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }
@ -352,7 +352,7 @@ xp_lsp_obj_t* xp_lsp_prim_demac (xp_lsp_t* lsp, xp_lsp_obj_t* args)
XP_LSP_CAR(XP_LSP_CDR(args)), XP_LSP_CDR(XP_LSP_CDR(args))); XP_LSP_CAR(XP_LSP_CDR(args)), XP_LSP_CDR(XP_LSP_CDR(args)));
if (mac == XP_NULL) return XP_NULL; if (mac == XP_NULL) return XP_NULL;
if (xp_lsp_set (lsp->mem, XP_LSP_CAR(args), mac) == XP_NULL) { if (xp_lsp_set_func (lsp->mem, XP_LSP_CAR(args), mac) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
return XP_NULL; return XP_NULL;
} }

8
ase/lsp/prim_let.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim_let.c,v 1.1 2005-09-19 12:04:00 bacon Exp $ * $Id: prim_let.c,v 1.2 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/prim.h> #include <xp/lsp/prim.h>
@ -71,7 +71,7 @@ static xp_lsp_obj_t* __prim_let (
xp_lsp_frame_free (frame); xp_lsp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
if (xp_lsp_frame_insert (frame, n, v) == XP_NULL) { if (xp_lsp_frame_insert_value(frame, n, v) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
@ -80,14 +80,14 @@ static xp_lsp_obj_t* __prim_let (
} }
} }
else if (XP_LSP_TYPE(ass) == XP_LSP_OBJ_SYMBOL) { else if (XP_LSP_TYPE(ass) == XP_LSP_OBJ_SYMBOL) {
if (xp_lsp_frame_lookup (frame, ass) != XP_NULL) { if (xp_lsp_frame_lookup(frame, ass) != XP_NULL) {
lsp->errnum = XP_LSP_ERR_DUP_FORMAL; lsp->errnum = XP_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
xp_lsp_frame_free (frame); xp_lsp_frame_free (frame);
return XP_NULL; return XP_NULL;
} }
if (xp_lsp_frame_insert (frame, ass, lsp->mem->nil) == XP_NULL) { if (xp_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;

11
ase/lsp/prim_math.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: prim_math.c,v 1.1 2005-09-20 08:05:32 bacon Exp $ * $Id: prim_math.c,v 1.2 2005-09-20 09:17:06 bacon Exp $
*/ */
#include <xp/lsp/prim.h> #include <xp/lsp/prim.h>
@ -28,6 +28,8 @@ xp_lsp_obj_t* xp_lsp_prim_plus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
body = XP_LSP_CDR(body); body = XP_LSP_CDR(body);
} }
xp_assert (body == lsp->mem->nil);
tmp = xp_lsp_make_int (lsp->mem, value); tmp = xp_lsp_make_int (lsp->mem, value);
if (tmp == XP_NULL) { if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;
@ -56,10 +58,15 @@ xp_lsp_obj_t* xp_lsp_prim_minus (xp_lsp_t* lsp, xp_lsp_obj_t* args)
return XP_NULL; return XP_NULL;
} }
value = value - XP_LSP_IVALUE(tmp); if (body == args)
value = XP_LSP_IVALUE(tmp);
else value = value - XP_LSP_IVALUE(tmp);
body = XP_LSP_CDR(body); body = XP_LSP_CDR(body);
} }
xp_assert (body == lsp->mem->nil);
tmp = xp_lsp_make_int (lsp->mem, value); tmp = xp_lsp_make_int (lsp->mem, value);
if (tmp == XP_NULL) { if (tmp == XP_NULL) {
lsp->errnum = XP_LSP_ERR_MEM; lsp->errnum = XP_LSP_ERR_MEM;