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 |
|
|
; |
; |
|
|