===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v
retrieving revision 1.39
retrieving revision 1.49
diff -u -p -r1.39 -r1.49
--- OpenXM/src/kan96xx/Kan/dr.sm1	2004/09/12 02:47:45	1.39
+++ OpenXM/src/kan96xx/Kan/dr.sm1	2005/06/16 06:21:21	1.49
@@ -1,4 +1,4 @@
-% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.38 2004/09/11 01:00:42 takayama Exp $
+% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.48 2005/02/27 05:28:06 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
@@ -1526,6 +1528,13 @@
   (type?) data_conversion  RingP eq
 } def
 
+[(isByteArray)
+ [(obj isByteArray bool) ]
+] putUsages
+/isByteArray {
+  (type?) data_conversion  ByteArrayP eq
+} def
+
 /toString.tmp {
   /arg1 set
   [/obj /fname] pushVariables
@@ -1555,6 +1564,8 @@
     { obj (string) data_conversion } { } ifelse
     obj isRational
     { obj (string) data_conversion } { } ifelse
+    obj isByteArray
+    { obj (array) data_conversion toString } { } ifelse
     obj tag 0 eq
     { (null) } { } ifelse
 
@@ -1669,9 +1680,10 @@
 /RationalFunctionP 16 def
 /ClassP 17 def
 /DoubleP 18 def
+/ByteArrayP 19 def
 /@.datatypeConstant.usage [
  (IntegerP, LiteralP, StringP, ExecutableArrayP, ArrayP, PolyP, FileP, RingP,)
- (UniversalNumberP, RationalFunctionP, ClassP, DoubleP)
+ (UniversalNumberP, RationalFunctionP, ClassP, DoubleP, ByteArrayP)
  (      return data type identifiers.)
  (Example:  7 tag IntegerP eq  ---> 1)
 ] def
@@ -1686,6 +1698,7 @@
 [(RationalFunctionP) @.datatypeConstant.usage ] putUsages
 [(ClassP) @.datatypeConstant.usage ] putUsages
 [(DoubleP) @.datatypeConstant.usage ] putUsages
+[(ByteArrayP) @.datatypeConstant.usage ] putUsages
 
 [(__)
  [( string ring __ polynomial)
@@ -1718,8 +1731,9 @@
  [( string .. universalNumber)
   (Parse the << string >> as a universalNumber.)
   (Example:  (123431232123123).. /n set)
+  ({ commands }..  executes the commands.  << .. >> is equivalent to exec.)
 ]] putUsages
-/.. { (universalNumber) data_conversion } def
+/.. { dup tag 3 eq { exec } { (universalNumber) data_conversion} ifelse } def
 
 [(dc) 
  [(Abbreviation of data_conversion.)
@@ -4151,15 +4165,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 +4206,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 {
@@ -4252,9 +4283,7 @@ $ [ff ff] fromVectors :: $ 
 [(list listToArray a)
 ]] putUsages
 
-/makeInfix {
-  [(or_attr) 4   4 -1 roll ] extension
-} def
+% Body is moved to smacro.sm1
 [(makeInfix)
 [(literal makeInfix)
  (Change literal to an infix operator.)
@@ -4266,14 +4295,22 @@ $ [ff ff] fromVectors :: $ 
 
 /usages {
   /arg1 set
-  [/name /flag /n /k /slist /m /i /sss] pushVariables
+  [/name /flag /n /k /slist /m /i /sss /key /ukeys] pushVariables
   [
     /name arg1 def
     /flag true def
+    {  % begin loop
 
- %BUG: should use regular expression in a future.
+       name isArray {
+         /ukeys @.usages { 0 get } map shell def
+         name { /key set [(regexec) key ukeys] extension
+                { 0 get } map } map /sss set
+         exit
+       } {  } ifelse
+
  name tag 1 eq { 
    @.usages { 0 get } map shell { (, ) nl } map /sss set
+   exit
  } { 
 
     /sss [ ] def
@@ -4300,7 +4337,10 @@ $ [ff ff] fromVectors :: $ 
    {name Usage  /sss [(Usage of ) name ( could not obtained.) nl ] def}
    { }
    ifelse
+   exit
  } ifelse
+
+} loop
    /arg1 sss cat def
    ] pop
    popVariables
@@ -4309,8 +4349,97 @@ $ [ff ff] fromVectors :: $ 
 [(usages)
  [(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
+
+% 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
 ;