![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to var.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin|
Return to var.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
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: }