Return to rat.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/rat.c, Revision 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: }