| version 1.42, 2004/09/14 02:13:29 |
version 1.53, 2006/02/04 02:44:39 |
|
|
| % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.41 2004/09/14 02:02:02 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.52 2005/11/21 09:12:22 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. |
| |
|
|
|
| (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 |
| |
|
|
|
| (type?) data_conversion RingP eq |
(type?) data_conversion RingP eq |
| } def |
} def |
| |
|
| |
[(isByteArray) |
| |
[(obj isByteArray bool) ] |
| |
] putUsages |
| |
/isByteArray { |
| |
(type?) data_conversion ByteArrayP eq |
| |
} def |
| |
|
| /toString.tmp { |
/toString.tmp { |
| /arg1 set |
/arg1 set |
| [/obj /fname] pushVariables |
[/obj /fname] pushVariables |
|
|
| { obj (string) data_conversion } { } ifelse |
{ obj (string) data_conversion } { } ifelse |
| obj isRational |
obj isRational |
| { obj (string) data_conversion } { } ifelse |
{ obj (string) data_conversion } { } ifelse |
| |
obj isByteArray |
| |
{ obj (array) data_conversion toString } { } ifelse |
| obj tag 0 eq |
obj tag 0 eq |
| { (null) } { } ifelse |
{ (null) } { } ifelse |
| |
|
|
|
| /RationalFunctionP 16 def |
/RationalFunctionP 16 def |
| /ClassP 17 def |
/ClassP 17 def |
| /DoubleP 18 def |
/DoubleP 18 def |
| |
/ByteArrayP 19 def |
| /@.datatypeConstant.usage [ |
/@.datatypeConstant.usage [ |
| (IntegerP, LiteralP, StringP, ExecutableArrayP, ArrayP, PolyP, FileP, RingP,) |
(IntegerP, LiteralP, StringP, ExecutableArrayP, ArrayP, PolyP, FileP, RingP,) |
| (UniversalNumberP, RationalFunctionP, ClassP, DoubleP) |
(UniversalNumberP, RationalFunctionP, ClassP, DoubleP, ByteArrayP) |
| ( return data type identifiers.) |
( return data type identifiers.) |
| (Example: 7 tag IntegerP eq ---> 1) |
(Example: 7 tag IntegerP eq ---> 1) |
| ] def |
] def |
|
|
| [(RationalFunctionP) @.datatypeConstant.usage ] putUsages |
[(RationalFunctionP) @.datatypeConstant.usage ] putUsages |
| [(ClassP) @.datatypeConstant.usage ] putUsages |
[(ClassP) @.datatypeConstant.usage ] putUsages |
| [(DoubleP) @.datatypeConstant.usage ] putUsages |
[(DoubleP) @.datatypeConstant.usage ] putUsages |
| |
[(ByteArrayP) @.datatypeConstant.usage ] putUsages |
| |
|
| [(__) |
[(__) |
| [( string ring __ polynomial) |
[( string ring __ polynomial) |
|
|
| [( string .. universalNumber) |
[( string .. universalNumber) |
| (Parse the << string >> as a universalNumber.) |
(Parse the << string >> as a universalNumber.) |
| (Example: (123431232123123).. /n set) |
(Example: (123431232123123).. /n set) |
| |
({ commands }.. executes the commands. << .. >> is equivalent to exec.) |
| ]] putUsages |
]] putUsages |
| /.. { (universalNumber) data_conversion } def |
/.. { dup tag 3 eq { exec } { (universalNumber) data_conversion} ifelse } def |
| |
|
| [(dc) |
[(dc) |
| [(Abbreviation of data_conversion.) |
[(Abbreviation of data_conversion.) |
|
|
| } 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 4153 $ [ff ff] fromVectors :: $ |
|
| Line 4166 $ [ff ff] fromVectors :: $ |
|
| /getNode { |
/getNode { |
| /arg2 set |
/arg2 set |
| /arg1 set |
/arg1 set |
| [/in-getNode /ob /key /rr /rr /ii] pushVariables |
[/in-getNode /ob /key /rr /tt /ii] pushVariables |
| [ |
[ |
| /ob arg1 def |
/ob arg1 def |
| /key arg2 def |
/key arg2 def |
| /rr null def |
/rr null def |
| { |
{ |
| |
ob isArray { |
| |
ob length 1 gt { |
| |
ob 0 get isString { |
| |
ob 0 get , key eq { |
| |
/rr ob 1 get def exit |
| |
} { } ifelse |
| |
} { } ifelse |
| |
}{ } ifelse |
| |
ob { key getNode , dup tag 0 eq {pop} { } ifelse } map /tt set |
| |
tt length 0 gt { /rr tt 0 get def exit } |
| |
{/rr null def exit } ifelse |
| |
} { } ifelse |
| |
|
| ob isClass { |
ob isClass { |
| ob (array) dc /ob set |
ob (array) dc /ob set |
| } { exit } ifelse |
} { } ifelse |
| |
ob isClass , ob isArray or { } { exit } ifelse |
| ob 0 get key eq { |
ob 0 get key eq { |
| /rr ob def |
/rr ob def |
| exit |
exit |
| Line 4180 $ [ff ff] fromVectors :: $ |
|
| Line 4207 $ [ff ff] fromVectors :: $ |
|
| arg1 |
arg1 |
| } def |
} def |
| [(getNode) |
[(getNode) |
| [(ob key getNode) |
[(ob key getNode node-value) |
| (ob is a class object.) |
(ob is a class object or an array.) |
| (The operator getNode returns the node with the key in ob.) |
(The operator getNode returns the node with the key in ob.) |
| (The node is an array of the format [key attr-list node-list]) |
(When ob is a class, the node is an array of the format [key attr-list node-list]) |
| |
(When ob is an array, the node is a value of key-value pairs.) |
| (Example:) |
(Example:) |
| ( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def) |
( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def) |
| ( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def) |
( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def) |
| ( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def) |
( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def) |
| ( ma (dog) getNode ) |
( ma (dog) getNode ) |
| |
(Example 2:) |
| |
( [ [1 ] [2 3] [[(dog) 2]]] (dog) getNode ::) |
| ]] putUsages |
]] putUsages |
| |
|
| /cons { |
/cons { |
| Line 4254 $ [ff ff] fromVectors :: $ |
|
| Line 4284 $ [ff ff] fromVectors :: $ |
|
| [(list listToArray a) |
[(list listToArray a) |
| ]] putUsages |
]] putUsages |
| |
|
| /makeInfix { |
% Body is moved to smacro.sm1 |
| [(or_attr) 4 4 -1 roll ] extension |
|
| } def |
|
| [(makeInfix) |
[(makeInfix) |
| [(literal makeInfix) |
[(literal makeInfix) |
| (Change literal to an infix operator.) |
(Change literal to an infix operator.) |
| Line 4344 $ [ff ff] fromVectors :: $ |
|
| Line 4372 $ [ff ff] fromVectors :: $ |
|
| [(setMinus) |
[(setMinus) |
| [(a b setMinus c) |
[(a b setMinus c) |
| ]] putUsages |
]] putUsages |
| |
|
| |
% Define some infix operators |
| |
/~add~ { add } def /~add~ makeInfix |
| |
/~sub~ { sub } def /~sub~ makeInfix |
| |
/~mul~ { mul } def /~mul~ makeInfix |
| |
/~div~ { div } def /~div~ makeInfix |
| |
/~power~ { power } def /~power~ makeInfix |
| |
/~put~ { |
| |
dup tag 3 eq { exec } { } ifelse put |
| |
} def |
| |
/~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 |
| |
|
| ; |
; |
| |
|