version 1.26, 2003/11/27 07:53:53 |
version 1.29, 2004/02/09 08:23:29 |
|
|
* 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.25 2003/01/18 02:38:56 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.28 2004/02/05 08:28:53 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 1314 void dp_nf_tab_f(DP p,LIST *tab,DP *rp) |
|
Line 1314 void dp_nf_tab_f(DP p,LIST *tab,DP *rp) |
|
* |
* |
*/ |
*/ |
|
|
int create_order_spec(Obj obj,struct order_spec *spec) |
int create_order_spec(VL vl,Obj obj,struct order_spec **specp) |
{ |
{ |
int i,j,n,s,row,col; |
int i,j,n,s,row,col; |
|
struct order_spec *spec; |
struct order_pair *l; |
struct order_pair *l; |
NODE node,t,tn; |
NODE node,t,tn; |
MAT m; |
MAT m; |
pointer **b; |
pointer **b; |
int **w; |
int **w; |
|
|
|
if ( vl && obj && OID(obj) == O_LIST ) |
|
return create_composite_order_spec(vl,(LIST)obj,specp); |
|
|
|
*specp = spec = (struct order_spec *)MALLOC(sizeof(struct order_spec)); |
if ( !obj || NUM(obj) ) { |
if ( !obj || NUM(obj) ) { |
spec->id = 0; spec->obj = obj; |
spec->id = 0; spec->obj = obj; |
spec->ord.simple = QTOS((Q)obj); |
spec->ord.simple = QTOS((Q)obj); |
Line 1354 int create_order_spec(Obj obj,struct order_spec *spec) |
|
Line 1359 int create_order_spec(Obj obj,struct order_spec *spec) |
|
return 0; |
return 0; |
} |
} |
|
|
|
void print_composite_order_spec(struct order_spec *spec) |
|
{ |
|
int nv,n,len,i,j,k,start; |
|
struct weight_or_block *worb; |
|
|
|
nv = spec->nv; |
|
n = spec->ord.composite.length; |
|
worb = spec->ord.composite.w_or_b; |
|
for ( i = 0; i < n; i++, worb++ ) { |
|
len = worb->length; |
|
printf("[ "); |
|
switch ( worb->type ) { |
|
case IS_DENSE_WEIGHT: |
|
for ( j = 0; j < len; j++ ) |
|
printf("%d ",worb->body.dense_weight[j]); |
|
for ( ; j < nv; j++ ) |
|
printf("0 "); |
|
break; |
|
case IS_SPARSE_WEIGHT: |
|
for ( j = 0, k = 0; j < nv; j++ ) |
|
if ( j == worb->body.sparse_weight[k].pos ) |
|
printf("%d ",worb->body.sparse_weight[k++].value); |
|
else |
|
printf("0 "); |
|
break; |
|
case IS_BLOCK: |
|
start = worb->body.block.start; |
|
for ( j = 0; j < start; j++ ) printf("0 "); |
|
switch ( worb->body.block.order ) { |
|
case 0: |
|
for ( k = 0; k < len; k++, j++ ) printf("R "); |
|
break; |
|
case 1: |
|
for ( k = 0; k < len; k++, j++ ) printf("G "); |
|
break; |
|
case 2: |
|
for ( k = 0; k < len; k++, j++ ) printf("L "); |
|
break; |
|
} |
|
for ( ; j < nv; j++ ) printf("0 "); |
|
break; |
|
} |
|
printf("]\n"); |
|
} |
|
} |
|
|
|
/* order = [w_or_b, w_or_b, ... ] */ |
|
/* w_or_b = w or b */ |
|
/* w = [1,2,...] or [x,1,y,2,...] */ |
|
/* b = [@lex,x,y,...,z] etc */ |
|
|
|
int create_composite_order_spec(VL vl,LIST order,struct order_spec **specp) |
|
{ |
|
NODE wb,t,p; |
|
struct order_spec *spec; |
|
VL tvl; |
|
int n,i,j,k,l,start,end,len,w; |
|
int *dw; |
|
struct sparse_weight *sw; |
|
struct weight_or_block *w_or_b; |
|
Obj a0; |
|
NODE a; |
|
V v,sv,ev; |
|
SYMBOL sym; |
|
int *top; |
|
|
|
/* l = number of vars in vl */ |
|
for ( l = 0, tvl = vl; tvl; tvl = NEXT(tvl), l++ ); |
|
/* n = number of primitives in order */ |
|
wb = BDY(order); |
|
n = length(wb); |
|
*specp = spec = (struct order_spec *)MALLOC(sizeof(struct order_spec)); |
|
spec->id = 3; |
|
spec->obj = (Obj)order; |
|
spec->nv = l; |
|
spec->ord.composite.length = n; |
|
w_or_b = spec->ord.composite.w_or_b = (struct weight_or_block *) |
|
MALLOC(sizeof(struct weight_or_block)*(n+1)); |
|
|
|
/* top : register the top variable in each w_or_b specification */ |
|
top = (int *)ALLOCA(l*sizeof(int)); |
|
for ( i = 0; i < l; i++ ) top[i] = 0; |
|
|
|
for ( t = wb, i = 0; t; t = NEXT(t), i++ ) { |
|
a = BDY((LIST)BDY(t)); |
|
len = length(a); |
|
a0 = (Obj)BDY(a); |
|
if ( !a0 || OID(a0) == O_N ) { |
|
/* a is a dense weight vector */ |
|
dw = (int *)MALLOC(sizeof(int)*len); |
|
for ( j = 0, p = a; j < len; p = NEXT(p), j++ ) |
|
dw[j] = QTOS((Q)BDY(p)); |
|
w_or_b[i].type = IS_DENSE_WEIGHT; |
|
w_or_b[i].length = len; |
|
w_or_b[i].body.dense_weight = dw; |
|
|
|
/* find the top */ |
|
for ( k = 0; k < len && !dw[k]; k++ ); |
|
if ( k < len ) top[k] = 1; |
|
|
|
} else if ( OID(a0) == O_P ) { |
|
/* a is a sparse weight vector */ |
|
len >>= 1; |
|
sw = (struct sparse_weight *) |
|
MALLOC(sizeof(struct sparse_weight)*len); |
|
for ( j = 0, p = a; j < len; j++ ) { |
|
v = VR((P)BDY(p)); p = NEXT(p); |
|
for ( tvl = vl, k = 0; tvl && tvl->v != v; |
|
k++, tvl = NEXT(tvl) ); |
|
if ( !tvl ) |
|
error("invalid variable name"); |
|
sw[j].pos = k; |
|
sw[j].value = QTOS((Q)BDY(p)); p = NEXT(p); |
|
} |
|
w_or_b[i].type = IS_SPARSE_WEIGHT; |
|
w_or_b[i].length = len; |
|
w_or_b[i].body.sparse_weight = sw; |
|
|
|
/* find the top */ |
|
for ( k = 0; k < len && !sw[k].value; k++ ); |
|
if ( k < len ) top[sw[k].pos] = 1; |
|
} else if ( OID(a0) == O_RANGE ) { |
|
/* [range(v1,v2),w] */ |
|
sv = VR((P)(((RANGE)a0)->start)); |
|
ev = VR((P)(((RANGE)a0)->end)); |
|
for ( tvl = vl, start = 0; tvl && tvl->v != sv; start++, tvl = NEXT(tvl) ); |
|
if ( !tvl ) |
|
error("invalid range"); |
|
for ( end = start; tvl && tvl->v != ev; end++, tvl = NEXT(tvl) ); |
|
if ( !tvl ) |
|
error("invalid range"); |
|
len = end-start+1; |
|
sw = (struct sparse_weight *) |
|
MALLOC(sizeof(struct sparse_weight)*len); |
|
w = QTOS((Q)BDY(NEXT(a))); |
|
for ( tvl = vl, k = 0; k < start; k++, tvl = NEXT(tvl) ); |
|
for ( j = 0 ; k <= end; k++, tvl = NEXT(tvl), j++ ) { |
|
sw[j].pos = k; |
|
sw[j].value = w; |
|
} |
|
w_or_b[i].type = IS_SPARSE_WEIGHT; |
|
w_or_b[i].length = len; |
|
w_or_b[i].body.sparse_weight = sw; |
|
|
|
/* register the top */ |
|
if ( w ) top[start] = 1; |
|
} else if ( OID(a0) == O_SYMBOL ) { |
|
/* a is a block */ |
|
sym = (SYMBOL)a0; a = NEXT(a); len--; |
|
if ( OID((Obj)BDY(a)) == O_RANGE ) { |
|
sv = VR((P)(((RANGE)BDY(a))->start)); |
|
ev = VR((P)(((RANGE)BDY(a))->end)); |
|
for ( tvl = vl, start = 0; tvl && tvl->v != sv; start++, tvl = NEXT(tvl) ); |
|
if ( !tvl ) |
|
error("invalid range"); |
|
for ( end = start; tvl && tvl->v != ev; end++, tvl = NEXT(tvl) ); |
|
if ( !tvl ) |
|
error("invalid range"); |
|
len = end-start+1; |
|
} else { |
|
for ( start = 0, tvl = vl; tvl->v != VR((P)BDY(a)); |
|
tvl = NEXT(tvl), start++ ); |
|
for ( p = NEXT(a), tvl = NEXT(tvl); p; |
|
p = NEXT(p), tvl = NEXT(tvl) ) |
|
if ( tvl->v != VR((P)BDY(p)) ) break; |
|
if ( p ) |
|
error("a block must be contiguous"); |
|
} |
|
w_or_b[i].type = IS_BLOCK; |
|
w_or_b[i].length = len; |
|
w_or_b[i].body.block.start = start; |
|
if ( !strcmp(sym->name,"@grlex") ) |
|
w_or_b[i].body.block.order = 0; |
|
else if ( !strcmp(sym->name,"@glex") ) |
|
w_or_b[i].body.block.order = 1; |
|
else if ( !strcmp(sym->name,"@lex") ) |
|
w_or_b[i].body.block.order = 2; |
|
else |
|
error("invalid ordername"); |
|
/* register the tops */ |
|
for ( j = 0, k = start; j < len; j++, k++ ) |
|
top[k] = 1; |
|
} |
|
} |
|
for ( k = 0; k < l && top[k]; k++ ); |
|
if ( k < l ) { |
|
/* incomplete order specification; add @grlex */ |
|
w_or_b[n].type = IS_BLOCK; |
|
w_or_b[n].length = l; |
|
w_or_b[n].body.block.start = 0; |
|
w_or_b[n].body.block.order = 0; |
|
spec->ord.composite.length = n+1; |
|
} |
|
if ( 1 ) print_composite_order_spec(spec); |
|
} |
|
|
/* |
/* |
* converters |
* converters |
* |
* |
Line 1451 void dp_rat(DP p,DP *rp) |
|
Line 1652 void dp_rat(DP p,DP *rp) |
|
} |
} |
|
|
|
|
void homogenize_order(struct order_spec *old,int n,struct order_spec *new) |
void homogenize_order(struct order_spec *old,int n,struct order_spec **newp) |
{ |
{ |
struct order_pair *l; |
struct order_pair *l; |
int length,nv,row,i,j; |
int length,nv,row,i,j; |
int **newm,**oldm; |
int **newm,**oldm; |
|
struct order_spec *new; |
|
|
|
*newp = new = (struct order_spec *)MALLOC(sizeof(struct order_spec)); |
switch ( old->id ) { |
switch ( old->id ) { |
case 0: |
case 0: |
switch ( old->ord.simple ) { |
switch ( old->ord.simple ) { |