=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.16 retrieving revision 1.25 diff -u -p -r1.16 -r1.25 --- OpenXM/src/kan96xx/Kan/dr.sm1 2003/07/17 12:11:09 1.16 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2003/12/04 05:27:19 1.25 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.15 2003/07/17 09:10:54 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.24 2003/09/13 13:14:03 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 @@ -3749,12 +3753,17 @@ $ [ff ff] fromVectors :: $ ] ] 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) @@ -3767,7 +3776,108 @@ $ [ff ff] fromVectors :: $ /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 + +/addStdoutStderr { + [(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join +} 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 ;