Return to ctrl.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
File: [local] / OpenXM_contrib2 / asir2000 / builtin / ctrl.c (download)
Revision 1.7, Wed Apr 5 08:32:16 2000 UTC (24 years, 5 months ago) by noro
A very^3 experimental implementation of Weyl algebra. example: [...] ctrl("do_weyl",1); [...] <<1,2,3,4>>*<<4,5,6,7>>; <--- (x*y^2*Dx^3*Dy^4)*(x^4*y^5*Dx^6*Dy^7) (1)*<<5,7,9,11>>+(20)*<<5,6,9,10>>+(12)*<<4,7,8,11>>+(120)*<<5,5,9,9>> +(240)*<<4,6,8,10>>+(36)*<<3,7,7,11>>+(240)*<<5,4,9,8>>+(1440)*<<4,5,8,9>> +(720)*<<3,6,7,10>>+(24)*<<2,7,6,11>>+(120)*<<5,3,9,7>>+(2880)*<<4,4,8,8>> +(4320)*<<3,5,7,9>>+(480)*<<2,6,6,10>>+(1440)*<<4,3,8,7>>+(8640)*<<3,4,7,8>> +(2880)*<<2,5,6,9>>+(4320)*<<3,3,7,7>>+(5760)*<<2,4,6,8>>+(2880)*<<2,3,6,7>> etc. |
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/ctrl.c,v 1.7 2000/04/05 08:32:16 noro Exp $ */ #include "ca.h" #include "parse.h" void Pctrl(); struct ftab ctrl_tab[] = { {"ctrl",Pctrl,-2}, {0,0,0}, }; extern int prtime,nez,echoback,bigfloat; extern int GC_free_space_numerator,GC_free_space_divisor,debug_up,no_prompt; extern int GC_max_heap_size,Verbose,hideargs,hex_output,do_server_in_X11; extern int do_message; extern int ox_batch,ox_check,ox_exchange_mathcap; extern int f4_nocheck; extern int fortran_output; extern int do_weyl; static struct { char *key; int *val; } ctrls[] = { {"cputime",&prtime}, {"nez",&nez}, {"echo",&echoback}, #if DO_PLOT {"bigfloat",&bigfloat}, #endif {"verbose",&Verbose}, {"hideargs",&hideargs}, {"hex",&hex_output}, {"debug_window",&do_server_in_X11}, {"message",&do_message}, {"debug_up",&debug_up}, {"no_prompt",&no_prompt}, {"ox_batch",&ox_batch}, {"ox_check",&ox_check}, {"ox_exchange_mathcap",&ox_exchange_mathcap}, {"f4_nocheck",&f4_nocheck}, {"fortran_output",&fortran_output}, {"do_weyl",&do_weyl}, {0,0}, }; void Pctrl(arg,rp) NODE arg; Q *rp; { int t,i; N num,den; Q c; char *key; char buf[BUFSIZ]; if ( !arg ) { *rp = 0; return; } key = BDY((STRING)ARG0(arg)); if ( !strcmp(key,"adj") ) { /* special treatment is necessary for "adj" */ if ( argc(arg) == 1 ) { UTON(GC_free_space_divisor,num); UTON(GC_free_space_numerator,den); } else { c = (Q)ARG1(arg); if ( !c ) error("ctrl : adj : invalid argument"); num = NM(c); den = !DN(c)?ONEN:DN(c); GC_free_space_divisor = BD(num)[0]; GC_free_space_numerator = BD(den)[0]; } NDTOQ(num,den,1,*rp); return; } for ( i = 0; ctrls[i].key; i++ ) if ( !strcmp(key,ctrls[i].key) ) break; if ( ctrls[i].key ) { if ( argc(arg) == 1 ) t = *ctrls[i].val; else *ctrls[i].val = t = QTOS((Q)ARG1(arg)); STOQ(t,*rp); } else { sprintf(buf,"ctrl : %s : no such key",key); error(buf); } }