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-19 16:13:18 +00:00
parent 4117977053
commit 4d7be92231
4 changed files with 31 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ase/lsp/eval.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: eval.c,v 1.8 2005-09-18 10:18:35 bacon Exp $ * $Id: eval.c,v 1.9 2005-09-19 16:13:18 bacon Exp $
*/ */
#include <xp/lsp/lsp.h> #include <xp/lsp/lsp.h>
@ -44,8 +44,7 @@ xp_lsp_obj_t* xp_lsp_eval (xp_lsp_t* lsp, xp_lsp_obj_t* obj)
static xp_lsp_obj_t* make_func (xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro) static xp_lsp_obj_t* make_func (xp_lsp_t* lsp, xp_lsp_obj_t* cdr, int is_macro)
{ {
// TODO: lambda expression syntax check. xp_lsp_obj_t* func, * formal, * body, * p;
xp_lsp_obj_t* func, * formal, * body;
xp_printf (XP_TEXT("about to create a function or a macro ....\n")); xp_printf (XP_TEXT("about to create a function or a macro ....\n"));
@ -67,6 +66,14 @@ xp_printf (XP_TEXT("about to create a function or a macro ....\n"));
return XP_NULL; return XP_NULL;
} }
// TODO: more lambda expression syntax checks required???.
for (p = body; XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS; p = XP_LSP_CDR(p));
if (p != lsp->mem->nil) {
/* (lambda (x) (+ x 10) . 4) */
lsp->errnum = XP_LSP_ERR_BAD_ARG;
return XP_NULL;
}
func = (is_macro)? func = (is_macro)?
xp_lsp_make_macro (lsp->mem, formal, body): xp_lsp_make_macro (lsp->mem, formal, body):
xp_lsp_make_func (lsp->mem, formal, body); xp_lsp_make_func (lsp->mem, formal, body);

2
ase/lsp/makefile.in
View File

@ -1,4 +1,4 @@
SRCS = name.c token.c array.c mem.c env.c error.c SRCS = name.c token.c array.c mem.c env.c error.c \
init.c read.c eval.c print.c \ init.c read.c eval.c print.c \
prim.c prim_prog.c prim_let.c prim.c prim_prog.c prim_let.c
OBJS = $(SRCS:.c=.o) OBJS = $(SRCS:.c=.o)

19
ase/lsp/print.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: print.c,v 1.9 2005-09-18 13:23:32 bacon Exp $ * $Id: print.c,v 1.10 2005-09-19 16:13:18 bacon Exp $
*/ */
#include <xp/lsp/lsp.h> #include <xp/lsp/lsp.h>
@ -75,7 +75,7 @@ void xp_lsp_print_debug (xp_lsp_obj_t* obj)
} \ } \
} while (0) } while (0)
int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj) static int __print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj, xp_bool_t prt_cons_par)
{ {
xp_char_t buf[256]; xp_char_t buf[256];
@ -117,7 +117,7 @@ int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj)
case XP_LSP_OBJ_CONS: case XP_LSP_OBJ_CONS:
{ {
const xp_lsp_obj_t* p = obj; const xp_lsp_obj_t* p = obj;
OUTPUT_STR (lsp, XP_TEXT("(")); if (prt_cons_par) OUTPUT_STR (lsp, XP_TEXT("("));
do { do {
xp_lsp_print (lsp, XP_LSP_CAR(p)); xp_lsp_print (lsp, XP_LSP_CAR(p));
p = XP_LSP_CDR(p); p = XP_LSP_CDR(p);
@ -129,11 +129,16 @@ int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj)
} }
} }
} while (p != lsp->mem->nil && XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS); } while (p != lsp->mem->nil && XP_LSP_TYPE(p) == XP_LSP_OBJ_CONS);
OUTPUT_STR (lsp, XP_TEXT(")")); if (prt_cons_par) OUTPUT_STR (lsp, XP_TEXT(")"));
} }
break; break;
case XP_LSP_OBJ_FUNC: case XP_LSP_OBJ_FUNC:
OUTPUT_STR (lsp, XP_TEXT("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(")"));
break; break;
case XP_LSP_OBJ_MACRO: case XP_LSP_OBJ_MACRO:
OUTPUT_STR (lsp, XP_TEXT("macro")); OUTPUT_STR (lsp, XP_TEXT("macro"));
@ -150,3 +155,7 @@ int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj)
return 0; return 0;
} }
int xp_lsp_print (xp_lsp_t* lsp, const xp_lsp_obj_t* obj)
{
return __print (lsp, obj, xp_true);
}

7
ase/test/lsp/t1.lsp
View File

@ -10,7 +10,12 @@
;;;;;;; ;;;;;;;
(setq init-rand (macro (seed) (lambda () (setq seed (+ seed 1))))) (setq init-rand (macro (seed) (lambda () (setq seed (+ seed 1)))))
(setq init-rand (lambda (seed) (lambda () (setq seed (+ seed 1))))) (setq init-rand (lambda (seed) (lambda () (setq seed (+ seed 1)))))
(set 'rand (init-rand 1)) (setq rand (init-rand 1))
(rand)
(defun init-rand (seed) (lambda () (setq seed (+ seed 1))))
(defun rand () (init-rand 1))
(rand) (rand)