![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to subst.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 subst.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
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.8 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.7 2004/06/22 09:17:21 noro Exp $
1.2 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "parse.h"
52:
1.4 noro 53: void Psubst(), Ppsubst(), Psubstf(), Psubst_quote();
1.8 ! noro 54: void Psubstr2np();
1.1 noro 55:
56: struct ftab subst_tab[] = {
57: {"subst",Psubst,-99999999},
1.8 ! noro 58: {"substr2np",Psubstr2np,2},
1.4 noro 59: {"subst_quote",Psubst_quote,-99999999},
1.1 noro 60: {"psubst",Ppsubst,-99999999},
61: {"substf",Psubstf,-99999999},
62: {0,0,0},
63: };
64:
1.8 ! noro 65: extern Obj VOIDobj;
! 66:
! 67: void Psubstr2np(NODE arg,Obj *rp)
! 68: {
! 69: Obj a;
! 70: P nm,dn,p;
! 71: R r;
! 72: VL vl,tvl;
! 73: int nv,i;
! 74: NODE slist,t,ps;
! 75: P s;
! 76: P *svect;
! 77: V v;
! 78: V *vvect;
! 79:
! 80: a = (Obj)ARG0(arg);
! 81: if ( !a || NUM(a) ) {
! 82: *rp = a;
! 83: return;
! 84: }
! 85: asir_assert(ARG0(arg),O_R,"substr2np");
! 86: asir_assert(ARG1(arg),O_LIST,"substr2np");
! 87: get_vars(a,&vl);
! 88: for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ );
! 89: nv = i;
! 90: vvect = (V *)MALLOC(nv*sizeof(V));
! 91: for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ) vvect[i] = tvl->v;
! 92: svect = (P *)MALLOC(nv*sizeof(P));
! 93: slist = BDY((LIST)ARG1(arg));
! 94: for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj;
! 95: for ( t = slist; t; t = NEXT(t) ) {
! 96: ps = BDY((LIST)BDY(t)); p = (P)BDY(ps); s = (P)BDY(NEXT(ps));
! 97: asir_assert(p,O_P,"substr2np"); asir_assert(s,O_N,"substr2np");
! 98: v = VR(p);
! 99: for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break;
! 100: svect[i] = s;
! 101: }
! 102:
! 103: switch ( OID(a) ) {
! 104: case O_P:
! 105: substpp(vl,(P)a,vvect,svect,nv,&nm); *rp = (Obj)nm;
! 106: return;
! 107: case O_R:
! 108: substpp(vl,(P)NM((R)a),vvect,svect,nv,&nm);
! 109: substpp(vl,(P)DN((R)a),vvect,svect,nv,&dn);
! 110: if ( !dn )
! 111: error("substr2np: division by 0");
! 112: else if ( NUM(dn) ) {
! 113: divsp(vl,nm,dn,&p);
! 114: *rp = (Obj)p;
! 115: } else {
! 116: MKRAT(nm,dn,0,r);
! 117: *rp = (Obj)r;
! 118: }
! 119: return;
! 120: default:
! 121: error("substr2np: invalid argument");
! 122: }
! 123: }
! 124:
1.1 noro 125: void Psubst(arg,rp)
126: NODE arg;
127: Obj *rp;
128: {
129: Obj a,b,t;
130: LIST l;
131: V v;
1.6 noro 132: int row,col,len;
133: VECT vect;
134: MAT mat;
135: int i,j;
136: NODE n0,n,nd;
137: struct oNODE arg0;
138: MP m,mp,mp0;
139: DP d;
1.1 noro 140:
141: if ( !arg ) {
142: *rp = 0; return;
143: }
1.6 noro 144: a = (Obj)ARG0(arg);
145: if ( !a ) {
146: *rp = 0;
147: return;
148: }
149: switch ( OID(a) ) {
150: case O_N: case O_P: case O_R:
151: reductr(CO,(Obj)ARG0(arg),&a);
152: arg = NEXT(arg);
153: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
154: arg = BDY(l);
155: while ( arg ) {
1.7 noro 156: if ( !BDY(arg) || OID((Obj)BDY(arg)) != O_P )
157: error("subst : invalid argument");
1.6 noro 158: v = VR((P)BDY(arg)); arg = NEXT(arg);
159: if ( !arg )
160: error("subst : invalid argument");
161: asir_assert(ARG0(arg),O_R,"subst");
162: reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg);
163: /* b = (Obj)BDY(arg); arg = NEXT(arg); */
164: substr(CO,0,a,v,b,&t); a = t;
165: }
166: *rp = a;
167: break;
168: case O_LIST:
169: n0 = 0;
170: for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) {
171: NEXTNODE(n0,n);
172: arg0.body = (pointer)BDY(nd);
173: arg0.next = NEXT(arg);
174: Psubst(&arg0,&b);
175: BDY(n) = (pointer)b;
176: }
177: if ( n0 )
178: NEXT(n) = 0;
179: MKLIST(l,n0);
180: *rp = (Obj)l;
181: break;
182: case O_VECT:
183: len = ((VECT)a)->len;
184: MKVECT(vect,len);
185: for ( i = 0; i < len; i++ ) {
186: arg0.body = (pointer)BDY((VECT)a)[i];
187: arg0.next = NEXT(arg);
188: Psubst(&arg0,&b);
189: BDY(vect)[i] = (pointer)b;
190: }
191: *rp = (Obj)vect;
192: break;
193: case O_MAT:
194: row = ((MAT)a)->row;
195: col = ((MAT)a)->col;
196: MKMAT(mat,row,col);
197: for ( i = 0; i < row; i++ )
198: for ( j = 0; j < col; j++ ) {
199: arg0.body = (pointer)BDY((MAT)a)[i][j];
200: arg0.next = NEXT(arg);
201: Psubst(&arg0,&b);
202: BDY(mat)[i][j] = (pointer)b;
203: }
204: *rp = (Obj)mat;
205: break;
206: case O_DP:
207: mp0 = 0;
208: for ( m = BDY((DP)a); m; m = NEXT(m) ) {
209: arg0.body = (pointer)C(m);
210: arg0.next = NEXT(arg);
211: Psubst(&arg0,&b);
212: if ( b ) {
213: NEXTMP(mp0,mp);
214: C(mp) = (P)b;
215: mp->dl = m->dl;
216: }
217: }
218: if ( mp0 ) {
219: MKDP(NV((DP)a),mp0,d);
220: d->sugar = ((DP)a)->sugar;
221: *rp = (Obj)d;
222: } else
223: *rp = 0;
224:
225: break;
226: default:
1.8 ! noro 227: error("subst : invalid argument");
1.1 noro 228: }
1.4 noro 229: }
230:
231: FNODE subst_in_fnode();
232:
233: void Psubst_quote(arg,rp)
234: NODE arg;
235: QUOTE *rp;
236: {
1.5 noro 237: QUOTE h;
1.4 noro 238: FNODE fn;
239: Obj g;
240: LIST l;
241: V v;
242:
243: if ( !arg ) {
244: *rp = 0; return;
245: }
246: asir_assert(ARG0(arg),O_QUOTE,"subst_quote");
247: fn = BDY((QUOTE)ARG0(arg)); arg = NEXT(arg);
248: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
249: arg = BDY(l);
250: while ( arg ) {
251: asir_assert(BDY(arg),O_P,"subst_quote");
252: v = VR((P)BDY(arg)); arg = NEXT(arg);
253: if ( !arg )
254: error("subst_quote : invalid argument");
255: g = (Obj)ARG0(arg); arg = NEXT(arg);
256: if ( !g || OID(g) != O_QUOTE )
257: objtoquote(g,&h);
258: else
259: h = (QUOTE)g;
260: fn = subst_in_fnode(fn,v,BDY(h));
261: }
262: MKQUOTE(*rp,fn);
1.1 noro 263: }
264:
265: void Ppsubst(arg,rp)
266: NODE arg;
267: Obj *rp;
268: {
269: Obj a,b,t;
270: LIST l;
271: V v;
272:
273: if ( !arg ) {
274: *rp = 0; return;
275: }
276: asir_assert(ARG0(arg),O_R,"psubst");
277: reductr(CO,(Obj)ARG0(arg),&a);
278: /* a = (Obj)ARG0(arg); */
279: arg = NEXT(arg);
280: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
281: arg = BDY(l);
282: while ( arg ) {
283: asir_assert(BDY(arg),O_P,"psubst");
284: v = VR((P)BDY(arg)); arg = NEXT(arg);
285: if ( !arg )
286: error("psubst : invalid argument");
287: asir_assert(ARG0(arg),O_R,"psubst");
288: reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg);
289: /* b = (Obj)BDY(arg); arg = NEXT(arg); */
290: substr(CO,1,a,v,b,&t); a = t;
291: }
292: *rp = a;
293: }
294:
295: void Psubstf(arg,rp)
296: NODE arg;
297: Obj *rp;
298: {
299: Obj a,t;
300: LIST l;
301: V v,f;
302:
303: if ( !arg ) {
304: *rp = 0; return;
305: }
306: asir_assert(ARG0(arg),O_R,"substf");
307: reductr(CO,(Obj)ARG0(arg),&a);
308: /* a = (Obj)ARG0(arg); */
309: arg = NEXT(arg);
310: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
311: arg = BDY(l);
312: while ( arg ) {
313: asir_assert(BDY(arg),O_P,"substf");
314: v = VR((P)BDY(arg)); arg = NEXT(arg);
315: if ( !arg || (int)v->attr != V_SR )
316: error("substf : invalid argument");
317: f = VR((P)BDY(arg)); arg = NEXT(arg);
318: if ( (int)f->attr != V_SR )
319: error("substf : invalid argument\n");
320: substfr(CO,a,((FUNC)v->priv)->f.puref,((FUNC)f->priv)->f.puref,&t);
321: a = t;
322: }
323: *rp = a;
324: }