===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/print.c,v
retrieving revision 1.4
retrieving revision 1.9
diff -u -p -r1.4 -r1.9
--- OpenXM_contrib2/asir2000/builtin/print.c	2001/08/06 01:48:32	1.4
+++ OpenXM_contrib2/asir2000/builtin/print.c	2001/09/03 08:52:38	1.9
@@ -45,17 +45,20 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/print.c,v 1.3 2000/08/22 05:03:59 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/print.c,v 1.8 2001/08/31 09:17:12 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
 
 void Pprint();
 void Pquotetolist();
+void Peval_variables_in_quote();
+FNODE eval_pvar_in_fnode();
 
 struct ftab print_tab[] = {
 	{"print",Pprint,-2},
 	{"quotetolist",Pquotetolist,1},
+	{"eval_variables_in_quote",Peval_variables_in_quote,1},
 	{0,0,0},
 };
 
@@ -89,31 +92,76 @@ Obj *rp;
 	fnodetotree((FNODE)BDY((QUOTE)(ARG0(arg))),rp);
 }
 
+void Peval_variables_in_quote(arg,rp)
+NODE arg;
+QUOTE *rp;
+{
+	FNODE fn;
+
+	asir_assert(ARG0(arg),O_QUOTE,"eval_variables_in_quote");	
+	fn = eval_pvar_in_fnode((FNODE)BDY((QUOTE)(ARG0(arg))));
+	MKQUOTE(*rp,fn);
+}
+
+/* fnode -> [tag,name,arg0,arg1,...] */
+
 void fnodetotree(f,rp)
 FNODE f;
 Obj *rp;
 {
-	Obj a1,a2;
+	Obj a1,a2,a3;
 	NODE n,t,t0;
-	STRING head;
+	STRING head,op,str;
 	LIST r,arg;
 	char *opname;
 
 	if ( !f ) {
-		*rp = 0;
+		MKSTR(head,"internal");
+		n = mknode(2,head,0);
+		MKLIST(r,n);
+		*rp = (Obj)r;
 		return;
 	}
 	switch ( f->id ) {
-		case I_BOP: case I_COP: I_LOP:
-			/* arg list */
-			fnodetotree((FNODE)FA1(f),&a1);
-			fnodetotree((FNODE)FA2(f),&a2);
-			n = mknode(2,a1,a2); MKLIST(arg,n);
+		/* unary operators */
+		case I_NOT: case I_PAREN:
+			MKSTR(head,"u_op");
+			switch ( f->id ) {
+				case I_NOT:
+					MKSTR(op,"!");
+					break;
+				case I_PAREN:
+					MKSTR(op,"()");
+					break;
+			}
+			fnodetotree((FNODE)FA0(f),&a1);
+			n = mknode(3,head,op,a1);
+			MKLIST(r,n);
+			*rp = (Obj)r;
+			break;
 
+		/* binary operators */
+		case I_BOP: case I_COP: case I_LOP: case I_AND: case I_OR:
 			/* head */
+			MKSTR(head,"b_op");
+
+			/* arg list */
 			switch ( f->id ) {
+				case I_AND: case I_OR:
+					fnodetotree((FNODE)FA0(f),&a1);
+					fnodetotree((FNODE)FA1(f),&a2);
+					break;
+				default:
+					fnodetotree((FNODE)FA1(f),&a1);
+					fnodetotree((FNODE)FA2(f),&a2);
+					break;
+			}
+
+			/* op */
+			switch ( f->id ) {
 				case I_BOP:
-					MKSTR(head,((ARF)FA0(f))->name); break;
+					MKSTR(op,((ARF)FA0(f))->name); break;
+
 				case I_COP:
 					switch( (cid)FA0(f) ) {
 						case C_EQ: opname = "=="; break;
@@ -123,7 +171,8 @@ Obj *rp;
 						case C_GE: opname = ">="; break;
 						case C_LE: opname = "<="; break;
 					}
-					MKSTR(head,opname); break;
+					MKSTR(op,opname); break;
+
 				case I_LOP:
 					switch( (lid)FA0(f) ) {
 						case L_EQ: opname = "@=="; break;
@@ -134,50 +183,43 @@ Obj *rp;
 						case L_LE: opname = "@<="; break;
 						case L_AND: opname = "@&&"; break;
 						case L_OR: opname = "@||"; break;
-						case L_NOT: opname = "@!"; break;
+
+						case L_NOT: opname = "@!";
+							/* XXX : L_NOT is a unary operator */
+							MKSTR(head,"u_op");
+							MKSTR(op,opname);
+							n = mknode(3,head,op,a1);
+							MKLIST(r,n);
+							*rp = (Obj)r;
+							return;
 					}
-					MKSTR(head,opname); break;
+					MKSTR(op,opname); break;
+
+				case I_AND:
+					MKSTR(op,"&&"); break;
+
+				case I_OR:
+					MKSTR(op,"||"); break;
 			}
-			n = mknode(2,head,arg);
+			n = mknode(4,head,op,a1,a2);
 			MKLIST(r,n);
 			*rp = (Obj)r;
 			break;
-		case I_AND:
-			fnodetotree((FNODE)FA0(f),&a1);
-			fnodetotree((FNODE)FA1(f),&a2);
-			n = mknode(2,a1,a2); MKLIST(arg,n);
-			MKSTR(head,"&&");
-			n = mknode(2,head,arg);
-			MKLIST(r,n);
-			*rp = (Obj)r;
-			break;
-		case I_OR:
-			fnodetotree((FNODE)FA0(f),&a1);
-			fnodetotree((FNODE)FA1(f),&a2);
-			n = mknode(2,a1,a2); MKLIST(arg,n);
-			MKSTR(head,"||");
-			n = mknode(2,head,arg);
-			MKLIST(r,n);
-			*rp = (Obj)r;
-			break;
-		case I_NOT:
-			fnodetotree((FNODE)FA0(f),&a1);
-			n = mknode(1,a1); MKLIST(arg,n);
-			MKSTR(head,"!");
-			n = mknode(2,head,arg);
-			MKLIST(r,n);
-			*rp = (Obj)r;
-			break;
+
+		/* ternary operators */
 		case I_CE:
+			MKSTR(head,"t_op");
+			MKSTR(op,"?:");
 			fnodetotree((FNODE)FA0(f),&a1);
 			fnodetotree((FNODE)FA1(f),&a2);
-			n = mknode(2,a1,a2); MKLIST(arg,n);
-			MKSTR(head,"?:");
-			n = mknode(2,head,arg);
+			fnodetotree((FNODE)FA2(f),&a3);
+			n = mknode(5,head,op,a1,a2,a3);
 			MKLIST(r,n);
 			*rp = (Obj)r;
 			break;
-		case I_EV: case I_LIST:
+
+		/* lists */
+		case I_LIST:
 			n = (NODE)FA0(f);
 			for ( t0 = 0; n; n = NEXT(n) ) {
 				NEXTNODE(t0,t);
@@ -185,43 +227,168 @@ Obj *rp;
 			}
 			if ( t0 )
 				NEXT(t) = 0;
-			MKLIST(arg,t0);
+			MKSTR(head,"list");
+			MKNODE(n,head,t0);
+			MKLIST(r,n);
+			*rp = (Obj)r;
+			break;
+
+		/* function */
+		case I_FUNC: case I_CAR: case I_CDR: case I_EV:
+			MKSTR(head,"function");
 			switch ( f->id ) {
-				case I_LIST:
-					*rp = (Obj)arg; break;
+				case I_FUNC:
+					MKSTR(op,((FUNC)FA0(f))->name);
+					fnodetotree((FNODE)FA1(f),&arg);
+					break;
+				case I_CAR:
+					MKSTR(op,"car");
+					fnodetotree((FNODE)FA0(f),&arg);
+					break;
+				case I_CDR:
+					MKSTR(op,"cdr");
+					fnodetotree((FNODE)FA0(f),&arg);
+					break;
 				case I_EV:
-					MKSTR(head,"exponent_vector");
-					n = mknode(2,head,arg);
-					MKLIST(r,n);
-					*rp = (Obj)r;
+					/* exponent vector; should be treated as function call */
+					MKSTR(op,"exponent_vector");
+					fnodetotree(mkfnode(1,I_LIST,FA0(f)),&arg);
 					break;
 			}
+			t0 = NEXT(BDY(arg)); /* XXX : skip the headers */
+			MKNODE(t,op,t0);
+			MKNODE(n,head,t);
+			MKLIST(r,n);
+			*rp = (Obj)r;
 			break;
-		case I_FUNC:
-			fnodetotree((FNODE)FA1(f),&arg);
-			MKSTR(head,((FUNC)FA0(f))->name);
-			n = mknode(2,head,arg);
+
+		case I_STR:
+			MKSTR(head,"internal");
+			MKSTR(str,FA0(f));
+			n = mknode(2,head,str);
 			MKLIST(r,n);
 			*rp = (Obj)r;
 			break;
-		case I_CAR:
-			fnodetotree((FNODE)FA0(f),&arg);
-			MKSTR(head,"car");
-			n = mknode(2,head,arg);
+
+		case I_FORMULA:
+			MKSTR(head,"internal");
+			n = mknode(2,head,FA0(f));
 			MKLIST(r,n);
 			*rp = (Obj)r;
 			break;
-		case I_CDR:
-			fnodetotree((FNODE)FA0(f),&arg);
-			MKSTR(head,"cdr");
-			n = mknode(2,head,arg);
+
+		case I_PVAR:
+			MKSTR(head,"variable");
+			GETPVNAME(FA0(f),opname);
+			MKSTR(op,opname);
+			n = mknode(2,head,op);
 			MKLIST(r,n);
 			*rp = (Obj)r;
 			break;
-		case I_FORMULA:
-			*rp = (Obj)FA0(f);
-			break;
+
 		default:
 			error("fnodetotree : not implemented yet");
 	}
 }
+
+FNODE eval_pvar_in_fnode(f)
+FNODE f;
+{
+	FNODE a1,a2,a3;
+	pointer r;
+	NODE n,t,t0;
+
+	if ( !f )
+		return 0;
+
+	switch ( f->id ) {
+		/* unary operators */
+		case I_NOT: case I_PAREN:
+			a1 = eval_pvar_in_fnode((FNODE)FA0(f));
+			return mkfnode(1,f->id,a1);
+
+		/* binary operators */
+		case I_AND: case I_OR:
+			a1 = eval_pvar_in_fnode((FNODE)FA0(f));
+			a2 = eval_pvar_in_fnode((FNODE)FA1(f));
+			return mkfnode(3,f->id,a1,a2);
+
+		case I_BOP: case I_COP: case I_LOP: 
+			a1 = eval_pvar_in_fnode((FNODE)FA1(f));
+			a2 = eval_pvar_in_fnode((FNODE)FA2(f));
+			return mkfnode(4,f->id,FA0(f),a1,a2);
+
+		/* ternary operators */
+		case I_CE:
+			a1 = eval_pvar_in_fnode((FNODE)FA0(f));
+			a2 = eval_pvar_in_fnode((FNODE)FA1(f));
+			a3 = eval_pvar_in_fnode((FNODE)FA2(f));
+			return mkfnode(5,f->id,a1,a2,a3);
+
+		/* lists */
+		case I_LIST:
+			n = (NODE)FA0(f);
+			for ( t0 = 0; n; n = NEXT(n) ) {
+				NEXTNODE(t0,t);
+				BDY(t) = (pointer)eval_pvar_in_fnode(BDY(n));
+			}
+			if ( t0 )
+				NEXT(t) = 0;
+			return mkfnode(1,f->id,t0);
+
+		/* function */
+		case I_FUNC:
+			a1 = eval_pvar_in_fnode((FNODE)FA1(f));
+			return mkfnode(2,f->id,FA0(f),a1);
+			break;
+		case I_CAR: case I_CDR:
+			a1 = eval_pvar_in_fnode((FNODE)FA0(f));
+			return mkfnode(1,f->id,a1);
+		case I_EV:
+			/* exponent vector */
+			a1 = eval_pvar_in_fnode(mkfnode(1,I_LIST,FA0(f)));
+			return mkfnode(1,f->id,a1);
+
+		case I_STR: case I_FORMULA:
+			return f;
+
+		case I_PVAR: case I_INDEX:
+		case I_POSTSELF: case I_PRESELF:
+			r = eval(f);
+			return mkfnode(1,I_FORMULA,r);
+
+		default:
+			error("eval_pvar_in_fnode : not implemented yet");
+	}
+}
+
+char *get_attribute(key,attr)
+char *key;
+LIST attr;
+{}
+
+void treetofnode(obj,f)
+Obj obj;
+FNODE *f;
+{
+	NODE n;
+	LIST attr;
+	char *prop;
+
+	if ( obj || OID(obj) != O_LIST ) {
+		/* internal object */
+		*f = mkfnode(1,I_FORMULA,obj);
+	} else {
+		/* [attr(list),name(string),args(node)] */
+		n = BDY((LIST)obj);
+		attr = (LIST)BDY(n); n = NEXT(n);
+		prop = get_attribute("asir",attr);
+		if ( !strcmp(prop,"u_op") ) {
+		} else if ( !strcmp(prop,"b_op") ) {
+		} else if ( !strcmp(prop,"t_op") ) {
+		} else if ( !strcmp(prop,"function") ) {
+		}
+			/* default will be set to P_FUNC */
+	}
+}
+