OpenXM_contrib2/asir2000/builtin/pf.c - diff

Return to pf.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/pf.c between version 1.4 and 1.7

version 1.4, 2001/04/20 02:34:21

version 1.7, 2004/06/22 09:17:21

Line 45

* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,

* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.

* $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.3 2000/08/22 05:03:59 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.6 2003/02/14 22:29:07 ohara Exp $

#include "ca.h"

#include "math.h"

Line 66 void simplify_pow(PFINS,Obj *);

void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval();

void Pregister_handler();

void Peval_quote();

void Pmapat();

struct ftab puref_tab[] = {

{"mapat",Pmapat,-99999999},

{"functor",Pfunctor,1},

{"args",Pargs,1},

{"funargs",Pfunargs,1},

Line 79 struct ftab puref_tab[] = {

Line 81 struct ftab puref_tab[] = {

{0,0,0},

};

#if PARI

#if defined(PARI)

int p_pi(),p_e();

int p_log(),p_exp(),p_pow();

int p_sin(),p_cos(),p_tan(),p_asin(),p_acos(),p_atan();

Line 310 P *rp;

Line 312 P *rp;

else {

ins = (PFINS)VR(p)->priv; pf = ins->pf;

t = (FUNC)MALLOC(sizeof(struct oFUNC));

t->name = pf->name; t->id = A_PURE; t->argc = pf->argc;

t->name = t->fullname = pf->name; t->id = A_PURE; t->argc = pf->argc;

t->f.puref = pf;

makesrvar(t,rp);

}

Line 360 LIST *rp;

Line 362 LIST *rp;

else {

ins = (PFINS)VR(p)->priv; ad = ins->ad; pf = ins->pf;

t = (FUNC)MALLOC(sizeof(struct oFUNC));

t->name = pf->name; t->id = A_PURE; t->argc = pf->argc;

t->name = t->fullname = pf->name; t->id = A_PURE; t->argc = pf->argc;

t->f.puref = pf;

makesrvar(t,&f);

n0 = 0; NEXTNODE(n0,n); BDY(n) = (pointer)f;

n = n0 = 0; NEXTNODE(n0,n); BDY(n) = (pointer)f;

for ( i = 0; i < pf->argc; i++ ) {

NEXTNODE(n0,n); BDY(n) = (pointer)ad[i].arg;

}

Line 414 Q *rp;

Line 416 Q *rp;

}

void Pcall(arg,rp)

void Pcall(NODE arg,Obj *rp)

NODE arg;

Obj *rp;

{

P p;

V v;

Line 430 Obj *rp;

else

*rp = (Obj)bevalf((FUNC)v->priv,BDY((LIST)ARG1(arg)));

}

/* at=position of arg to be used for iteration */

void Pmapat(NODE arg,Obj *rp)

{

LIST args;

NODE node,rest,t0,t,n,r,r0;

P fpoly;

V fvar;

FUNC f;

VECT v,rv;

MAT m,rm;

LIST rl;

int len,row,col,i,j,pos;

Obj iter;

pointer val;

if ( argc(arg) < 3 )

error("mapat : too few arguments");

fpoly = (P)ARG0(arg);

if ( !fpoly || OID(fpoly) != O_P )

error("mapat : invalid function specification");

fvar = VR(fpoly);

if ( fvar->attr != (pointer)V_SR || !(f=(FUNC)fvar->priv) )

error("mapat : invalid function specification");

if ( !INT(ARG1(arg)) )

error("mapat : invalid position");

pos = QTOS((Q)ARG1(arg));

node = NEXT(NEXT(arg));

len = length(node);

if ( pos >= len )

error("evalmapatf : invalid position");

r0 = 0;

for ( i = 0, t = node; i < pos; i++, t = NEXT(t) ) {

NEXTNODE(r0,r);

BDY(r) = BDY(t);

}

NEXTNODE(r0,r);

iter = BDY(t); rest = NEXT(t);

if ( !iter ) {

*rp = bevalf(f,node);

return;

}

switch ( OID(iter) ) {

case O_VECT:

v = (VECT)iter; len = v->len; MKVECT(rv,len);

for ( i = 0; i < len; i++ ) {

BDY(r) = BDY(v)[i]; NEXT(r) = rest;

BDY(rv)[i] = bevalf(f,r0);

}

*rp = (Obj)rv;

break;

case O_MAT:

m = (MAT)iter; row = m->row; col = m->col; MKMAT(rm,row,col);

for ( i = 0; i < row; i++ )

for ( j = 0; j < col; j++ ) {

BDY(r) = BDY(m)[i][j]; NEXT(r) = rest;

BDY(rm)[i][j] = bevalf(f,r0);

}

*rp = (Obj)rm;

break;

case O_LIST:

n = BDY((LIST)iter);

for ( t0 = t = 0; n; n = NEXT(n) ) {

BDY(r) = BDY(n); NEXT(r) = rest;

NEXTNODE(t0,t); BDY(t) = bevalf(f,r0);

}

if ( t0 )

NEXT(t) = 0;

MKLIST(rl,t0);

*rp = (Obj)rl;

break;

default:

*rp = bevalf(f,node);

break;

}

void Pdeval(arg,rp)

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>