| version 1.47, 2004/09/20 02:11:22 |
version 1.55, 2013/09/22 01:06:20 |
|
|
| % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.46 2004/09/17 00:47:08 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.54 2013/01/26 10:48:26 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 12/10, 2000. ) message } ifelse |
{ (macro package : dr.sm1, 9/26,1995 --- Version 09/22, 2013. ) message } ifelse |
| |
|
| /ctrlC-hook { |
/ctrlC-hook { |
| %%% define your own routing in case of error. |
%%% define your own routing in case of error. |
|
|
| (one may use the command ) |
(one may use the command ) |
| ( f (ring) data_conversion /R set) |
( f (ring) data_conversion /R set) |
| (cf. define_ring, define_qring, system_variable, poly (ring) data_conversion) |
(cf. define_ring, define_qring, system_variable, poly (ring) data_conversion) |
| (cf. << __ >>) |
(cf. << __ >>, getRing) |
| ] |
] |
| ] putUsages |
] putUsages |
| |
|
|
|
| } def |
} def |
| [(getRing) |
[(getRing) |
| [(obj getRing rr) |
[(obj getRing rr) |
| (ring rr;) |
(ring rr; ) |
| (getRing obtains the ring structure from obj.) |
(getRing obtains the ring structure from obj.) |
| (If obj is a polynomial, it returns the ring structure associated to) |
(If obj is a polynomial, it returns the ring structure associated to) |
| (the polynomial.) |
(the polynomial.) |
| (If obj is an array, it recursively looks for the ring structure.) |
(If obj is an array, it recursively looks for the ring structure.) |
| |
(cf. ring_def) |
| ]] putUsages |
]] putUsages |
| /toVectors { |
/toVectors { |
| /arg1 set |
/arg1 set |
| Line 4383 $ [ff ff] fromVectors :: $ |
|
| Line 4384 $ [ff ff] fromVectors :: $ |
|
| } def |
} def |
| /~put~ makeInfix |
/~put~ makeInfix |
| |
|
| |
/toTokensBySpace { |
| |
/arg1 set |
| |
[(cgiToTokens) arg1 [ ]] extension |
| |
} def |
| |
[(toTokensBySpace) |
| |
[ |
| |
( string toTokensBySpace token_array ) |
| |
]] putUsages |
| |
|
| |
/setAttributeList { |
| |
/arg2 set |
| |
/arg1 set |
| |
[ |
| |
[(setAttributeList) arg1 arg2] extension /arg1 set |
| |
] pop |
| |
arg1 |
| |
} def |
| |
/getAttributeList { |
| |
/arg1 set |
| |
[(getAttributeList) arg1] extension |
| |
} def |
| |
/setAttribute { |
| |
/arg3 set |
| |
/arg2 set |
| |
/arg1 set |
| |
[ |
| |
[(setAttribute) arg1 arg2 arg3] extension /arg1 set |
| |
] pop |
| |
arg1 |
| |
} def |
| |
/getAttribute { |
| |
/arg2 set |
| |
/arg1 set |
| |
[(getAttribute) arg1 arg2] extension |
| |
} def |
| |
[(setAttributeList) |
| |
[ |
| |
(ob attr setAttributeList new-obj ) |
| |
(Example: [(x-1) (y-1)] [(gb) 1] setAttributeList /ff set ) |
| |
]] putUsages |
| |
[(setAttribute) |
| |
[ |
| |
(ob key value setAttribute new-obj ) |
| |
(Example: [(x-1) (y-1)] (gb) 1 setAttribute /ff set ) |
| |
]] putUsages |
| |
[(getAttributeList) |
| |
[ |
| |
(ob getAttributeList attr-obj ) |
| |
(Example: [(x-1) (y-1)] [(gb) 1] setAttributeList /ff set ) |
| |
( ff getAttributeList :: ) |
| |
]] putUsages |
| |
[(getAttribute) |
| |
[ |
| |
(ob key getAttribute value ) |
| |
(Example: [(x-1) (y-1)] (gb) 1 setAttribute /ff set ) |
| |
( ff (gb) getAttribute :: ) |
| |
]] putUsages |
| |
|
| |
% [(gbCheck) 1 (needSyz) 1 (countDown) 100] (attribute format) |
| |
% --> [(gbCheck) (needSyz) (countDown) 100] (groebner option format) |
| |
% cf. gb |
| |
/configureGroebnerOption { |
| |
/arg1 set |
| |
[/opt /i] pushVariables |
| |
[ |
| |
/opt arg1 def |
| |
opt tag 0 eq { |
| |
/arg1 null def |
| |
} { |
| |
[ |
| |
0 2 opt length 1 sub { |
| |
/i set |
| |
opt i get |
| |
opt i get (countDown) eq { |
| |
opt i 1 add get |
| |
} { } ifelse |
| |
opt i get (stopDegree) eq { |
| |
opt i 1 add get |
| |
} { } ifelse |
| |
} for |
| |
] /arg1 set |
| |
} ifelse |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
[(getFileType) |
| |
[ |
| |
(string getFileType type) |
| |
$Example: (/www/prog/cohom.sm1) getFileType ==> (sm1)$ |
| |
]] putUsages |
| |
/getFileType { |
| |
/arg1 set |
| |
[/ss ] pushVariables |
| |
[ /ss arg1 def |
| |
[(stringToArgv2) ss (.)] extension /ss set |
| |
ss, ss length 1 sub, get /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
% Default initial value. |
| |
/localizedString.file null def |
| |
/localizedString.dic [ ] def |
| |
/localizedString.local { } def |
| |
|
| |
% Clear and load |
| |
/localizedString.load { |
| |
/localizedString.dic [ ] def |
| |
/localizedString.local { } def |
| |
localizedString.file tag 0 eq { } |
| |
{ [(parse) localizedString.file pushfile] extension pop } ifelse |
| |
} def |
| |
|
| |
|
| |
[(localizedString) |
| |
[ |
| |
(string localizedString translatedString) |
| |
(It returns localizedString if localizedString.dic [array] and) |
| |
(localizedString.local [function] are set.) |
| |
] |
| |
] putUsages |
| |
/localizedString { |
| |
/arg1 set |
| |
[/ss /ans /tt] pushVariables |
| |
[ |
| |
arg1 /ss set |
| |
/ans ss def |
| |
{ |
| |
localizedString.dic length 0 eq { exit } { } ifelse |
| |
localizedString.dic ss getNode /tt set |
| |
tt tag 0 eq { } { tt /ans set exit } ifelse |
| |
ss localizedString.local /ans set |
| |
exit |
| |
} loop |
| |
ans /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
[(univ2poly) |
| |
[(list univ2poly list2) |
| |
(Change universal numbers in list to an element of a ring of polynomials) |
| |
(defined by other elements in list. If there is no polynomial element,) |
| |
(the current ring is used.) |
| |
]] putUsages |
| |
/univ2poly { |
| |
/arg1 set |
| |
[/aa /rg /ag /ans] pushVariables |
| |
[ |
| |
arg1 /aa set |
| |
[(CurrentRingp)] system_variable /rg set |
| |
aa getRing /ag set |
| |
ag tag 0 { } { |
| |
ag ring_def |
| |
} ifelse |
| |
aa univ2poly.aux /ans set |
| |
rg ring_def |
| |
ans /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/univ2poly.aux { |
| |
/arg1 set |
| |
[/aa /ans] pushVariables |
| |
[ |
| |
arg1 /aa set |
| |
aa getRing |
| |
aa tag 6 eq { |
| |
aa { univ2poly.aux} map /ans set |
| |
}{ |
| |
aa tag 15 eq, aa tag 1 eq, or { aa toString . /ans set } { |
| |
aa /ans set |
| |
} ifelse |
| |
} ifelse |
| |
ans /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/sm1log { |
| |
/arg1 set |
| |
[/ss /fd ] pushVariables |
| |
[ |
| |
arg1 /ss set |
| |
(/tmp/sm1log.txt) (a) file /fd set |
| |
fd , ss (string) dc , writestring |
| |
fd closefile |
| |
] pop |
| |
popVariables |
| |
} def |
| |
|
| ; |
; |
| |
|