*** empty log message ***

ase/lsp/eval.c

@@ -1,9 +1,10 @@
 /*
- * $Id: eval.c,v 1.22 2006-11-02 10:30:28 bacon Exp $
+ * $Id: eval.c,v 1.23 2006-11-02 11:10:12 bacon Exp $
  */
 
 #include <ase/lsp/lsp_i.h>
 
+static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
 static ase_lsp_obj_t* make_func (
 	ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro);
 static ase_lsp_obj_t* eval_cons (
@@ -14,6 +15,18 @@ static ase_lsp_obj_t* apply_to_prim (
 	ase_lsp_t* lsp, ase_lsp_obj_t* func, ase_lsp_obj_t* actual);
 
 ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
+{
+	ase_lsp_obj_t* ret;
+
+	//push_to_eval_stack (obj); 
+
+	ret = __eval (lsp, obj);
+	//pop ();
+
+	return ret;
+}
+
+static ase_lsp_obj_t* __eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
 {
 	lsp->errnum = ASE_LSP_ENOERR;
 

ase/lsp/lsp.c

@@ -1,5 +1,5 @@
 /*
- * $Id: lsp.c,v 1.16 2006-11-02 10:12:01 bacon Exp $
+ * $Id: lsp.c,v 1.17 2006-11-02 11:10:12 bacon Exp $
  */
 
 #if defined(__BORLANDC__)
@@ -203,6 +203,7 @@ static int __add_builtin_prims (ase_lsp_t* lsp)
 	ADD_PRIM (lsp, ASE_T("demac"), 5, ase_lsp_prim_demac, 3, MAX_ARGS);
 	ADD_PRIM (lsp, ASE_T("let"),   3, ase_lsp_prim_let,   1, MAX_ARGS);
 	ADD_PRIM (lsp, ASE_T("let*"),  4, ase_lsp_prim_letx,  1, MAX_ARGS);
+	ADD_PRIM (lsp, ASE_T("or"),    2, ase_lsp_prim_or,    2, MAX_ARGS);
 
 	ADD_PRIM (lsp, ASE_T("="),     1, ase_lsp_prim_eq,    2, 2);
 	ADD_PRIM (lsp, ASE_T("/="),    2, ase_lsp_prim_ne,    2, 2);

ase/lsp/mem.c

@@ -1,5 +1,5 @@
 /*
- * $Id: mem.c,v 1.23 2006-11-02 10:12:01 bacon Exp $
+ * $Id: mem.c,v 1.24 2006-11-02 11:10:12 bacon Exp $
  */
 
 #include <ase/lsp/lsp_i.h>
@@ -90,6 +90,7 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
 {
 	ase_lsp_obj_t* obj;
 	
+ase_lsp_collectgarbage(mem);
 	if (mem->count >= mem->ubound) ase_lsp_collectgarbage (mem);
 	if (mem->count >= mem->ubound) 
 	{

ase/lsp/prim.c

@@ -1,5 +1,5 @@
 /*
- * $Id: prim.c,v 1.17 2006-11-02 10:12:01 bacon Exp $
+ * $Id: prim.c,v 1.18 2006-11-02 11:10:12 bacon Exp $
  */
 
 #include <ase/lsp/lsp_i.h>
@@ -404,3 +404,26 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
 	}
 	return mac;
 }
+
+ase_lsp_obj_t* ase_lsp_prim_or (ase_lsp_t* lsp, ase_lsp_obj_t* args)
+{
+	/*
+	 * (or 10 20 30 40)
+	 * (or (= n 20) (= n 30))
+	 */
+	ase_lsp_obj_t* tmp;
+
+/* TODO: this is wrong. redo the work */
+	while (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS) 
+	{
+		tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
+		if (tmp == ASE_NULL) return ASE_NULL;
+
+		if (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_INT)
+		if (tmp != lsp->mem->nil) return lsp->mem->t;
+		args = ASE_LSP_CDR(args);
+	}
+
+	return lsp->mem->nil;
+}
+

ase/lsp/prim.h

@@ -1,5 +1,5 @@
 /*
- * $Id: prim.h,v 1.12 2006-11-02 06:46:31 bacon Exp $
+ * $Id: prim.h,v 1.13 2006-11-02 11:10:12 bacon Exp $
  */
 
 #ifndef _ASE_LSP_PRIM_H_
@@ -32,6 +32,7 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args);
 ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args);
 ase_lsp_obj_t* ase_lsp_prim_let   (ase_lsp_t* lsp, ase_lsp_obj_t* args);
 ase_lsp_obj_t* ase_lsp_prim_letx  (ase_lsp_t* lsp, ase_lsp_obj_t* args);
+ase_lsp_obj_t* ase_lsp_prim_or    (ase_lsp_t* lsp, ase_lsp_obj_t* args);
 
 /*---------------------
        prim_compar.c 

ase/test/lsp/t5.lsp

@@ -1,6 +1,7 @@
 ; Compute the N'th Fibonacci number.
 (defun fibonacci (N)
-  (if (or (zerop N) (= N 1))
+  ;(if (or (zerop N) (= N 1))
+  (if (or (= N 0) (= N 1))
       1
     (+ (fibonacci (- N 1)) (fibonacci (- N 2)))))
 

ase/test/lsp/t6.lsp

@@ -0,0 +1,9 @@
+
+
+(setq x '(a b c))
+(setq y '(x y z))
+(setcar x y)
+(setcar y x)
+x
+y
+