Return to dp-supp.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
version 1.61, 2015/08/14 13:51:54 | version 1.64, 2016/03/31 08:43:25 | ||
---|---|---|---|
|
|
||
* 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/dp-supp.c,v 1.60 2015/08/08 14:19:41 fujimoto Exp $ | * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.63 2016/03/31 07:33:32 noro Exp $ | ||
*/ | */ | ||
#include "ca.h" | #include "ca.h" | ||
#include "base.h" | #include "base.h" | ||
|
|
||
int create_order_spec(VL vl,Obj obj,struct order_spec **specp) | int create_order_spec(VL vl,Obj obj,struct order_spec **specp) | ||
{ | { | ||
int i,j,n,s,row,col,ret; | int i,j,n,s,row,col,ret,wlen; | ||
struct order_spec *spec; | struct order_spec *spec; | ||
struct order_pair *l; | struct order_pair *l; | ||
NODE node,t,tn; | Obj wp,wm; | ||
NODE node,t,tn,wpair; | |||
MAT m; | MAT m; | ||
VECT v; | VECT v; | ||
pointer **b,*bv; | pointer **b,*bv; | ||
|
|
||
spec->ord.simple = QTOS((Q)obj); | spec->ord.simple = QTOS((Q)obj); | ||
return 1; | return 1; | ||
} else if ( OID(obj) == O_LIST ) { | } else if ( OID(obj) == O_LIST ) { | ||
/* module order; obj = [0|1,w,ord] or [0|1,ord] */ | |||
node = BDY((LIST)obj); | node = BDY((LIST)obj); | ||
if ( !BDY(node) || NUM(BDY(node)) ) { | if ( !BDY(node) || NUM(BDY(node)) ) { | ||
if ( length(node) < 2 ) | switch ( length(node) ) { | ||
error("create_order_spec : invalid argument"); | case 2: | ||
create_order_spec(0,(Obj)BDY(NEXT(node)),&spec); | create_order_spec(0,(Obj)BDY(NEXT(node)),&spec); | ||
spec->id += 256; spec->obj = obj; | spec->id += 256; spec->obj = obj; | ||
spec->ispot = (BDY(node)!=0); | spec->top_weight = 0; | ||
if ( spec->ispot ) { | spec->module_rank = 0; | ||
n = QTOS((Q)BDY(node)); | spec->module_top_weight = 0; | ||
if ( n < 0 ) | spec->ispot = (BDY(node)!=0); | ||
spec->pot_nelim = -n; | if ( spec->ispot ) { | ||
else | n = QTOS((Q)BDY(node)); | ||
spec->pot_nelim = 0; | if ( n < 0 ) | ||
} | spec->pot_nelim = -n; | ||
else | |||
spec->pot_nelim = 0; | |||
} | |||
break; | |||
case 3: | |||
create_order_spec(0,(Obj)BDY(NEXT(NEXT(node))),&spec); | |||
spec->id += 256; spec->obj = obj; | |||
spec->ispot = (BDY(node)!=0); | |||
node = NEXT(node); | |||
if ( !BDY(node) || OID(BDY(node)) != O_LIST ) | |||
error("create_order_spec : [weight_for_poly,weight_for_modlue] must be specified as a module topweight"); | |||
wpair = BDY((LIST)BDY(node)); | |||
if ( length(wpair) != 2 ) | |||
error("create_order_spec : [weight_for_poly,weight_for_modlue] must be specified as a module topweight"); | |||
wp = BDY(wpair); | |||
wm = BDY(NEXT(wpair)); | |||
if ( !wp || OID(wp) != O_LIST || !wm || OID(wm) != O_LIST ) | |||
error("create_order_spec : [weight_for_poly,weight_for_modlue] must be specified as a module topweight"); | |||
spec->nv = length(BDY((LIST)wp)); | |||
spec->top_weight = (int *)MALLOC_ATOMIC(spec->nv*sizeof(int)); | |||
for ( i = 0, t = BDY((LIST)wp); i < spec->nv; t = NEXT(t), i++ ) | |||
spec->top_weight[i] = QTOS((Q)BDY(t)); | |||
spec->module_rank = length(BDY((LIST)wm)); | |||
spec->module_top_weight = (int *)MALLOC_ATOMIC(spec->module_rank*sizeof(int)); | |||
for ( i = 0, t = BDY((LIST)wm); i < spec->module_rank; t = NEXT(t), i++ ) | |||
spec->module_top_weight[i] = QTOS((Q)BDY(t)); | |||
break; | |||
default: | |||
error("create_order_spec : invalid arguments for module order"); | |||
} | |||
*specp = spec; | *specp = spec; | ||
return 1; | return 1; | ||
} | } else { | ||
/* block order in polynomial ring */ | |||
for ( n = 0, t = node; t; t = NEXT(t), n++ ); | for ( n = 0, t = node; t; t = NEXT(t), n++ ); | ||
l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); | l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); | ||
for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { | for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { | ||
tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); | tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); | ||
tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); | tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); | ||
s += l[i].length; | s += l[i].length; | ||
} | } | ||
spec->id = 1; spec->obj = obj; | spec->id = 1; spec->obj = obj; | ||
spec->ord.block.order_pair = l; | spec->ord.block.order_pair = l; | ||
spec->ord.block.length = n; spec->nv = s; | spec->ord.block.length = n; spec->nv = s; | ||
return 1; | return 1; | ||
} | |||
} else if ( OID(obj) == O_MAT ) { | } else if ( OID(obj) == O_MAT ) { | ||
m = (MAT)obj; row = m->row; col = m->col; b = BDY(m); | m = (MAT)obj; row = m->row; col = m->col; b = BDY(m); | ||
w = almat(row,col); | w = almat(row,col); |