version 1.42, 2004/09/14 02:13:29 |
version 1.46, 2004/09/17 00:47:08 |
|
|
% $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.45 2004/09/17 00:10:41 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. |
|
|
|
|
[( 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 4153 $ [ff ff] fromVectors :: $ |
|
Line 4154 $ [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 4195 $ [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 4272 $ [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 4360 $ [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 |
|
|
|
|
; |
; |
|
|