version 1.13, 2008/09/01 07:53:59 |
version 1.17, 2011/09/14 06:41:20 |
|
|
* 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/pf.c,v 1.12 2005/10/05 07:38:08 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.16 2009/07/23 01:04:29 ohara Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "math.h" |
#include "math.h" |
Line 564 void Pcall(NODE arg,Obj *rp) |
|
Line 564 void Pcall(NODE arg,Obj *rp) |
|
{ |
{ |
P p; |
P p; |
V v; |
V v; |
|
NODE n,n1; |
|
LIST list; |
|
VECT vect; |
|
pointer *a; |
|
int len,i; |
|
|
p = (P)ARG0(arg); |
p = (P)ARG0(arg); |
if ( !p || OID(p) != 2 ) |
if ( !p || OID(p) != 2 ) |
Line 571 void Pcall(NODE arg,Obj *rp) |
|
Line 576 void Pcall(NODE arg,Obj *rp) |
|
v = VR(p); |
v = VR(p); |
if ( (int)v->attr != V_SR ) |
if ( (int)v->attr != V_SR ) |
error("call : no such function"); |
error("call : no such function"); |
|
else { |
else |
list = (LIST) ARG1(arg); |
*rp = (Obj)bevalf((FUNC)v->priv,BDY((LIST)ARG1(arg))); |
if ( list ) { |
|
switch (OID(list)) { |
|
case O_VECT: |
|
vect = (VECT)list; len = vect->len; a = BDY(vect); |
|
for ( i = len - 1, n = 0; i >= 0; i-- ) { |
|
MKNODE(n1,a[i],n); n = n1; |
|
} |
|
MKLIST(list,n); |
|
/* falling next case */ |
|
case O_LIST: |
|
*rp = (Obj)bevalf_with_opts((FUNC)v->priv,BDY(list),current_option); |
|
return; |
|
default: |
|
break; |
|
} |
|
} |
|
error("call : invalid argument"); |
|
} |
} |
} |
|
|
/* at=position of arg to be used for iteration */ |
/* at=position of arg to be used for iteration */ |
Line 591 void Pmapat(NODE arg,Obj *rp) |
|
Line 613 void Pmapat(NODE arg,Obj *rp) |
|
int len,row,col,i,j,pos; |
int len,row,col,i,j,pos; |
Obj iter; |
Obj iter; |
pointer val; |
pointer val; |
|
NODE option; |
|
|
|
option = current_option; |
|
|
if ( argc(arg) < 3 ) |
if ( argc(arg) < 3 ) |
error("mapat : too few arguments"); |
error("mapat : too few arguments"); |
|
|
Line 616 void Pmapat(NODE arg,Obj *rp) |
|
Line 641 void Pmapat(NODE arg,Obj *rp) |
|
NEXTNODE(r0,r); |
NEXTNODE(r0,r); |
iter = BDY(t); rest = NEXT(t); |
iter = BDY(t); rest = NEXT(t); |
if ( !iter ) { |
if ( !iter ) { |
*rp = bevalf(f,node); |
*rp = bevalf_with_opts(f,node,option); |
return; |
return; |
} |
} |
switch ( OID(iter) ) { |
switch ( OID(iter) ) { |
Line 624 void Pmapat(NODE arg,Obj *rp) |
|
Line 649 void Pmapat(NODE arg,Obj *rp) |
|
v = (VECT)iter; len = v->len; MKVECT(rv,len); |
v = (VECT)iter; len = v->len; MKVECT(rv,len); |
for ( i = 0; i < len; i++ ) { |
for ( i = 0; i < len; i++ ) { |
BDY(r) = BDY(v)[i]; NEXT(r) = rest; |
BDY(r) = BDY(v)[i]; NEXT(r) = rest; |
BDY(rv)[i] = bevalf(f,r0); |
BDY(rv)[i] = bevalf_with_opts(f,r0,option); |
} |
} |
*rp = (Obj)rv; |
*rp = (Obj)rv; |
break; |
break; |
Line 633 void Pmapat(NODE arg,Obj *rp) |
|
Line 658 void Pmapat(NODE arg,Obj *rp) |
|
for ( i = 0; i < row; i++ ) |
for ( i = 0; i < row; i++ ) |
for ( j = 0; j < col; j++ ) { |
for ( j = 0; j < col; j++ ) { |
BDY(r) = BDY(m)[i][j]; NEXT(r) = rest; |
BDY(r) = BDY(m)[i][j]; NEXT(r) = rest; |
BDY(rm)[i][j] = bevalf(f,r0); |
BDY(rm)[i][j] = bevalf_with_opts(f,r0,option); |
} |
} |
*rp = (Obj)rm; |
*rp = (Obj)rm; |
break; |
break; |
Line 641 void Pmapat(NODE arg,Obj *rp) |
|
Line 666 void Pmapat(NODE arg,Obj *rp) |
|
n = BDY((LIST)iter); |
n = BDY((LIST)iter); |
for ( t0 = t = 0; n; n = NEXT(n) ) { |
for ( t0 = t = 0; n; n = NEXT(n) ) { |
BDY(r) = BDY(n); NEXT(r) = rest; |
BDY(r) = BDY(n); NEXT(r) = rest; |
NEXTNODE(t0,t); BDY(t) = bevalf(f,r0); |
NEXTNODE(t0,t); BDY(t) = bevalf_with_opts(f,r0,option); |
} |
} |
if ( t0 ) |
if ( t0 ) |
NEXT(t) = 0; |
NEXT(t) = 0; |
Line 649 void Pmapat(NODE arg,Obj *rp) |
|
Line 674 void Pmapat(NODE arg,Obj *rp) |
|
*rp = (Obj)rl; |
*rp = (Obj)rl; |
break; |
break; |
default: |
default: |
*rp = bevalf(f,node); |
*rp = bevalf_with_opts(f,node,option); |
break; |
break; |
} |
} |
} |
} |
Line 668 void Pmap(NODE arg,Obj *rp) |
|
Line 693 void Pmap(NODE arg,Obj *rp) |
|
int len,row,col,i,j; |
int len,row,col,i,j; |
Obj iter; |
Obj iter; |
pointer val; |
pointer val; |
|
NODE option; |
|
|
|
option = current_option; |
|
|
if ( argc(arg) < 2 ) |
if ( argc(arg) < 2 ) |
error("mapat : too few arguments"); |
error("mapat : too few arguments"); |
|
|
Line 685 void Pmap(NODE arg,Obj *rp) |
|
Line 713 void Pmap(NODE arg,Obj *rp) |
|
error("evalmapf : invalid position"); |
error("evalmapf : invalid position"); |
r0 = 0; |
r0 = 0; |
NEXTNODE(r0,r); |
NEXTNODE(r0,r); |
iter = BDY(t); rest = NEXT(t); |
iter = BDY(node); rest = NEXT(node); |
if ( !iter ) { |
if ( !iter ) { |
*rp = bevalf(f,node); |
*rp = bevalf_with_opts(f,node,option); |
return; |
return; |
} |
} |
switch ( OID(iter) ) { |
switch ( OID(iter) ) { |
Line 695 void Pmap(NODE arg,Obj *rp) |
|
Line 723 void Pmap(NODE arg,Obj *rp) |
|
v = (VECT)iter; len = v->len; MKVECT(rv,len); |
v = (VECT)iter; len = v->len; MKVECT(rv,len); |
for ( i = 0; i < len; i++ ) { |
for ( i = 0; i < len; i++ ) { |
BDY(r) = BDY(v)[i]; NEXT(r) = rest; |
BDY(r) = BDY(v)[i]; NEXT(r) = rest; |
BDY(rv)[i] = bevalf(f,r0); |
BDY(rv)[i] = bevalf_with_opts(f,r0,option); |
} |
} |
*rp = (Obj)rv; |
*rp = (Obj)rv; |
break; |
break; |
Line 704 void Pmap(NODE arg,Obj *rp) |
|
Line 732 void Pmap(NODE arg,Obj *rp) |
|
for ( i = 0; i < row; i++ ) |
for ( i = 0; i < row; i++ ) |
for ( j = 0; j < col; j++ ) { |
for ( j = 0; j < col; j++ ) { |
BDY(r) = BDY(m)[i][j]; NEXT(r) = rest; |
BDY(r) = BDY(m)[i][j]; NEXT(r) = rest; |
BDY(rm)[i][j] = bevalf(f,r0); |
BDY(rm)[i][j] = bevalf_with_opts(f,r0,option); |
} |
} |
*rp = (Obj)rm; |
*rp = (Obj)rm; |
break; |
break; |
Line 712 void Pmap(NODE arg,Obj *rp) |
|
Line 740 void Pmap(NODE arg,Obj *rp) |
|
n = BDY((LIST)iter); |
n = BDY((LIST)iter); |
for ( t0 = t = 0; n; n = NEXT(n) ) { |
for ( t0 = t = 0; n; n = NEXT(n) ) { |
BDY(r) = BDY(n); NEXT(r) = rest; |
BDY(r) = BDY(n); NEXT(r) = rest; |
NEXTNODE(t0,t); BDY(t) = bevalf(f,r0); |
NEXTNODE(t0,t); BDY(t) = bevalf_with_opts(f,r0,option); |
} |
} |
if ( t0 ) |
if ( t0 ) |
NEXT(t) = 0; |
NEXT(t) = 0; |
Line 720 void Pmap(NODE arg,Obj *rp) |
|
Line 748 void Pmap(NODE arg,Obj *rp) |
|
*rp = (Obj)rl; |
*rp = (Obj)rl; |
break; |
break; |
default: |
default: |
*rp = bevalf(f,node); |
*rp = bevalf_with_opts(f,node,option); |
break; |
break; |
} |
} |
} |
} |