=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.19 retrieving revision 1.24 diff -u -p -r1.19 -r1.24 --- OpenXM/src/kan96xx/Kan/dr.sm1 2003/08/23 02:28:38 1.19 +++ 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.18 2003/08/20 01:39:16 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. @@ -3753,6 +3753,7 @@ $ [ff ff] fromVectors :: $ ] ] putUsages +/ecart.debug_reduction1 0 def /beginEcart { (red@) (ecart) switch_function [(Ecart) 1] system_variable @@ -3760,6 +3761,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 +3776,7 @@ $ [ff ff] fromVectors :: $ /endEcart { (red@) (standard) switch_function [(Ecart) 0] system_variable + [(degreeShift) (reset)] homogenize pop } def /ord_ws_all { @@ -3794,6 +3799,81 @@ $ [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 + +/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 ;