Annotation of OpenXM_contrib2/asir2000/builtin/rat.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/rat.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
2: #include "ca.h"
3: #include "parse.h"
4:
5: void Pnm(), Pdn(), Pderiv();
6:
7: struct ftab rat_tab[] = {
8: {"nm",Pnm,1},
9: {"dn",Pdn,1},
10: {"diff",Pderiv,-99999999},
11: {0,0,0},
12: };
13:
14: void Pnm(arg,rp)
15: NODE arg;
16: Obj *rp;
17: {
18: Obj t;
19: Q q;
20:
21: asir_assert(ARG0(arg),O_R,"nm");
22: if ( !(t = (Obj)ARG0(arg)) )
23: *rp = 0;
24: else
25: switch ( OID(t) ) {
26: case O_N:
27: switch ( NID(t) ) {
28: case N_Q:
29: NTOQ(NM((Q)t),SGN((Q)t),q); *rp = (Obj)q; break;
30: default:
31: *rp = t; break;
32: }
33: break;
34: case O_P:
35: *rp = t; break;
36: case O_R:
37: *rp = (Obj)NM((R)t); break;
38: default:
39: *rp = 0;
40: }
41: }
42:
43: void Pdn(arg,rp)
44: NODE arg;
45: Obj *rp;
46: {
47: Obj t;
48: Q q;
49:
50: asir_assert(ARG0(arg),O_R,"dn");
51: if ( !(t = (Obj)ARG0(arg)) )
52: *rp = (Obj)ONE;
53: else
54: switch ( OID(t) ) {
55: case O_N:
56: switch ( NID(t) ) {
57: case N_Q:
58: if ( DN((Q)t) )
59: NTOQ(DN((Q)t),1,q);
60: else
61: q = ONE;
62: *rp = (Obj)q; break;
63: default:
64: *rp = (Obj)ONE; break;
65: }
66: break;
67: case O_P:
68: *rp = (Obj)ONE; break;
69: case O_R:
70: *rp = (Obj)DN((R)t); break;
71: default:
72: *rp = 0;
73: }
74: }
75:
76: void Pderiv(arg,rp)
77: NODE arg;
78: Obj *rp;
79: {
80: Obj a,t;
81: LIST l;
82: P v;
83: NODE n;
84:
85: if ( !arg ) {
86: *rp = 0; return;
87: }
88: asir_assert(ARG0(arg),O_R,"diff");
89: reductr(CO,(Obj)ARG0(arg),&a);
90: n = NEXT(arg);
91: if ( n && (l = (LIST)ARG0(n)) && OID(l) == O_LIST )
92: n = BDY(l);
93: for ( ; n; n = NEXT(n) ) {
94: if ( !(v = (P)BDY(n)) || OID(v) != O_P )
95: error("diff : invalid argument");
96: derivr(CO,a,VR(v),&t); a = t;
97: }
98: *rp = a;
99: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>