Annotation of OpenXM_contrib2/asir2000/builtin/subst.c, Revision 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>