===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/eval.c,v
retrieving revision 1.2
retrieving revision 1.11
diff -u -p -r1.2 -r1.11
--- OpenXM_contrib2/asir2000/parse/eval.c	2000/02/08 04:47:12	1.2
+++ OpenXM_contrib2/asir2000/parse/eval.c	2001/08/31 02:47:19	1.11
@@ -1,13 +1,59 @@
-/* $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.1.1.1 1999/12/03 07:39:12 noro Exp $ */
+/*
+ * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED 
+ * All rights reserved.
+ * 
+ * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
+ * non-exclusive and royalty-free license to use, copy, modify and
+ * redistribute, solely for non-commercial and non-profit purposes, the
+ * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
+ * conditions of this Agreement. For the avoidance of doubt, you acquire
+ * only a limited right to use the SOFTWARE hereunder, and FLL or any
+ * third party developer retains all rights, including but not limited to
+ * copyrights, in and to the SOFTWARE.
+ * 
+ * (1) FLL does not grant you a license in any way for commercial
+ * purposes. You may use the SOFTWARE only for non-commercial and
+ * non-profit purposes only, such as academic, research and internal
+ * business use.
+ * (2) The SOFTWARE is protected by the Copyright Law of Japan and
+ * international copyright treaties. If you make copies of the SOFTWARE,
+ * with or without modification, as permitted hereunder, you shall affix
+ * to all such copies of the SOFTWARE the above copyright notice.
+ * (3) An explicit reference to this SOFTWARE and its copyright owner
+ * shall be made on your publication or presentation in any form of the
+ * results obtained by use of the SOFTWARE.
+ * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
+ * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
+ * for such modification or the source code of the modified part of the
+ * SOFTWARE.
+ * 
+ * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
+ * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
+ * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
+ * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
+ * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
+ * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
+ * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
+ * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
+ * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
+ * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
+ * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
+ * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
+ * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
+ * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
+ * 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.10 2001/08/21 01:39:39 noro Exp $ 
+*/
 #include <ctype.h>
 #include "ca.h"
 #include "al.h"
 #include "base.h"
 #include "parse.h"
-#if !defined(THINK_C)
 #include <sys/types.h>
 #include <sys/stat.h>
-#endif
 #if PARI
 #include "genpari.h"
 #endif
@@ -19,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)
@@ -53,10 +100,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);
@@ -115,6 +165,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)
@@ -137,15 +189,6 @@ FNODE f;
 			}
 			break;
 #endif
-#if 0
-		case I_PRESELF: case I_POSTSELF: 
-			val = evalpv(f->id,FA1(f),FA0(f)); break;
-		case I_PVAR: 
-			val = evalpv(f->id,FA0(f),0); break;
-		case I_ASSPVAR:
-			val = evalpv(f->id,FA0(f),FA1(f)); break;
-#endif
-#if 1
 		case I_PRESELF:
 			f1 = (FNODE)FA1(f);
 			if ( ID(f1) == I_PVAR ) {
@@ -157,7 +200,7 @@ FNODE f;
 					(*((ARF)FA0(f))->fp)(CO,u,ONE,&val); putarray(a,tn,val);
 				}
 			} else
-				val = evalpv(f->id,(FNODE)FA1(f),FA0(f));
+				error("++ : not implemented yet");
 			break;
 		case I_POSTSELF:
 			f1 = (FNODE)FA1(f);
@@ -171,10 +214,8 @@ FNODE f;
 					val = a;
 				}
 			} else
-				val = evalpv(f->id,(FNODE)FA1(f),FA0(f));
+				error("-- : not implemented yet");
 			break;
-		case I_CAST:
-			getmember((FNODE)f,(Obj *)&val); break;
 		case I_PVAR:
 			pv = (int)FA0(f); ind = (NODE)FA1(f); GETPV(pv,a); 
 			if ( !ind )
@@ -194,10 +235,17 @@ FNODE f;
 					evalnodebody(ind,&tn); 
 					putarray(a,tn,val = eval((FNODE)FA1(f))); 
 				}
-			} else
-				val = evalpv(ID(f),(FNODE)FA0(f),FA1(f));
+			} else if ( ID(f1) == I_POINT ) {
+				/* f1 <-> FA0(f1)->FA1(f1) */
+				a = eval(FA0(f1));
+				assign_to_member(a,(char *)FA1(f1),val = eval((FNODE)FA1(f)));
+			} else if ( ID(f1) == I_INDEX ) {
+				/* f1 <-> FA0(f1)[FA1(f1)] */
+				a = eval((FNODE)FA0(f1)); ind = (NODE)FA1(f1);
+				evalnodebody(ind,&tn);
+				putarray(a,tn,val = eval((FNODE)FA1(f)));
+			}
 			break;
-#endif
 		case I_ANS:
 			if ( (pv =(int)FA0(f)) < (int)APVS->n ) 
 				val = APVS->va[pv].priv;
@@ -257,6 +305,10 @@ FNODE f;
 		case I_GETOPT:
 			val = (pointer)getopt_from_cpvs((char *)FA0(f));
 			break;
+		case I_POINT:
+			a = (pointer)eval(FA0(f));
+			val = (pointer)memberofstruct(a,(char *)FA1(f));
+			break;
 		default:
 			error("eval : unknown id");
 			break;
@@ -393,7 +445,7 @@ FNODE opt;
 	LIST args;
 	pointer val;
 	int i,n,level;
-	NODE tn,sn,opts;
+	NODE tn,sn,opts,opt1;
     VS pvs;
 	char errbuf[BUFSIZ];
 
@@ -428,9 +480,19 @@ FNODE opt;
 			break;
 		case A_USR:
 			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 ) {
@@ -483,6 +545,10 @@ FNODE a;
 
 	args = (LIST)eval(a);
 	node = BDY(args); 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);
@@ -516,6 +582,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;
@@ -748,6 +877,7 @@ char *key;
 
 	opts = CPVS->opt;
 	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));