Annotation of OpenXM_contrib2/asir2000/builtin/subst.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/subst.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 Psubst(), Ppsubst(), Psubstf();
6:
7: struct ftab subst_tab[] = {
8: {"subst",Psubst,-99999999},
9: {"psubst",Ppsubst,-99999999},
10: {"substf",Psubstf,-99999999},
11: {0,0,0},
12: };
13:
14: void Psubst(arg,rp)
15: NODE arg;
16: Obj *rp;
17: {
18: Obj a,b,t;
19: LIST l;
20: V v;
21:
22: if ( !arg ) {
23: *rp = 0; return;
24: }
25: asir_assert(ARG0(arg),O_R,"subst");
26: reductr(CO,(Obj)ARG0(arg),&a);
27: /* a = (Obj)ARG0(arg); */
28: arg = NEXT(arg);
29: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
30: arg = BDY(l);
31: while ( arg ) {
32: asir_assert(BDY(arg),O_P,"subst");
33: v = VR((P)BDY(arg)); arg = NEXT(arg);
34: if ( !arg )
35: error("subst : invalid argument");
36: asir_assert(ARG0(arg),O_R,"subst");
37: reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg);
38: /* b = (Obj)BDY(arg); arg = NEXT(arg); */
39: substr(CO,0,a,v,b,&t); a = t;
40: }
41: *rp = a;
42: }
43:
44: void Ppsubst(arg,rp)
45: NODE arg;
46: Obj *rp;
47: {
48: Obj a,b,t;
49: LIST l;
50: V v;
51:
52: if ( !arg ) {
53: *rp = 0; return;
54: }
55: asir_assert(ARG0(arg),O_R,"psubst");
56: reductr(CO,(Obj)ARG0(arg),&a);
57: /* a = (Obj)ARG0(arg); */
58: arg = NEXT(arg);
59: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
60: arg = BDY(l);
61: while ( arg ) {
62: asir_assert(BDY(arg),O_P,"psubst");
63: v = VR((P)BDY(arg)); arg = NEXT(arg);
64: if ( !arg )
65: error("psubst : invalid argument");
66: asir_assert(ARG0(arg),O_R,"psubst");
67: reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg);
68: /* b = (Obj)BDY(arg); arg = NEXT(arg); */
69: substr(CO,1,a,v,b,&t); a = t;
70: }
71: *rp = a;
72: }
73:
74: void Psubstf(arg,rp)
75: NODE arg;
76: Obj *rp;
77: {
78: Obj a,t;
79: LIST l;
80: V v,f;
81:
82: if ( !arg ) {
83: *rp = 0; return;
84: }
85: asir_assert(ARG0(arg),O_R,"substf");
86: reductr(CO,(Obj)ARG0(arg),&a);
87: /* a = (Obj)ARG0(arg); */
88: arg = NEXT(arg);
89: if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST )
90: arg = BDY(l);
91: while ( arg ) {
92: asir_assert(BDY(arg),O_P,"substf");
93: v = VR((P)BDY(arg)); arg = NEXT(arg);
94: if ( !arg || (int)v->attr != V_SR )
95: error("substf : invalid argument");
96: f = VR((P)BDY(arg)); arg = NEXT(arg);
97: if ( (int)f->attr != V_SR )
98: error("substf : invalid argument\n");
99: substfr(CO,a,((FUNC)v->priv)->f.puref,((FUNC)f->priv)->f.puref,&t);
100: a = t;
101: }
102: *rp = a;
103: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>