version 1.11, 2003/05/15 00:42:07 |
version 1.26, 2003/12/06 02:49:22 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.10 2002/11/08 14:18:01 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 |
%% dr.sm1 (Define Ring) 1994/9/25, 26 |
%% This file is error clean. |
%% This file is error clean. |
|
|
|
|
/arg1 set |
/arg1 set |
[/f /k /i /ans] pushVariables |
[/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 |
/f arg1 def /k arg2 ..int def |
k 0 lt { |
k 0 lt { |
1 1 << 0 k sub >> { |
1 1 << 0 k sub >> { |
|
|
/ans f ans {mul} sendmsg2 def |
/ans f ans {mul} sendmsg2 def |
} for |
} for |
} ifelse |
} ifelse |
/arg1 ans def |
} ifelse |
|
/arg1 ans def |
] pop |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
|
|
arg1 |
arg1 |
} def |
} def |
|
|
|
[(ord_w_all) |
|
[(ff [v1 w1 v2 w2 ... vm wm] ord_w d) |
|
(poly ff; string v1; integer w1; ...) |
|
(order of ff by the weight vector [w1 w2 ...]) |
|
(Example: [(x,y,t) ring_of_polynomials 0] define_ring ) |
|
( (x^2 y^3-x-t). [(t) 1 ] ord_w_all ::) |
|
] |
|
] putUsages |
|
/ord_w_all { |
|
/arg2 set /arg1 set |
|
[/ord_w_all-in /fff /fff-in /www /rrr /iii /ddd /zzz /ddd-tmp] pushVariables |
|
[ |
|
/fff arg1 def |
|
/www arg2 def |
|
fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse |
|
/ddd -intInfinity def |
|
fff (ring) dc /rrr set |
|
/zzz (0) rrr ,, def |
|
fff init /fff-in set |
|
fff fff-in sub /fff set |
|
{ |
|
/ddd-tmp 0 def |
|
0 2 www length 1 sub { |
|
/iii set |
|
fff-in << www iii get rrr ,, >> degree |
|
<< www iii 1 add get >> mul |
|
ddd-tmp add /ddd-tmp set |
|
} for |
|
ddd-tmp ddd gt { /ddd ddd-tmp def } { } ifelse |
|
fff zzz eq { exit } { } ifelse |
|
fff init /fff-in set |
|
fff fff-in sub /fff set |
|
} loop |
|
/ord_w_all.LLL |
|
/arg1 ddd def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
[(laplace0) |
[(laplace0) |
[ |
[ |
(f [v1 ... vn] laplace0 g) |
(f [v1 ... vn] laplace0 g) |
|
|
]] putUsages |
]] putUsages |
|
|
/cancelCoeff { |
/cancelCoeff { |
|
/arg1 set |
|
[(reduceContent) arg1] gbext 0 get |
|
} def |
|
/cancelCoeff_org { |
/arg1 set |
/arg1 set |
[/in-cancelCoeff /ff /gg /dd /dd2] pushVariables |
[/in-cancelCoeff /ff /gg /dd /dd2] pushVariables |
[ /ff arg1 def |
[ /ff arg1 def |
Line 3687 $ [ff ff] fromVectors :: $ |
|
Line 3736 $ [ff ff] fromVectors :: $ |
|
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} def |
|
|
|
[(execve) |
|
[ |
|
(command execve) |
|
([arg0 arg1 arg2 ...] execve ) |
|
(It executes the command by the system call execve.) |
|
(cf. system, forkExec) |
|
] |
|
] putUsages |
|
|
|
/execve { |
|
/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 |
|
|
|
/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 |
|
|
; |
; |
|
|