Return to var.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/var.c, Revision 1.1

1.1     ! noro        1: /* $OpenXM: OpenXM/src/asir99/builtin/var.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 Pvar(), Pvars(), Puc(), Pvars_recursive();
        !             6: void get_vars(Obj,VL *);
        !             7: void get_vars_recursive(Obj,VL *);
        !             8:
        !             9: struct ftab var_tab[] = {
        !            10:        {"var",Pvar,1},
        !            11:        {"vars",Pvars,1},
        !            12:        {"vars_recursive",Pvars_recursive,1},
        !            13:        {"uc",Puc,0},
        !            14:        {0,0,0},
        !            15: };
        !            16:
        !            17: void Pvar(arg,rp)
        !            18: NODE arg;
        !            19: Obj *rp;
        !            20: {
        !            21:        Obj t;
        !            22:        P p;
        !            23:        V vn,vd,v;
        !            24:        VL vl;
        !            25:
        !            26:        if ( !(t = (Obj)ARG0(arg)) )
        !            27:                v = 0;
        !            28:        else
        !            29:                switch ( OID(t) ) {
        !            30:                        case O_P:
        !            31:                                v = VR((P)t); break;
        !            32:                        case O_R:
        !            33:                                vn = VR(NM((R)t)); vd = VR(DN((R)t));
        !            34:                                for ( vl = CO; (vl->v != vn) && (vl->v != vd); vl = NEXT(vl) );
        !            35:                                v = vl->v; break;
        !            36:                        default:
        !            37:                                v = 0; break;
        !            38:                }
        !            39:        if ( v ) {
        !            40:                MKV(v,p); *rp = (Obj)p;
        !            41:        } else
        !            42:                *rp = 0;
        !            43: }
        !            44:
        !            45: void Pvars(arg,rp)
        !            46: NODE arg;
        !            47: LIST *rp;
        !            48: {
        !            49:        VL vl;
        !            50:        NODE n,n0;
        !            51:        P p;
        !            52:
        !            53:        get_vars((Obj)ARG0(arg),&vl);
        !            54:        for ( n0 = 0; vl; vl = NEXT(vl) ) {
        !            55:                NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;
        !            56:        }
        !            57:        if ( n0 )
        !            58:                NEXT(n) = 0;
        !            59:        MKLIST(*rp,n0);
        !            60: }
        !            61:
        !            62: void Pvars_recursive(arg,rp)
        !            63: NODE arg;
        !            64: LIST *rp;
        !            65: {
        !            66:        VL vl;
        !            67:        NODE n,n0;
        !            68:        P p;
        !            69:
        !            70:        get_vars_recursive((Obj)ARG0(arg),&vl);
        !            71:        for ( n0 = 0; vl; vl = NEXT(vl) ) {
        !            72:                NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;
        !            73:        }
        !            74:        if ( n0 )
        !            75:                NEXT(n) = 0;
        !            76:        MKLIST(*rp,n0);
        !            77: }
        !            78:
        !            79: void get_vars_recursive(obj,vlp)
        !            80: Obj obj;
        !            81: VL *vlp;
        !            82: {
        !            83:        VL vl,vl0,vl1,vl2,t;
        !            84:        PFINS ins;
        !            85:        int argc,i;
        !            86:        PFAD ad;
        !            87:
        !            88:        get_vars(obj,&vl);
        !            89:        vl0 = 0;
        !            90:        for ( t = vl; t; t = NEXT(t) )
        !            91:                if ( t->v->attr == (pointer)V_PF ) {
        !            92:                        ins = (PFINS)t->v->priv;
        !            93:                        argc = ins->pf->argc;
        !            94:                        ad = ins->ad;
        !            95:                        for ( i = 0; i < argc; i++ ) {
        !            96:                                get_vars_recursive(ad[i].arg,&vl1);
        !            97:                                mergev(CO,vl0,vl1,&vl2); vl0 = vl2;
        !            98:                        }
        !            99:                }
        !           100:        mergev(CO,vl,vl0,vlp);
        !           101: }
        !           102:
        !           103: void get_vars(t,vlp)
        !           104: Obj t;
        !           105: VL *vlp;
        !           106: {
        !           107:        pointer *vb;
        !           108:        pointer **mb;
        !           109:        VL vl,vl1,vl2;
        !           110:        NODE n;
        !           111:        MP mp;
        !           112:        int i,j,row,col,len;
        !           113:
        !           114:        if ( !t )
        !           115:                vl = 0;
        !           116:        else
        !           117:                switch ( OID(t) ) {
        !           118:                        case O_P: case O_R:
        !           119:                                clctvr(CO,t,&vl); break;
        !           120:                        case O_VECT:
        !           121:                                len = ((VECT)t)->len; vb = BDY((VECT)t);
        !           122:                                for ( i = 0, vl = 0; i < len; i++ ) {
        !           123:                                        get_vars((Obj)vb[i],&vl1); mergev(CO,vl,vl1,&vl2);
        !           124:                                        vl = vl2;
        !           125:                                }
        !           126:                                break;
        !           127:                        case O_MAT:
        !           128:                                row = ((MAT)t)->row; col = ((MAT)t)->col; mb = BDY((MAT)t);
        !           129:                                for ( i = 0, vl = 0; i < row; i++ )
        !           130:                                        for ( j = 0; j < col; j++ ) {
        !           131:                                                get_vars((Obj)mb[i][j],&vl1); mergev(CO,vl,vl1,&vl2);
        !           132:                                                vl = vl2;
        !           133:                                        }
        !           134:                                break;
        !           135:                        case O_LIST:
        !           136:                                n = BDY((LIST)t);
        !           137:                                for ( vl = 0; n; n = NEXT(n) ) {
        !           138:                                        get_vars((Obj)BDY(n),&vl1); mergev(CO,vl,vl1,&vl2);
        !           139:                                        vl = vl2;
        !           140:                                }
        !           141:                                break;
        !           142:                        case O_DP:
        !           143:                                mp = ((DP)t)->body;
        !           144:                                for ( vl = 0; mp; mp = NEXT(mp) ) {
        !           145:                                        get_vars((Obj)mp->c,&vl1); mergev(CO,vl,vl1,&vl2);
        !           146:                                        vl = vl2;
        !           147:                                }
        !           148:                                break;
        !           149:                        default:
        !           150:                                vl = 0; break;
        !           151:                }
        !           152:        *vlp = vl;
        !           153: }
        !           154:
        !           155: void Puc(p)
        !           156: Obj *p;
        !           157: {
        !           158:        VL vl;
        !           159:        V v;
        !           160:        P t;
        !           161:        char buf[BUFSIZ];
        !           162:        static int UCN;
        !           163:
        !           164:        NEWV(v); v->attr = (pointer)V_UC;
        !           165:        sprintf(buf,"_%d",UCN++);
        !           166:        NAME(v) = (char *)CALLOC(strlen(buf)+1,sizeof(char));
        !           167:        strcpy(NAME(v),buf);
        !           168:        for ( vl = CO; NEXT(vl); vl = NEXT(vl) );
        !           169:        NEWVL(NEXT(vl)); VR(NEXT(vl)) = v; NEXT(NEXT(vl)) = 0;
        !           170:        MKV(v,t); *p = (Obj)t;
        !           171: }