Return to user.c CVS log

Up to [local] / OpenXM_contrib2 / asir2018 / builtin

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: */