Annotation of OpenXM_contrib2/asir2018/builtin/user.c, Revision 1.1
1.1 ! noro 1: /* $OpenXM$ */
! 2:
! 3: /* a sample file for adding builtin functions */
! 4:
! 5: #include "ca.h"
! 6: #include "parse.h"
! 7:
! 8: void Ppartial_derivative();
! 9: void partial_derivative(VL vl,P p,V v,P *r);
! 10: void Pzadd(),Pzsub(),Pzmul();
! 11: void Pcomp_f();
! 12:
! 13: struct ftab user_tab[] = {
! 14: /*
! 15: {"partial_derivative",Ppartial_derivative,2},
! 16: */
! 17: {"comp_f",Pcomp_f,2},
! 18: {0,0,0},
! 19: };
! 20:
! 21: /* compare two [[F,M],...] */
! 22:
! 23: void Pcomp_f(NODE arg,Z *rp)
! 24: {
! 25: NODE l1,l2,e1,e2;
! 26: int m1,m2,r;
! 27:
! 28: l1 = BDY((LIST)ARG0(arg));
! 29: l2 = BDY((LIST)ARG1(arg));
! 30: for ( ; l1 && l2; l1 = NEXT(l1), l2 = NEXT(l2) ) {
! 31: e1 = BDY((LIST)BDY(l1));
! 32: e2 = BDY((LIST)BDY(l2));
! 33: r = compp(CO,(P)ARG0(e1),(P)ARG0(e2));
! 34: if ( r ) { STOQ(r,*rp); return; }
! 35: m1 = QTOS((Q)ARG1(e1));
! 36: m2 = QTOS((Q)ARG1(e2));
! 37: r = m1>m2?1:(m1<m2?-1:0);
! 38: if ( r ) { STOQ(r,*rp); return; }
! 39: }
! 40: r = l1?1:(l2?-1:0);
! 41: STOQ(r,*rp);
! 42: }
! 43:
! 44: /*
! 45: void Ppartial_derivative(NODE arg,P *rp)
! 46: {
! 47: asir_assert(ARG0(arg),O_P,"partial_derivative");
! 48: asir_assert(ARG1(arg),O_P,"partial_derivative");
! 49: partial_derivative(CO,(P)ARG0(arg),((P)ARG1(arg))->v,rp);
! 50: }
! 51:
! 52: void partial_derivative(VL vl,P p,V v,P *r)
! 53: {
! 54: P t;
! 55: DCP dc,dcr,dcr0;
! 56:
! 57: if ( !p || NUM(p) ) *r = 0;
! 58: else if ( v == p->v ) {
! 59: for ( dc = p->dc, dcr0 = 0; dc && dc->d; dc = dc->next ) {
! 60: mulp(vl,dc->c,(P)dc->d,&t);
! 61: if ( t ) {
! 62: NEXTDC(dcr0,dcr); subq(dc->d,ONE,&dcr->d); dcr->c = t;
! 63: }
! 64: }
! 65: if ( !dcr0 ) *r = 0;
! 66: else { dcr->next = 0; MKP(v,dcr0,*r); }
! 67: } else {
! 68: for ( dc = p->dc, dcr0 = 0; dc; dc = dc->next ) {
! 69: partial_derivative(vl,dc->c,v,&t);
! 70: if ( t ) { NEXTDC(dcr0,dcr); dcr->d = dc->d; dcr->c = t; }
! 71: }
! 72: if ( !dcr0 ) *r = 0;
! 73: else { dcr->next = 0; MKP(p->v,dcr0,*r); }
! 74: }
! 75: }
! 76: */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>