=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.21 retrieving revision 1.26 diff -u -p -r1.21 -r1.26 --- OpenXM/src/kan96xx/Kan/dr.sm1 2003/08/24 05:25:58 1.21 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2003/12/06 02:49:22 1.26 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.20 2003/08/24 05:19:42 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.25 2003/12/04 05:27:19 takayama Exp $ %% dr.sm1 (Define Ring) 1994/9/25, 26 %% This file is error clean. @@ -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) @@ -3795,6 +3804,85 @@ $ [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 + +/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 ;