version 1.41, 2004/09/14 02:02:02 |
version 1.47, 2004/09/20 02:11:22 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.40 2004/09/14 01:57:15 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.46 2004/09/17 00:47:08 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. |
|
|
|
|
0 1 << set0 length 1 sub >> |
0 1 << set0 length 1 sub >> |
{ |
{ |
/i set |
/i set |
<< set0 i get >> a eq |
set0 i get tag , a tag , eq { |
{ |
<< set0 i get >> a eq |
/flag 1 def |
{ |
} |
/flag 1 def exit |
{ } |
} |
ifelse |
{ } |
|
ifelse |
|
} { } ifelse |
} for |
} for |
] pop |
] pop |
/arg1 flag def |
/arg1 flag def |
|
|
(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.) |
Line 4151 $ [ff ff] fromVectors :: $ |
|
Line 4165 $ [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 4178 $ [ff ff] fromVectors :: $ |
|
Line 4206 $ [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 4252 $ [ff ff] fromVectors :: $ |
|
Line 4283 $ [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 4322 $ [ff ff] fromVectors :: $ |
|
Line 4351 $ [ff ff] fromVectors :: $ |
|
(num usages list-of-key-words) |
(num usages list-of-key-words) |
([key1 key2 ... ] usages list-of-key-words : it accepts regular expressions.) |
([key1 key2 ... ] usages list-of-key-words : it accepts regular expressions.) |
]] putUsages |
]] putUsages |
|
|
|
/setMinus { |
|
/arg2 set /arg1 set |
|
[/aa /bb /i ] pushVariables |
|
[ |
|
/aa arg1 def /bb arg2 def |
|
[ |
|
0 1 aa length 1 sub { |
|
/i set |
|
aa i get bb memberQ { |
|
} { aa i get } ifelse |
|
} for |
|
] /arg1 set |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(setMinus) |
|
[(a b setMinus c) |
|
]] 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 |
|
|
|
|
; |
; |
|
|