===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/eval.c,v
retrieving revision 1.8
retrieving revision 1.13
diff -u -p -r1.8 -r1.13
--- OpenXM_contrib2/asir2000/parse/eval.c	2000/12/05 01:24:56	1.8
+++ OpenXM_contrib2/asir2000/parse/eval.c	2001/09/03 07:01:10	1.13
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.7 2000/09/22 06:36:43 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.12 2001/09/03 01:04:28 noro Exp $ 
 */
 #include <ctype.h>
 #include "ca.h"
@@ -65,6 +65,7 @@ int evalstatline;
 int recv_intr;
 
 pointer bevalf(), evalmapf(), evall();
+pointer eval_rec_mapf(), beval_rec_mapf();
 Obj getopt_from_cpvs();
 
 pointer eval(f)
@@ -81,8 +82,10 @@ FNODE f;
 	FNODE f1;
 	UP2 up2;
 	UP up;
+	UM um;
 	GF2N gf2n;
 	GFPN gfpn;
+	GFSN gfsn;
 
 #if defined(VISUAL)
 	if ( recv_intr ) {
@@ -99,10 +102,13 @@ FNODE f;
 	if ( !f )
 		return ( 0 );
 	switch ( f->id ) {
+		case I_PAREN:
+			val = eval((FNODE)(FA0(f)));
+			break;
 		case I_BOP:
 			a1 = eval((FNODE)FA1(f)); a2 = eval((FNODE)FA2(f));
 			(*((ARF)FA0(f))->fp)(CO,a1,a2,&val); 
-		break;
+			break;
 		case I_COP:
 			a1 = eval((FNODE)FA1(f)); a2 = eval((FNODE)FA2(f));
 			c = arf_comp(CO,a1,a2);
@@ -161,6 +167,8 @@ FNODE f;
 			break;
 		case I_MAP:
 			val = evalmapf((FUNC)FA0(f),(FNODE)FA1(f)); break;
+		case I_RECMAP:
+			val = eval_rec_mapf((FUNC)FA0(f),(FNODE)FA1(f)); break;
 		case I_IFUNC:
 			val = evalif((FNODE)FA0(f),(FNODE)FA1(f)); break;
 #if !defined(VISUAL)
@@ -253,12 +261,20 @@ FNODE f;
 			break;
 		case I_GFPNGEN:
 			up = UPALLOC(1);
-			up->d=1;
-			up->c[0] = 0;
-			up->c[1] = (Num)ONELM;
+			DEG(up)=1;
+			COEF(up)[0] = 0;
+			COEF(up)[1] = (Num)ONELM;
 			MKGFPN(up,gfpn);
 			val = (pointer)gfpn;
 			break;
+		case I_GFSNGEN:
+			um = UMALLOC(1);
+			DEG(um) = 1;
+			COEF(um)[0] = 0;
+			COEF(um)[1] = _onesf();
+			MKGFSN(um,gfsn);
+			val = (pointer)gfsn;
+			break;
 		case I_STR:
 			MKSTR(str,FA0(f)); val = (pointer)str; break;
 		case I_FORMULA:
@@ -439,9 +455,11 @@ FNODE opt;
 	LIST args;
 	pointer val;
 	int i,n,level;
-	NODE tn,sn,opts;
+	NODE tn,sn,opts,opt1;
     VS pvs;
 	char errbuf[BUFSIZ];
+	static int stack_size;
+	static void *stack_base;
 
 	if ( f->id == A_UNDEF ) {
 		sprintf(errbuf,"evalf : %s undefined",NAME(f));
@@ -473,10 +491,32 @@ FNODE opt;
 			cur_binf = 0;
 			break;
 		case A_USR:
+			/* stack check */
+#if !defined(VISUAL)
+			if ( !stack_size ) {
+				struct rlimit rl;
+				getrlimit(RLIMIT_STACK,&rl);
+				stack_size = rl.rlim_cur;
+			}
+			if ( !stack_base )
+				stack_base = (void *)GC_get_stack_base();
+			if ( (stack_base - (void *)&args) +0x100000 > stack_size )
+				error("stack overflow");
+#endif
 			args = (LIST)eval(a);
-			if ( opt )
+			if ( opt ) {
 				opts = BDY((LIST)eval(opt));
-			else
+				/* opts = ["opt1",arg1],... */
+				opt1 = BDY((LIST)BDY(opts));
+				if ( !strcmp(BDY((STRING)BDY(opt1)),"option_list") ) {
+					/*
+					 * the special option specification:
+					 *  option_list=[["o1","a1"],...]
+					 */
+					asir_assert(BDY(NEXT(opt1)),O_LIST,"evalf");
+					opts = BDY((LIST)BDY(NEXT(opt1)));
+				}
+			} else
 				opts = 0;
     		pvs = f->f.usrf->pvs;
     		if ( PVSS ) {
@@ -566,6 +606,69 @@ FNODE a;
 	return val;
 }
 
+pointer eval_rec_mapf(f,a)
+FUNC f;
+FNODE a;
+{
+	LIST args;
+
+	args = (LIST)eval(a);
+	return beval_rec_mapf(f,BDY(args));
+}
+
+pointer beval_rec_mapf(f,node)
+FUNC f;
+NODE node;
+{
+	LIST args;
+	NODE rest,t,n,r,r0;
+	Obj head;
+	VECT v,rv;
+	MAT m,rm;
+	LIST rl;
+	int len,row,col,i,j;
+	pointer val;
+
+	head = (Obj)BDY(node); rest = NEXT(node);
+	if ( !head ) {
+		val = bevalf(f,node);
+		return val;
+	}
+	switch ( OID(head) ) {
+		case O_VECT:
+			v = (VECT)head; len = v->len; MKVECT(rv,len);
+			for ( i = 0; i < len; i++ ) {
+				MKNODE(t,BDY(v)[i],rest); BDY(rv)[i] = beval_rec_mapf(f,t);
+			}
+			val = (pointer)rv;
+			break;
+		case O_MAT:
+			m = (MAT)head; row = m->row; col = m->col; MKMAT(rm,row,col);
+			for ( i = 0; i < row; i++ )
+				for ( j = 0; j < col; j++ ) {
+					MKNODE(t,BDY(m)[i][j],rest);
+					BDY(rm)[i][j] = beval_rec_mapf(f,t);
+				}
+			val = (pointer)rm;
+			break;
+		case O_LIST:
+			n = BDY((LIST)head);
+			for ( r0 = r = 0; n; n = NEXT(n) ) {
+				NEXTNODE(r0,r); MKNODE(t,BDY(n),rest);
+				BDY(r) = beval_rec_mapf(f,t);
+			}
+			if ( r0 )
+				NEXT(r) = 0;
+			MKLIST(rl,r0);
+			val = (pointer)rl;
+			break;
+		default:
+			val = bevalf(f,node);
+			break;
+	}
+	return val;
+}
+
 pointer bevalf(f,a)
 FUNC f;
 NODE a;
@@ -698,6 +801,24 @@ NODE *dnp;
 	NEXT(n) = 0; *dnp = n0;
 }
 
+void gen_searchf(name,r)
+char *name;
+FUNC *r;
+{
+	FUNC val;
+
+	searchf(sysf,name,&val);
+	if ( !val )
+		searchf(ubinf,name,&val);
+	if ( !val )
+		searchpf(name,&val);
+	if ( !val )
+		searchf(usrf,name,&val);
+	if ( !val )
+		appenduf(name,&val);
+	*r = val;
+}
+
 void searchf(fn,name,r)
 NODE fn;
 char *name;
@@ -794,14 +915,21 @@ char *key;
 {
 	NODE opts,opt;
 	Obj value;
+	LIST r;
 	extern Obj VOIDobj;
 
 	opts = CPVS->opt;
-	for ( ; opts; opts = NEXT(opts) ) {
-		opt = BDY((LIST)BDY(opts));
-		if ( !strcmp(key,BDY((STRING)BDY(opt))) )
-			return (Obj)BDY(NEXT(opt));
+	if ( !key ) {
+		MKLIST(r,opts);
+		return (Obj)r;
+	} else {
+		for ( ; opts; opts = NEXT(opts) ) {
+			asir_assert(BDY(opts),O_LIST,"getopt_from_cvps");
+			opt = BDY((LIST)BDY(opts));
+			if ( !strcmp(key,BDY((STRING)BDY(opt))) )
+				return (Obj)BDY(NEXT(opt));
+		}
+		return VOIDobj;
 	}
-	return VOIDobj;
 
 }