=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.19 retrieving revision 1.28 diff -u -p -r1.19 -r1.28 --- OpenXM/src/kan96xx/Kan/dr.sm1 2003/08/23 02:28:38 1.19 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2004/05/13 05:33:10 1.28 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.18 2003/08/20 01:39:16 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.27 2004/04/29 11:20:37 takayama Exp $ %% dr.sm1 (Define Ring) 1994/9/25, 26 %% This file is error clean. @@ -50,7 +50,7 @@ } for ] /dList set - [(H)] xList join [@@@.esymbol] join /xList set + [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set [(h)] dList join [@@@.Esymbol] join /dList set [0 %% dummy characteristic << xList length >> << xList length >> << xList length >> @@ -167,7 +167,7 @@ vars reverse /xList set %[z y x] vars {@@@.Dsymbol 2 1 roll 2 cat_n} map reverse /dList set %[Dz Dy Dx] - [(H)] xList join [@@@.esymbol] join /xList set + [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set [(h)] dList join [@@@.Esymbol] join /dList set [0 1 1 1 << xList length >> 1 1 1 << xList length 1 sub >> ] /param set @@ -269,7 +269,7 @@ vars reverse /xList set %[z y x] vars {@@@.diffEsymbol 2 1 roll 2 cat_n} map reverse /dList set %[Dz Dy Dx] - [(H)] xList join [@@@.esymbol] join /xList set + [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set [(h)] dList join [@@@.Esymbol] join /dList set [0 1 1 << xList length >> << xList length >> 1 1 << xList length 1 sub >> << xList length >> ] /param set @@ -308,7 +308,7 @@ vars2 reverse vars {@@@.Dsymbol 2 1 roll 2 cat_n} map reverse join /dList set %[s2 s1 Dz Dy Dx] - [(H)] xList join [@@@.esymbol] join /xList set + [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set [(h)] dList join [@@@.Esymbol] join /dList set [0 1 1 << vars2 length 1 add >> << xList length >> 1 1 << vars2 length 1 add >> << xList length 1 sub >> ] /param set @@ -1766,7 +1766,11 @@ /arg1 set [/f /k /i /ans] pushVariables [ - /ans (1).. def + /ans (1).. def + [(QuoteMode)] system_variable { + /f arg1 def /k arg2 def + [(ooPower) f k] extension /ans set + } { /f arg1 def /k arg2 ..int def k 0 lt { 1 1 << 0 k sub >> { @@ -1779,7 +1783,8 @@ /ans f ans {mul} sendmsg2 def } for } ifelse - /arg1 ans def + } ifelse + /arg1 ans def ] pop popVariables arg1 @@ -3753,6 +3758,7 @@ $ [ff ff] fromVectors :: $ ] ] putUsages +/ecart.debug_reduction1 0 def /beginEcart { (red@) (ecart) switch_function [(Ecart) 1] system_variable @@ -3760,6 +3766,9 @@ $ [ff ff] fromVectors :: $ [(ReduceLowerTerms) 0] system_variable [(AutoReduce) 0] system_variable [(EcartAutomaticHomogenization) 0] system_variable + ecart.debug_reduction1 { + (red@) (debug) switch_function + } { } ifelse } def [(endEcart) @@ -3772,6 +3781,7 @@ $ [ff ff] fromVectors :: $ /endEcart { (red@) (standard) switch_function [(Ecart) 0] system_variable + [(degreeShift) (reset)] homogenize pop } def /ord_ws_all { @@ -3794,6 +3804,103 @@ $ [ff ff] fromVectors :: $ (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 + +[(,,,) +[(reparse a polynomial or polynomials)] +] putUsages +/,,, { + /arg1 set + [/in-reparse /ff] pushVariables + [ + /ff arg1 def + ff tag 6 eq { + ff { ,,, } map /arg1 set + } { + ff toString . /arg1 set + } ifelse + ] 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 ;