[BACK]Return to pf.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/pf.c, Revision 1.7

1.2       noro        1: /*
                      2:  * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
                      3:  * All rights reserved.
                      4:  *
                      5:  * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
                      6:  * non-exclusive and royalty-free license to use, copy, modify and
                      7:  * redistribute, solely for non-commercial and non-profit purposes, the
                      8:  * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
                      9:  * conditions of this Agreement. For the avoidance of doubt, you acquire
                     10:  * only a limited right to use the SOFTWARE hereunder, and FLL or any
                     11:  * third party developer retains all rights, including but not limited to
                     12:  * copyrights, in and to the SOFTWARE.
                     13:  *
                     14:  * (1) FLL does not grant you a license in any way for commercial
                     15:  * purposes. You may use the SOFTWARE only for non-commercial and
                     16:  * non-profit purposes only, such as academic, research and internal
                     17:  * business use.
                     18:  * (2) The SOFTWARE is protected by the Copyright Law of Japan and
                     19:  * international copyright treaties. If you make copies of the SOFTWARE,
                     20:  * with or without modification, as permitted hereunder, you shall affix
                     21:  * to all such copies of the SOFTWARE the above copyright notice.
                     22:  * (3) An explicit reference to this SOFTWARE and its copyright owner
                     23:  * shall be made on your publication or presentation in any form of the
                     24:  * results obtained by use of the SOFTWARE.
                     25:  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.3       noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.2       noro       27:  * for such modification or the source code of the modified part of the
                     28:  * SOFTWARE.
                     29:  *
                     30:  * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
                     31:  * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
                     32:  * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
                     33:  * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
                     34:  * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
                     35:  * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
                     36:  * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
                     37:  * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
                     38:  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
                     39:  * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
                     40:  * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
                     41:  * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
                     42:  * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
                     43:  * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
                     44:  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
                     45:  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
                     46:  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
                     47:  *
1.7     ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.6 2003/02/14 22:29:07 ohara Exp $
1.2       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "math.h"
                     52: #include "parse.h"
                     53: #if 0
                     54: #include <alloca.h>
                     55: #endif
                     56:
                     57: double const_pi(),const_e();
                     58:
                     59: void make_ihyp(void);
                     60: void make_hyp(void);
                     61: void make_itri(void);
                     62: void make_tri(void);
                     63: void make_exp(void);
                     64: void simplify_pow(PFINS,Obj *);
                     65:
                     66: void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval();
                     67: void Pregister_handler();
1.4       noro       68: void Peval_quote();
1.7     ! noro       69: void Pmapat();
1.1       noro       70:
                     71: struct ftab puref_tab[] = {
1.7     ! noro       72:        {"mapat",Pmapat,-99999999},
1.1       noro       73:        {"functor",Pfunctor,1},
                     74:        {"args",Pargs,1},
                     75:        {"funargs",Pfunargs,1},
                     76:        {"register_handler",Pregister_handler,1},
                     77:        {"call",Pcall,2},
                     78:        {"vtype",Pvtype,1},
                     79:        {"deval",Pdeval,1},
1.4       noro       80:        {"eval_quote",Peval_quote,1},
1.1       noro       81:        {0,0,0},
                     82: };
                     83:
1.6       ohara      84: #if defined(PARI)
1.1       noro       85: int p_pi(),p_e();
                     86: int p_log(),p_exp(),p_pow();
                     87: int p_sin(),p_cos(),p_tan(),p_asin(),p_acos(),p_atan();
                     88: int p_sinh(),p_cosh(),p_tanh(),p_asinh(),p_acosh(),p_atanh();
                     89: #else
                     90: int p_pi,p_e;
                     91: int p_log,p_exp,p_pow;
                     92: int p_sin,p_cos,p_tan,p_asin,p_acos,p_atan;
                     93: int p_sinh,p_cosh,p_tanh,p_asinh,p_acosh,p_atanh;
                     94: #endif
                     95:
                     96: static V *uarg,*darg;
                     97: static P x,y;
                     98: static PF pidef,edef;
                     99: static PF logdef,expdef,powdef;
                    100: static PF sindef,cosdef,tandef;
                    101: static PF asindef,acosdef,atandef;
                    102: static PF sinhdef,coshdef,tanhdef;
                    103: static PF asinhdef,acoshdef,atanhdef;
                    104:
                    105: #define OALLOC(p,n) ((p)=(Obj *)CALLOC((n),sizeof(Obj)))
                    106:
                    107: double const_pi() { return 3.14159265358979323846264338327950288; }
                    108: double const_e() { return 2.718281828459045235360287471352662497; }
                    109:
                    110: void pf_init() {
                    111:        uarg = (V *)CALLOC(1,sizeof(V));
                    112:        uarg[0] = &oVAR[26]; MKV(uarg[0],x);
                    113:
                    114:        darg = (V *)CALLOC(2,sizeof(V));
                    115:        darg[0] = &oVAR[26];
                    116:        darg[1] = &oVAR[27]; MKV(darg[1],y);
                    117:
                    118:        mkpf("@pi",0,0,0,(int (*)())p_pi,const_pi,0,&pidef);
                    119:        mkpf("@e",0,0,0,(int (*)())p_e,const_e,0,&edef);
                    120:
                    121:        mkpf("log",0,1,uarg,(int (*)())p_log,log,0,&logdef);
                    122:        mkpf("exp",0,1,uarg,(int (*)())p_exp,exp,0,&expdef);
                    123:        mkpf("pow",0,2,darg,(int (*)())p_pow,pow,(int (*)())simplify_pow,&powdef);
                    124:
                    125:        mkpf("sin",0,1,uarg,(int (*)())p_sin,sin,0,&sindef);
                    126:        mkpf("cos",0,1,uarg,(int (*)())p_cos,cos,0,&cosdef);
                    127:        mkpf("tan",0,1,uarg,(int (*)())p_tan,tan,0,&tandef);
                    128:        mkpf("asin",0,1,uarg,(int (*)())p_asin,asin,0,&asindef);
                    129:        mkpf("acos",0,1,uarg,(int (*)())p_acos,acos,0,&acosdef);
                    130:        mkpf("atan",0,1,uarg,(int (*)())p_atan,atan,0,&atandef);
                    131:
                    132:        mkpf("sinh",0,1,uarg,(int (*)())p_sinh,sinh,0,&sinhdef);
                    133:        mkpf("cosh",0,1,uarg,(int (*)())p_cosh,cosh,0,&coshdef);
                    134:        mkpf("tanh",0,1,uarg,(int (*)())p_tanh,tanh,0,&tanhdef);
                    135: #if !defined(VISUAL)
                    136:        mkpf("asinh",0,1,uarg,(int (*)())p_asinh,asinh,0,&asinhdef);
                    137:        mkpf("acosh",0,1,uarg,(int (*)())p_acosh,acosh,0,&acoshdef);
                    138:        mkpf("atanh",0,1,uarg,(int (*)())p_atanh,atanh,0,&atanhdef);
                    139: #endif
                    140:        make_exp();
                    141:        make_tri();
                    142:        make_itri();
                    143:        make_hyp();
                    144: #if !defined(VISUAL)
                    145:        make_ihyp();
                    146: #endif
                    147: }
                    148:
                    149: void make_exp() {
                    150:        V v;
                    151:        P u,vexp,vlog,vpow;
                    152:        Obj *args;
                    153:
                    154:        mkpfins(expdef,uarg,&v); MKV(v,vexp);
                    155:        mkpfins(powdef,darg,&v); MKV(v,vpow);
                    156:        mkpfins(logdef,uarg,&v); MKV(v,vlog);
                    157:
                    158:        /* d/dx(log(x)) = 1/x */
                    159:        OALLOC(logdef->deriv,1); divr(CO,(Obj)ONE,(Obj)x,&logdef->deriv[0]);
                    160:
                    161:        /* d/dx(exp(x)) = exp(x) */
                    162:        OALLOC(expdef->deriv,1); expdef->deriv[0] = (Obj)vexp;
                    163:
                    164:        /* d/dy(x^y) = log(x)*x^y */
                    165:        OALLOC(powdef->deriv,2); mulp(CO,vpow,vlog,(P *)&powdef->deriv[1]);
                    166:
                    167:        /* d/dx(x^y) = y*x^(y-1) */
                    168:        args = (Obj *)ALLOCA(2*sizeof(Obj));
                    169:        args[0] = (Obj)x; subp(CO,y,(P)ONE,(P *)&args[1]);
                    170:        _mkpfins(powdef,args,&v); MKV(v,u);
                    171:        mulr(CO,(Obj)u,(Obj)y,&powdef->deriv[0]);
                    172: }
                    173:
                    174: void make_tri() {
                    175:        V v;
                    176:        P vcos,vsin,vtan,t;
                    177:
                    178:        mkpfins(cosdef,uarg,&v); MKV(v,vcos);
                    179:        mkpfins(sindef,uarg,&v); MKV(v,vsin);
                    180:        mkpfins(tandef,uarg,&v); MKV(v,vtan);
                    181:
                    182:        /* d/dx(sin(x)) = cos(x) */
                    183:        OALLOC(sindef->deriv,1); sindef->deriv[0] = (Obj)vcos;
                    184:
                    185:        /* d/dx(cos(x)) = -sin(x) */
                    186:        OALLOC(cosdef->deriv,1); chsgnp(vsin,(P *)&cosdef->deriv[0]);
                    187:
                    188:        /* d/dx(tan(x)) = 1+tan(x)^2 */
                    189:        OALLOC(tandef->deriv,1);
                    190:        mulr(CO,(Obj)vtan,(Obj)vtan,(Obj *)&t); addp(CO,(P)ONE,t,(P *)&tandef->deriv[0]);
                    191: }
                    192:
                    193: void make_itri() {
                    194:        P t,xx;
                    195:        Q mtwo;
                    196:        V v;
                    197:        Obj *args;
                    198:
                    199:        /* d/dx(asin(x)) = (1-x^2)^(-1/2) */
                    200:        OALLOC(asindef->deriv,1);
                    201:        args = (Obj *)ALLOCA(2*sizeof(Obj));
                    202:        mulp(CO,x,x,&xx); subp(CO,(P)ONE,xx,(P *)&args[0]);
                    203:        STOQ(-2,mtwo); divq(ONE,mtwo,(Q *)&args[1]);
                    204:        _mkpfins(powdef,args,&v); MKV(v,t);
                    205:        asindef->deriv[0] = (Obj)t;
                    206:
                    207:        /* d/dx(acos(x)) = -(1-x^2)^(-1/2) */
                    208:        OALLOC(acosdef->deriv,1); chsgnp((P)asindef->deriv[0],(P *)&acosdef->deriv[0]);
                    209:
                    210:        /* d/dx(atan(x)) = 1/(x^2+1) */
                    211:        OALLOC(atandef->deriv,1);
                    212:        addp(CO,(P)ONE,xx,&t); divr(CO,(Obj)ONE,(Obj)t,&atandef->deriv[0]);
                    213: }
                    214:
                    215: void make_hyp() {
                    216:        V v;
                    217:        P vcosh,vsinh,vtanh,t;
                    218:
                    219:        mkpfins(coshdef,uarg,&v); MKV(v,vcosh);
                    220:        mkpfins(sinhdef,uarg,&v); MKV(v,vsinh);
                    221:        mkpfins(tanhdef,uarg,&v); MKV(v,vtanh);
                    222:
                    223:        /* d/dx(sinh(x)) = cosh(x) */
                    224:        OALLOC(sinhdef->deriv,1); sinhdef->deriv[0] = (Obj)vcosh;
                    225:
                    226:        /* d/dx(cosh(x)) = sinh(x) */
                    227:        OALLOC(coshdef->deriv,1); coshdef->deriv[0] = (Obj)vsinh;
                    228:
                    229:        /* d/dx(tanh(x)) = 1-tanh(x)^2 */
                    230:        OALLOC(tanhdef->deriv,1);
                    231:        mulr(CO,(Obj)vtanh,(Obj)vtanh,(Obj *)&t); subp(CO,(P)ONE,t,(P *)&tanhdef->deriv[0]);
                    232: }
                    233:
                    234: void make_ihyp() {
                    235:        P t,xx;
                    236:        Q mtwo;
                    237:        V v;
                    238:        Obj *args;
                    239:
                    240:        /* d/dx(asinh(x)) = (1+x^2)^(-1/2) */
                    241:        OALLOC(asinhdef->deriv,1);
                    242:        args = (Obj *)ALLOCA(2*sizeof(Obj));
                    243:        mulp(CO,x,x,&xx); addp(CO,(P)ONE,xx,(P *)&args[0]);
                    244:        STOQ(-2,mtwo); divq(ONE,mtwo,(Q *)&args[1]);
                    245:        _mkpfins(powdef,args,&v); MKV(v,t);
                    246:        asinhdef->deriv[0] = (Obj)t;
                    247:
                    248:        /* d/dx(acosh(x)) = (x^2-1)^(-1/2) */
                    249:        OALLOC(acoshdef->deriv,1);
                    250:        subp(CO,xx,(P)ONE,(P *)&args[0]);
                    251:        _mkpfins(powdef,args,&v); MKV(v,t);
                    252:        acoshdef->deriv[0] = (Obj)t;
                    253:
                    254:        /* d/dx(atanh(x)) = 1/(1-x^2) */
                    255:        OALLOC(atanhdef->deriv,1);
                    256:        subp(CO,(P)ONE,xx,&t); divr(CO,(Obj)ONE,(Obj)t,&atanhdef->deriv[0]);
                    257: }
                    258:
                    259: void mkpow(vl,a,e,r)
                    260: VL vl;
                    261: Obj a;
                    262: Obj e;
                    263: Obj *r;
                    264: {
                    265:        PFINS ins;
                    266:        PFAD ad;
                    267:
                    268:        ins = (PFINS)CALLOC(1,sizeof(PF)+2*sizeof(struct oPFAD));
                    269:        ins->pf = powdef; ad = ins->ad;
                    270:        ad[0].d = 0; ad[0].arg = a; ad[1].d = 0; ad[1].arg = e;
                    271:        simplify_ins(ins,r);
                    272: }
                    273:
                    274: void simplify_pow(ins,rp)
                    275: PFINS ins;
                    276: Obj *rp;
                    277: {
                    278:        PF pf;
                    279:        PFAD ad;
                    280:        Obj a0,a1;
                    281:        V v;
                    282:        P t;
                    283:
                    284:        pf = ins->pf; ad = ins->ad; a0 = ad[0].arg; a1 = ad[1].arg;
                    285:        if ( !a1 )
                    286:                *rp = (Obj)ONE;
                    287:        else if ( !a0 )
                    288:                *rp = 0;
                    289:        else if ( NUM(a1) && INT(a1) )
                    290:                arf_pwr(CO,a0,a1,rp);
                    291:        else {
                    292:                instov(ins,&v); MKV(v,t); *rp = (Obj)t;
                    293:        }
                    294: }
                    295:
                    296: #define ISPFINS(p)\
                    297: (p)&&(ID(p) == O_P)&&((int)VR((P)p)->attr!=V_PF)&&\
                    298: UNIQ(DEG(DC((P)p)))&&UNIQ(COEF(DC((P)p)))
                    299:
                    300: void Pfunctor(arg,rp)
                    301: NODE arg;
                    302: P *rp;
                    303: {
                    304:        P p;
                    305:        FUNC t;
                    306:        PF pf;
                    307:        PFINS ins;
                    308:
                    309:        p = (P)ARG0(arg);
                    310:        if ( !ISPFINS(p) )
                    311:                *rp = 0;
                    312:        else {
                    313:                ins = (PFINS)VR(p)->priv; pf = ins->pf;
                    314:                t = (FUNC)MALLOC(sizeof(struct oFUNC));
1.7     ! noro      315:                t->name = t->fullname = pf->name; t->id = A_PURE; t->argc = pf->argc;
1.1       noro      316:                t->f.puref = pf;
                    317:                makesrvar(t,rp);
                    318:        }
                    319: }
                    320:
                    321: void Pargs(arg,rp)
                    322: NODE arg;
                    323: LIST *rp;
                    324: {
                    325:        P p;
                    326:        PF pf;
                    327:        PFAD ad;
                    328:        PFINS ins;
                    329:        NODE n,n0;
                    330:        int i;
                    331:
                    332:        p = (P)ARG0(arg);
                    333:        if ( !ISPFINS(p) )
                    334:                *rp = 0;
                    335:        else {
                    336:                ins = (PFINS)VR(p)->priv; ad = ins->ad; pf = ins->pf;
                    337:                for ( i = 0, n0 = 0; i < pf->argc; i++ ) {
                    338:                        NEXTNODE(n0,n); BDY(n) = (pointer)ad[i].arg;
                    339:                }
                    340:                if ( n0 )
                    341:                        NEXT(n) = 0;
                    342:                MKLIST(*rp,n0);
                    343:        }
                    344: }
                    345:
                    346: void Pfunargs(arg,rp)
                    347: NODE arg;
                    348: LIST *rp;
                    349: {
                    350:        P p;
                    351:        P f;
                    352:        FUNC t;
                    353:        PF pf;
                    354:        PFINS ins;
                    355:        PFAD ad;
                    356:        NODE n,n0;
                    357:        int i;
                    358:
                    359:        p = (P)ARG0(arg);
                    360:        if ( !ISPFINS(p) )
                    361:                *rp = 0;
                    362:        else {
                    363:                ins = (PFINS)VR(p)->priv; ad = ins->ad; pf = ins->pf;
                    364:                t = (FUNC)MALLOC(sizeof(struct oFUNC));
1.7     ! noro      365:                t->name = t->fullname = pf->name; t->id = A_PURE; t->argc = pf->argc;
1.1       noro      366:                t->f.puref = pf;
                    367:                makesrvar(t,&f);
1.5       noro      368:                n = n0 = 0; NEXTNODE(n0,n); BDY(n) = (pointer)f;
1.1       noro      369:                for ( i = 0; i < pf->argc; i++ ) {
                    370:                        NEXTNODE(n0,n); BDY(n) = (pointer)ad[i].arg;
                    371:                }
                    372:                NEXT(n) = 0;
                    373:                MKLIST(*rp,n0);
                    374:        }
                    375: }
                    376:
                    377: void Pvtype(arg,rp)
                    378: NODE arg;
                    379: Q *rp;
                    380: {
                    381:        P p;
                    382:
                    383:        p = (P)ARG0(arg);
                    384:        if ( !p || ID(p) != O_P )
                    385:                *rp = 0;
                    386:        else
                    387:                STOQ((int)VR(p)->attr,*rp);
                    388: }
                    389:
                    390: extern FUNC registered_handler;
                    391:
                    392: void Pregister_handler(arg,rp)
                    393: NODE arg;
                    394: Q *rp;
                    395: {
                    396:        P p;
                    397:        V v;
                    398:        FUNC func;
                    399:
                    400:        p = (P)ARG0(arg);
                    401:        if ( !p )
                    402:                registered_handler = 0;
                    403:        else if ( OID(p) != 2 )
                    404:                error("register_hanlder : invalid argument");
                    405:        v = VR(p);
                    406:        if ( (int)v->attr != V_SR )
                    407:                error("register_hanlder : no such function");
                    408:        else {
                    409:                func = (FUNC)v->priv;
                    410:                if ( func->argc )
                    411:                        error("register_hanlder : the function must be with no argument");
                    412:                else {
                    413:                        registered_handler = func;
                    414:                        *rp = ONE;
                    415:                }
                    416:        }
                    417: }
                    418:
1.7     ! noro      419: void Pcall(NODE arg,Obj *rp)
1.1       noro      420: {
                    421:        P p;
                    422:        V v;
                    423:
                    424:        p = (P)ARG0(arg);
                    425:        if ( !p || OID(p) != 2 )
                    426:                error("call : invalid argument");
                    427:        v = VR(p);
                    428:        if ( (int)v->attr != V_SR )
                    429:                error("call : no such function");
                    430:
                    431:        else
                    432:                *rp = (Obj)bevalf((FUNC)v->priv,BDY((LIST)ARG1(arg)));
1.7     ! noro      433: }
        !           434:
        !           435: /* at=position of arg to be used for iteration */
        !           436:
        !           437: void Pmapat(NODE arg,Obj *rp)
        !           438: {
        !           439:        LIST args;
        !           440:        NODE node,rest,t0,t,n,r,r0;
        !           441:        P fpoly;
        !           442:        V fvar;
        !           443:        FUNC f;
        !           444:        VECT v,rv;
        !           445:        MAT m,rm;
        !           446:        LIST rl;
        !           447:        int len,row,col,i,j,pos;
        !           448:        Obj iter;
        !           449:        pointer val;
        !           450:
        !           451:        if ( argc(arg) < 3 )
        !           452:                error("mapat : too few arguments");
        !           453:
        !           454:        fpoly = (P)ARG0(arg);
        !           455:        if ( !fpoly || OID(fpoly) != O_P )
        !           456:                error("mapat : invalid function specification");
        !           457:        fvar = VR(fpoly);
        !           458:        if ( fvar->attr != (pointer)V_SR || !(f=(FUNC)fvar->priv) )
        !           459:                error("mapat : invalid function specification");
        !           460:        if ( !INT(ARG1(arg)) )
        !           461:                error("mapat : invalid position");
        !           462:        pos = QTOS((Q)ARG1(arg));
        !           463:        node = NEXT(NEXT(arg));
        !           464:        len = length(node);
        !           465:        if ( pos >= len )
        !           466:                error("evalmapatf : invalid position");
        !           467:        r0 = 0;
        !           468:        for ( i = 0, t = node; i < pos; i++, t = NEXT(t) ) {
        !           469:                NEXTNODE(r0,r);
        !           470:                BDY(r) = BDY(t);
        !           471:        }
        !           472:        NEXTNODE(r0,r);
        !           473:        iter = BDY(t); rest = NEXT(t);
        !           474:        if ( !iter ) {
        !           475:                *rp = bevalf(f,node);
        !           476:                return;
        !           477:        }
        !           478:        switch ( OID(iter) ) {
        !           479:                case O_VECT:
        !           480:                        v = (VECT)iter; len = v->len; MKVECT(rv,len);
        !           481:                        for ( i = 0; i < len; i++ ) {
        !           482:                                BDY(r) = BDY(v)[i]; NEXT(r) = rest;
        !           483:                                BDY(rv)[i] = bevalf(f,r0);
        !           484:                        }
        !           485:                        *rp = (Obj)rv;
        !           486:                        break;
        !           487:                case O_MAT:
        !           488:                        m = (MAT)iter; row = m->row; col = m->col; MKMAT(rm,row,col);
        !           489:                        for ( i = 0; i < row; i++ )
        !           490:                                for ( j = 0; j < col; j++ ) {
        !           491:                                        BDY(r) = BDY(m)[i][j]; NEXT(r) = rest;
        !           492:                                        BDY(rm)[i][j] = bevalf(f,r0);
        !           493:                                }
        !           494:                        *rp = (Obj)rm;
        !           495:                        break;
        !           496:                case O_LIST:
        !           497:                        n = BDY((LIST)iter);
        !           498:                        for ( t0 = t = 0; n; n = NEXT(n) ) {
        !           499:                                BDY(r) = BDY(n); NEXT(r) = rest;
        !           500:                                NEXTNODE(t0,t); BDY(t) = bevalf(f,r0);
        !           501:                        }
        !           502:                        if ( t0 )
        !           503:                                NEXT(t) = 0;
        !           504:                        MKLIST(rl,t0);
        !           505:                        *rp = (Obj)rl;
        !           506:                        break;
        !           507:                default:
        !           508:                        *rp = bevalf(f,node);
        !           509:                        break;
        !           510:        }
1.1       noro      511: }
                    512:
                    513: void Pdeval(arg,rp)
                    514: NODE arg;
                    515: Obj *rp;
                    516: {
                    517:        asir_assert(ARG0(arg),O_R,"deval");
                    518:        devalr(CO,(Obj)ARG0(arg),rp);
                    519: }
                    520:
1.4       noro      521: void Peval_quote(arg,rp)
                    522: NODE arg;
                    523: Obj *rp;
                    524: {
                    525:        asir_assert(ARG0(arg),O_QUOTE,"eval_quote");
                    526:        *rp = eval((FNODE)BDY((QUOTE)ARG0(arg)));
                    527: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>