=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.14 retrieving revision 1.24 diff -u -p -r1.14 -r1.24 --- OpenXM/src/kan96xx/Kan/dr.sm1 2003/07/14 12:49:51 1.14 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2003/09/13 13:14:03 1.24 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.13 2003/05/16 08:58:52 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.23 2003/09/12 02:52:50 takayama Exp $ %% dr.sm1 (Define Ring) 1994/9/25, 26 %% This file is error clean. @@ -3322,6 +3322,10 @@ newline ]] putUsages /cancelCoeff { + /arg1 set + [(reduceContent) arg1] gbext 0 get +} def +/cancelCoeff_org { /arg1 set [/in-cancelCoeff /ff /gg /dd /dd2] pushVariables [ /ff arg1 def @@ -3741,6 +3745,135 @@ $ [ff ff] fromVectors :: $ /execve.arg set [(forkExec) execve.arg [ ] 1] extension } def + +[(beginEcart) + [ + (beginEcart) + (Set the environments for the ecart division algorithm.) + ] +] putUsages + +/ecart.debug_reduction1 0 def +/beginEcart { + (red@) (ecart) switch_function + [(Ecart) 1] system_variable + [(CheckHomogenization) 0] system_variable + [(ReduceLowerTerms) 0] system_variable + [(AutoReduce) 0] system_variable + [(EcartAutomaticHomogenization) 0] system_variable + ecart.debug_reduction1 { + (red@) (debug) switch_function + } { } ifelse +} def + +[(endEcart) + [ + (endEcart) + (End of using the ecart division algorithm.) + ] +] putUsages + +/endEcart { + (red@) (standard) switch_function + [(Ecart) 0] system_variable + [(degreeShift) (reset)] homogenize pop +} def + +/ord_ws_all { + /arg2 set /arg1 set + [(ord_ws_all) arg1 arg2] gbext +} def +[(ord_ws_all) + [ + (fv wv ord_ws_all degree) + ( ord_ws_all returns the ord with respect to the weight vector wv.) + $Example: [(x,y) ring_of_differential_operators 0] define_ring $ + $ (Dx^2+x*Dx*Dy+2). [(Dx) 1 (Dy) 1] weightv ord_ws_all :: $ + ( ) + (fv [wv shiftv] ord_ws_all degree) + ( ord_ws_all returns the ord with respect to the weight vector wv and) + ( the shift vector shiftv.) + $Example: [(x,y) ring_of_differential_operators 0] define_ring $ + $ [(Dx^2+x*Dx*Dy+2). (Dx).] [[(Dx) 1 (Dy) 1] weightv [0 2]] ord_ws_all ::$ + ( ) + (cf: init, gbext. Obsolete: ord_w, ord_w_all) + ] +] putUsages + +[(newVector) + [( n newVector vec) +]] putUsages +/newVector { + /arg1 set + [/in-newVector /n] pushVariables + [ + /n arg1 def + [(newVector) n] extension /arg1 set + ] pop + popVariables + arg1 +} def + +[(newMatrix) + [( [m n] newMatrix mat) +]] putUsages +/newMatrix { + /arg1 set + [/in-newMatrix /n] pushVariables + [ + /n arg1 def + [(newMatrix) n 0 get n 1 get] extension /arg1 set + ] pop + popVariables + arg1 +} def + +/usages { + /arg1 set + [/name /flag /n /k /slist /m /i /sss] pushVariables + [ + /name arg1 def + /flag true def + + %BUG: should use regular expression in a future. + name tag 1 eq { + @.usages { 0 get } map shell { (, ) nl } map /sss set + } { + + /sss [ ] def + @.usages length /n set + 0 1 << n 1 sub >> + { + /k set + name << @.usages k get 0 get >> eq + { + /slist @.usages k get 1 get def + /m slist length def + 0 1 << m 1 sub >> { + /i set + sss slist i get append nl append /sss set + } for + /flag false def + } + { } + ifelse + } for + + %BUG: cannot get usages of primitives. + flag + {name Usage /sss [(Usage of ) name ( could not obtained.) nl ] def} + { } + ifelse + } ifelse + /arg1 sss cat def + ] pop + popVariables + arg1 +} def +[(usages) + [(key usages usages-as-a-string) + (num usages list-of-key-words) +]] putUsages ;