[BACK]Return to reduct.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin
File: [local] / OpenXM_contrib2 / asir2000 / builtin / reduct.c (download)

Revision 1.1.1.1 (vendor branch), Fri Dec 3 07:39:07 1999 UTC (24 years, 5 months ago) by noro
Branch: NORO
CVS Tags: RELEASE_20000124, RELEASE_1_1_2, ASIR2000
Changes since 1.1: +0 -0 lines 

Imported asir2000 as OpenXM_contrib2/asir2000.

/* $OpenXM: OpenXM_contrib2/asir2000/builtin/reduct.c,v 1.1.1.1 1999/12/03 07:39:07 noro Exp $ */
#include "ca.h"
#include "parse.h"

void Pred(), Predc(), Pprim();

struct ftab reduct_tab[] = {
	{"red",Pred,1},
	{"redc",Predc,2},
	{"prim",Pprim,-2},
	{0,0,0},
};

void Pred(arg,rp)
NODE arg;
Obj *rp;
{
	asir_assert(ARG0(arg),O_R,"red");
	reductr(CO,(Obj)ARG0(arg),rp);
}

void Predc(arg,rp)
NODE arg;
P *rp;
{
	asir_assert(ARG0(arg),O_P,"redc");
	asir_assert(ARG1(arg),O_P,"redc");
	remsdcp(CO,(P)ARG0(arg),(P)ARG1(arg),rp);
}

void Pprim(arg,rp)
NODE arg;
P *rp;
{
	P t,p,p1,r;
	V v;
	VL vl;

	asir_assert(ARG0(arg),O_P,"prim");
	p = (P)ARG0(arg);
	if ( NUM(p) )
		*rp = (P)ONE;
	else {
		if ( argc(arg) == 2 ) {
			v = VR((P)ARG1(arg));
			change_mvar(CO,p,v,&p1);
			if ( VR(p1) != v ) {
				*rp = (P)ONE; return;
			} else {
				reordvar(CO,v,&vl); pcp(vl,p1,&r,&t);
				restore_mvar(CO,r,v,rp);
			}
		} else
			pcp(CO,p,rp,&t);
	}
}