version 1.2, 2000/08/21 08:31:21 |
version 1.7, 2004/06/22 09:17:21 |
|
|
* shall be made on your publication or presentation in any form of the |
* shall be made on your publication or presentation in any form of the |
* results obtained by use of the SOFTWARE. |
* results obtained by use of the SOFTWARE. |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
* e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification |
* e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification |
* for such modification or the source code of the modified part of the |
* for such modification or the source code of the modified part of the |
* SOFTWARE. |
* SOFTWARE. |
* |
* |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.1.1.1 1999/12/03 07:39:07 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.6 2003/11/27 08:28:40 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
void Psubst(), Ppsubst(), Psubstf(); |
void Psubst(), Ppsubst(), Psubstf(), Psubst_quote(); |
|
|
struct ftab subst_tab[] = { |
struct ftab subst_tab[] = { |
{"subst",Psubst,-99999999}, |
{"subst",Psubst,-99999999}, |
|
{"subst_quote",Psubst_quote,-99999999}, |
{"psubst",Ppsubst,-99999999}, |
{"psubst",Ppsubst,-99999999}, |
{"substf",Psubstf,-99999999}, |
{"substf",Psubstf,-99999999}, |
{0,0,0}, |
{0,0,0}, |
|
|
Obj a,b,t; |
Obj a,b,t; |
LIST l; |
LIST l; |
V v; |
V v; |
|
int row,col,len; |
|
VECT vect; |
|
MAT mat; |
|
int i,j; |
|
NODE n0,n,nd; |
|
struct oNODE arg0; |
|
MP m,mp,mp0; |
|
DP d; |
|
|
if ( !arg ) { |
if ( !arg ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
asir_assert(ARG0(arg),O_R,"subst"); |
a = (Obj)ARG0(arg); |
reductr(CO,(Obj)ARG0(arg),&a); |
if ( !a ) { |
/* a = (Obj)ARG0(arg); */ |
*rp = 0; |
arg = NEXT(arg); |
return; |
|
} |
|
switch ( OID(a) ) { |
|
case O_N: case O_P: case O_R: |
|
reductr(CO,(Obj)ARG0(arg),&a); |
|
arg = NEXT(arg); |
|
if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST ) |
|
arg = BDY(l); |
|
while ( arg ) { |
|
if ( !BDY(arg) || OID((Obj)BDY(arg)) != O_P ) |
|
error("subst : invalid argument"); |
|
v = VR((P)BDY(arg)); arg = NEXT(arg); |
|
if ( !arg ) |
|
error("subst : invalid argument"); |
|
asir_assert(ARG0(arg),O_R,"subst"); |
|
reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg); |
|
/* b = (Obj)BDY(arg); arg = NEXT(arg); */ |
|
substr(CO,0,a,v,b,&t); a = t; |
|
} |
|
*rp = a; |
|
break; |
|
case O_LIST: |
|
n0 = 0; |
|
for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) { |
|
NEXTNODE(n0,n); |
|
arg0.body = (pointer)BDY(nd); |
|
arg0.next = NEXT(arg); |
|
Psubst(&arg0,&b); |
|
BDY(n) = (pointer)b; |
|
} |
|
if ( n0 ) |
|
NEXT(n) = 0; |
|
MKLIST(l,n0); |
|
*rp = (Obj)l; |
|
break; |
|
case O_VECT: |
|
len = ((VECT)a)->len; |
|
MKVECT(vect,len); |
|
for ( i = 0; i < len; i++ ) { |
|
arg0.body = (pointer)BDY((VECT)a)[i]; |
|
arg0.next = NEXT(arg); |
|
Psubst(&arg0,&b); |
|
BDY(vect)[i] = (pointer)b; |
|
} |
|
*rp = (Obj)vect; |
|
break; |
|
case O_MAT: |
|
row = ((MAT)a)->row; |
|
col = ((MAT)a)->col; |
|
MKMAT(mat,row,col); |
|
for ( i = 0; i < row; i++ ) |
|
for ( j = 0; j < col; j++ ) { |
|
arg0.body = (pointer)BDY((MAT)a)[i][j]; |
|
arg0.next = NEXT(arg); |
|
Psubst(&arg0,&b); |
|
BDY(mat)[i][j] = (pointer)b; |
|
} |
|
*rp = (Obj)mat; |
|
break; |
|
case O_DP: |
|
mp0 = 0; |
|
for ( m = BDY((DP)a); m; m = NEXT(m) ) { |
|
arg0.body = (pointer)C(m); |
|
arg0.next = NEXT(arg); |
|
Psubst(&arg0,&b); |
|
if ( b ) { |
|
NEXTMP(mp0,mp); |
|
C(mp) = (P)b; |
|
mp->dl = m->dl; |
|
} |
|
} |
|
if ( mp0 ) { |
|
MKDP(NV((DP)a),mp0,d); |
|
d->sugar = ((DP)a)->sugar; |
|
*rp = (Obj)d; |
|
} else |
|
*rp = 0; |
|
|
|
break; |
|
default: |
|
error("subst invalid argument"); |
|
} |
|
} |
|
|
|
FNODE subst_in_fnode(); |
|
|
|
void Psubst_quote(arg,rp) |
|
NODE arg; |
|
QUOTE *rp; |
|
{ |
|
QUOTE h; |
|
FNODE fn; |
|
Obj g; |
|
LIST l; |
|
V v; |
|
|
|
if ( !arg ) { |
|
*rp = 0; return; |
|
} |
|
asir_assert(ARG0(arg),O_QUOTE,"subst_quote"); |
|
fn = BDY((QUOTE)ARG0(arg)); arg = NEXT(arg); |
if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST ) |
if ( arg && (l = (LIST)ARG0(arg)) && OID(l) == O_LIST ) |
arg = BDY(l); |
arg = BDY(l); |
while ( arg ) { |
while ( arg ) { |
asir_assert(BDY(arg),O_P,"subst"); |
asir_assert(BDY(arg),O_P,"subst_quote"); |
v = VR((P)BDY(arg)); arg = NEXT(arg); |
v = VR((P)BDY(arg)); arg = NEXT(arg); |
if ( !arg ) |
if ( !arg ) |
error("subst : invalid argument"); |
error("subst_quote : invalid argument"); |
asir_assert(ARG0(arg),O_R,"subst"); |
g = (Obj)ARG0(arg); arg = NEXT(arg); |
reductr(CO,(Obj)BDY(arg),&b); arg = NEXT(arg); |
if ( !g || OID(g) != O_QUOTE ) |
/* b = (Obj)BDY(arg); arg = NEXT(arg); */ |
objtoquote(g,&h); |
substr(CO,0,a,v,b,&t); a = t; |
else |
|
h = (QUOTE)g; |
|
fn = subst_in_fnode(fn,v,BDY(h)); |
} |
} |
*rp = a; |
MKQUOTE(*rp,fn); |
} |
} |
|
|
void Ppsubst(arg,rp) |
void Ppsubst(arg,rp) |