| version 1.1.1.1, 1999/10/08 02:12:02 |
version 1.7, 2000/12/29 07:19:38 |
|
|
| |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.6 2000/12/10 07:48:42 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. |
| |
|
| @@@.quiet { } |
@@@.quiet { } |
| { (macro package : dr.sm1, 9/26,1995 --- Version 9/8, 1999. ) message } ifelse |
{ (macro package : dr.sm1, 9/26,1995 --- Version 12/10, 2000. ) message } ifelse |
| |
|
| /ctrlC-hook { |
/ctrlC-hook { |
| %%% define your own routing in case of error. |
%%% define your own routing in case of error. |
|
|
| (type?) data_conversion RationalFunctionP eq |
(type?) data_conversion RationalFunctionP eq |
| } def |
} def |
| |
|
| |
[(isRing) |
| |
[(obj isRing bool) ] |
| |
] putUsages |
| |
/isRing { |
| |
(type?) data_conversion RingP eq |
| |
} def |
| |
|
| /toString.tmp { |
/toString.tmp { |
| /arg1 set |
/arg1 set |
| [/obj /fname] pushVariables |
[/obj /fname] pushVariables |
|
|
| /obj arg1 def |
/obj arg1 def |
| obj isArray |
obj isArray |
| { |
{ |
| ( [ ) |
[(LeftBracket)] system_variable %%( [ ) |
| obj {toString.tmp2} map /r set |
obj {toString.tmp2} map /r set |
| /n r length 1 sub def |
/n r length 1 sub def |
| [0 1 n { |
[0 1 n { |
|
|
| ifelse |
ifelse |
| } for |
} for |
| ] aload length cat_n |
] aload length cat_n |
| ( ] ) |
[(RightBracket)] system_variable %%( ] ) |
| 3 cat_n |
3 cat_n |
| } |
} |
| { |
{ |
|
|
| arg1 |
arg1 |
| } def |
} def |
| |
|
| |
/distraction2* { |
| |
/arg1 set |
| |
[/in-distraction2* /aa /f /vlist /xlist /dlist /slist ] pushVariables |
| |
[(CurrentRingp)] pushEnv |
| |
[ |
| |
/aa arg1 def |
| |
/f aa 0 get def |
| |
/vlist aa 1 get def |
| |
/xlist aa 2 get def |
| |
/dlist aa 3 get def |
| |
/slist aa 4 get def |
| |
vlist isArray |
| |
{ |
| |
vlist { toString } map /vlist set |
| |
} |
| |
{ |
| |
vlist toString to_records /vlist set |
| |
} ifelse |
| |
xlist isArray |
| |
{ |
| |
xlist { toString } map /xlist set |
| |
} |
| |
{ |
| |
xlist toString to_records /xlist set |
| |
} ifelse |
| |
slist isArray |
| |
{ |
| |
slist { toString } map /slist set |
| |
} |
| |
{ |
| |
slist toString to_records /slist set |
| |
} ifelse |
| |
[vlist from_records ring_of_differential_operators 0] define_ring pop |
| |
f toString . |
| |
xlist { . } map |
| |
dlist { toString . } map |
| |
slist { toString . } map |
| |
distraction2 /arg1 set |
| |
] pop |
| |
popEnv |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| /message-quiet { |
/message-quiet { |
| @@@.quiet { pop } { message } ifelse |
@@@.quiet { pop } { message } ifelse |
| } def |
} def |
| Line 3487 $ [ff ff] fromVectors :: $ |
|
| Line 3539 $ [ff ff] fromVectors :: $ |
|
| [(nl) |
[(nl) |
| [(nl is the newline character.) |
[(nl is the newline character.) |
| $Example: [(You can break line) nl (here.)] cat message$ |
$Example: [(You can break line) nl (here.)] cat message$ |
| |
]] putUsages |
| |
|
| |
/to_int { |
| |
/arg1 set |
| |
[/to-int /ob /ans] pushVariables |
| |
[ |
| |
/ob arg1 def |
| |
/ans ob def |
| |
ob isArray { |
| |
ob {to_int} map /ans set |
| |
/LLL.to_int goto |
| |
} { } ifelse |
| |
ob isInteger { |
| |
ob (universalNumber) dc /ans set |
| |
/LLL.to_int goto |
| |
} { } ifelse |
| |
/LLL.to_int |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
[(to_int) |
| |
[(obj to_int obj2) |
| |
(All integers in obj are changed to universalNumber.) |
| |
(Example: /ff [1 2 [(hello) (0).]] def ff { tag } map ::) |
| |
( ff to_int { tag } map :: ) |
| |
]] putUsages |
| |
|
| |
/define_ring_variables { |
| |
[/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables |
| |
%% You cannot use these names for names for polynomials. |
| |
[ |
| |
/drv._v getVariableNames def |
| |
/drv._v0 drv._v def |
| |
drv._v { dup /drv._p set (/) 2 1 roll ( $) drv._p ($. def ) } map cat |
| |
/drv._v set |
| |
% drv._v message |
| |
[(parse) drv._v] extension |
| |
] pop |
| |
popVariables |
| |
} def |
| |
[(define_ring_variables) |
| |
[(It binds a variable <<a>> in the current ring to the sm1 variable <<a>>.) |
| |
(For example, if x is a variable in the current ring, it defines the sm1) |
| |
(variable x by /x (x) def) |
| |
]] putUsages |
| |
|
| |
/boundp { |
| |
/arg1 set |
| |
[/a /ans] pushVariables |
| |
[ |
| |
/a arg1 def |
| |
[(parse) [(/) a ( load tag 0 eq { /ans 0 def } ) |
| |
( { /ans 1 def } ifelse )] cat ] extension |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
[(boundp) |
| |
[( a boundp b) |
| |
(string a, b is 0 or 1.) |
| |
(If the variable named << a >> is bounded to a value,) |
| |
(it returns 1 else it returns 0.) |
| |
$Example: (hoge) boundp ::$ |
| ]] putUsages |
]] putUsages |
| |
|
| ; |
; |