Annotation of OpenXM_contrib2/asir2000/builtin/user.c, Revision 1.2
1.2 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/user.c,v 1.1 2002/08/14 03:51:38 noro Exp $ */
1.1 noro 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);
1.2 ! noro 10: void Pzadd(),Pzsub(),Pzmul();
1.1 noro 11:
12: struct ftab user_tab[] = {
13: /*
14: {"partial_derivative",Ppartial_derivative,2},
15: */
1.2 ! noro 16: {"zadd",Pzadd,2},
! 17: {"zsub",Pzsub,2},
! 18: {"zmul",Pzmul,2},
1.1 noro 19: {0,0,0},
20: };
1.2 ! noro 21:
! 22: pointer qtoz(Q);
! 23: Q ztoq(pointer);
! 24: pointer addz(pointer,pointer), subz(pointer,pointer), mulz(pointer,pointer);
! 25: void Pzadd(NODE arg,Q *rp)
! 26: {
! 27: pointer z0,z1,z2;
! 28:
! 29: z0 = qtoz((Q)ARG0(arg));
! 30: z1 = qtoz((Q)ARG1(arg));
! 31: z2 = addz(z0,z1);
! 32: printz(z2); printf(" ");
! 33: *rp = ztoq(z2);
! 34: }
! 35:
! 36: void Pzsub(NODE arg,Q *rp)
! 37: {
! 38: pointer z0,z1,z2;
! 39:
! 40: z0 = qtoz((Q)ARG0(arg));
! 41: z1 = qtoz((Q)ARG1(arg));
! 42: z2 = subz(z0,z1);
! 43: printz(z2); printf(" ");
! 44: *rp = ztoq(z2);
! 45: }
! 46:
! 47: void Pzmul(NODE arg,Q *rp)
! 48: {
! 49: pointer z0,z1,z2;
! 50:
! 51: z0 = qtoz((Q)ARG0(arg));
! 52: z1 = qtoz((Q)ARG1(arg));
! 53: z2 = mulz(z0,z1);
! 54: printz(z2); printf(" ");
! 55: *rp = ztoq(z2);
! 56: }
1.1 noro 57:
58: /*
59: void Ppartial_derivative(NODE arg,P *rp)
60: {
61: asir_assert(ARG0(arg),O_P,"partial_derivative");
62: asir_assert(ARG1(arg),O_P,"partial_derivative");
63: partial_derivative(CO,(P)ARG0(arg),((P)ARG1(arg))->v,rp);
64: }
65:
66: void partial_derivative(VL vl,P p,V v,P *r)
67: {
68: P t;
69: DCP dc,dcr,dcr0;
70:
71: if ( !p || NUM(p) ) *r = 0;
72: else if ( v == p->v ) {
73: for ( dc = p->dc, dcr0 = 0; dc && dc->d; dc = dc->next ) {
74: mulp(vl,dc->c,(P)dc->d,&t);
75: if ( t ) {
76: NEXTDC(dcr0,dcr); subq(dc->d,ONE,&dcr->d); dcr->c = t;
77: }
78: }
79: if ( !dcr0 ) *r = 0;
80: else { dcr->next = 0; MKP(v,dcr0,*r); }
81: } else {
82: for ( dc = p->dc, dcr0 = 0; dc; dc = dc->next ) {
83: partial_derivative(vl,dc->c,v,&t);
84: if ( t ) { NEXTDC(dcr0,dcr); dcr->d = dc->d; dcr->c = t; }
85: }
86: if ( !dcr0 ) *r = 0;
87: else { dcr->next = 0; MKP(p->v,dcr0,*r); }
88: }
89: }
90: */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>