version 1.42, 2004/09/14 02:13:29 |
version 1.44, 2004/09/16 23:53:44 |
|
|
% $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.43 2004/09/14 10:50:49 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. |
|
|
Line 4153 $ [ff ff] fromVectors :: $ |
|
Line 4153 $ [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 4194 $ [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 4271 $ [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.) |