=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.40 retrieving revision 1.43 diff -u -p -r1.40 -r1.43 --- OpenXM/src/kan96xx/Kan/dr.sm1 2004/09/14 01:57:15 1.40 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2004/09/14 10:50:49 1.43 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.39 2004/09/12 02:47:45 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.42 2004/09/14 02:13:29 takayama Exp $ %% dr.sm1 (Define Ring) 1994/9/25, 26 %% This file is error clean. @@ -342,12 +342,14 @@ 0 1 << set0 length 1 sub >> { /i set - << set0 i get >> a eq - { - /flag 1 def - } - { } - ifelse + set0 i get tag , a tag , eq { + << set0 i get >> a eq + { + /flag 1 def exit + } + { } + ifelse + } { } ifelse } for ] pop /arg1 flag def @@ -4151,15 +4153,29 @@ $ [ff ff] fromVectors :: $ /getNode { /arg2 set /arg1 set - [/in-getNode /ob /key /rr /rr /ii] pushVariables + [/in-getNode /ob /key /rr /tt /ii] pushVariables [ /ob arg1 def /key arg2 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 (array) dc /ob set - } { exit } ifelse + } { } ifelse + ob isClass , ob isArray or { } { exit } ifelse ob 0 get key eq { /rr ob def exit @@ -4178,15 +4194,18 @@ $ [ff ff] fromVectors :: $ arg1 } def [(getNode) -[(ob key getNode) - (ob is a class object.) +[(ob key getNode node-value) + (ob is a class object or an array.) (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:) ( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def) ( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def) ( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def) ( ma (dog) getNode ) + (Example 2:) + ( [ [1 ] [2 3] [[(dog) 2]]] (dog) getNode ::) ]] putUsages /cons { @@ -4273,7 +4292,7 @@ $ [ff ff] fromVectors :: $ { % begin loop name isArray { - /ukeys @.usages { 0 get } map def + /ukeys @.usages { 0 get } map shell def name { /key set [(regexec) key ukeys] extension { 0 get } map } map /sss set exit @@ -4321,6 +4340,26 @@ $ [ff ff] fromVectors :: $ [(key usages usages-as-a-string) (num usages list-of-key-words) ([key1 key2 ... ] usages list-of-key-words : it accepts regular expressions.) +]] 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 ;