=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v retrieving revision 1.32 retrieving revision 1.37 diff -u -p -r1.32 -r1.37 --- OpenXM_contrib2/asir2000/builtin/array.c 2003/09/17 08:14:26 1.32 +++ OpenXM_contrib2/asir2000/builtin/array.c 2004/09/15 01:43:32 1.37 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.31 2003/07/01 08:12:37 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.36 2004/09/14 07:23:34 noro Exp $ */ #include "ca.h" #include "base.h" @@ -68,7 +68,7 @@ void Pgeneric_gauss_elim(); void Pgeneric_gauss_elim_mod(); void Pmat_to_gfmmat(),Plu_gfmmat(),Psolve_by_lu_gfmmat(); -void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol(); +void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol(), Pltov(); void Pgeninv_sf_swap(); void sepvect(); void Pmulmat_gf2n(); @@ -87,6 +87,7 @@ void Pmat_swap_col_destructive(); void Pvect(); void Pmat(); void Pmatc(); +void Pnd_det(); struct ftab array_tab[] = { {"solve_by_lu_gfmmat",Psolve_by_lu_gfmmat,4}, @@ -108,8 +109,10 @@ struct ftab array_tab[] = { {"sepvect",Psepvect,2}, {"qsort",Pqsort,-2}, {"vtol",Pvtol,1}, + {"ltov",Pltov,1}, {"size",Psize,1}, {"det",Pdet,-2}, + {"nd_det",Pnd_det,-2}, {"invmat",Pinvmat,-2}, {"leqm",Pleqm,2}, {"leqm1",Pleqm1,2}, @@ -156,12 +159,28 @@ int generic_comp_obj(Obj *a,Obj *b) void Pqsort(NODE arg,VECT *rp) { VECT vect; - NODE n; + NODE n,n1; P p; V v; + FUNC func; + int len,i; + pointer *a; + Obj t; - asir_assert(ARG0(arg),O_VECT,"qsort"); - vect = (VECT)ARG0(arg); + t = ARG0(arg); + if (OID(t) == O_LIST) { + n = (NODE)BDY((LIST)t); + len = length(n); + MKVECT(vect,len); + for ( i = 0; i < len; i++, n = NEXT(n) ) { + BDY(vect)[i] = BDY(n); + } + + }else if (OID(t) != O_VECT) { + error("qsort : invalid argument"); + }else { + vect = (VECT)t; + } if ( argc(arg) == 1 ) qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))comp_obj); else { @@ -169,13 +188,25 @@ void Pqsort(NODE arg,VECT *rp) if ( !p || OID(p)!=2 ) error("qsort : invalid argument"); v = VR(p); - if ( (int)v->attr != V_SR ) - error("qsort : no such function"); - generic_comp_obj_func = (FUNC)v->priv; + gen_searchf(NAME(v),&func); + if ( !func ) { + if ( (int)v->attr != V_SR ) + error("qsort : no such function"); + func = (FUNC)v->priv; + } + generic_comp_obj_func = func; MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n); qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj); } - *rp = vect; + if (OID(t) == O_LIST) { + a = BDY(vect); + for ( i = len - 1, n = 0; i >= 0; i-- ) { + MKNODE(n1,a[i],n); n = n1; + } + MKLIST((LIST)*rp,n); + }else { + *rp = vect; + } } void PNBmul_gf2n(NODE arg,GF2N *rp) @@ -596,6 +627,21 @@ void Pvtol(NODE arg,LIST *rp) MKLIST(*rp,n); } +void Pltov(NODE arg,VECT *rp) +{ + NODE n; + VECT v; + int len,i; + + asir_assert(ARG0(arg),O_LIST,"ltov"); + n = (NODE)BDY((LIST)ARG0(arg)); + len = length(n); + MKVECT(v,len); + for ( i = 0; i < len; i++, n = NEXT(n) ) + BDY(v)[i] = BDY(n); + *rp = v; +} + void Premainder(NODE arg,Obj *rp) { Obj a; @@ -2869,4 +2915,12 @@ void printimat(int **mat,int row,int col) } printf("\n"); } +} + +void Pnd_det(NODE arg,P *rp) +{ + if ( argc(arg) == 1 ) + nd_det(0,ARG0(arg),rp); + else + nd_det(QTOS((Q)ARG1(arg)),ARG0(arg),rp); }