===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v
retrieving revision 1.29
retrieving revision 1.36
diff -u -p -r1.29 -r1.36
--- OpenXM/src/kan96xx/Kan/dr.sm1	2004/08/22 12:52:34	1.29
+++ OpenXM/src/kan96xx/Kan/dr.sm1	2004/09/09 11:42:22	1.36
@@ -1,4 +1,4 @@
-% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.28 2004/05/13 05:33:10 takayama Exp $
+% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.35 2004/09/09 03:14:46 takayama Exp $
 %% dr.sm1 (Define Ring) 1994/9/25, 26
 %% This file is error clean.
 
@@ -361,6 +361,8 @@
   [
     /mat arg1 def
     /m mat length def
+  { 
+    m 0 eq { /ans [ ] def exit } { } ifelse
     mat 0 get isArray 
     {   }
     { (transpose: Argument must be an array of arrays.) error }
@@ -374,6 +376,8 @@
          ans [ j i ]  <<  mat i get j get >> put
       } for
     } for
+    exit
+   } loop
    /arg1 ans def
   ] pop
   popVariables
@@ -1328,6 +1332,7 @@
     /univ vars 0 get reverse
           vars 1 get reverse join
     def
+    w-vectors to_int32 /w-vectors set
     [
     0 1 << w-vectors length 1 sub >> 
     {
@@ -1350,7 +1355,8 @@
   /arg2 set  /arg1 set
   [/univ /www /k /vname /vweight /ans] pushVariables
   /univ arg1 def /www arg2 def
-  [ 
+  [
+    www to_int32 /www set 
     /ans << univ length >> -1 0 evecw def
     0  2  << www length 2 sub >>
     {
@@ -1923,8 +1929,8 @@ newline
 } def
 %%end of function
 
-/rest { % returns remainder of a given list
-  [ 2 1 roll  aload length -1 roll pop ]
+/rest {
+  /arg1 set [(Krest) arg1] extension 
 } def
 [(rest)
  [(array rest the-rest-of-the-array)
@@ -2522,6 +2528,7 @@ newline
   [
     /fff arg1 def
     /www arg2 def
+    www to_int32 /www set
     fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse
     fff (ring) dc /rrr set
     fff init /fff set
@@ -2553,6 +2560,7 @@ newline
   [
     /fff arg1 def
     /www arg2 def
+    www to_int32 /www set
     fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse
     /ddd -intInfinity def
     fff (ring) dc /rrr set
@@ -3657,6 +3665,34 @@ $ [ff ff] fromVectors :: $ 
  (         ff to_int { tag } map :: )
 ]] putUsages
 
+/to_int32 {
+  /arg1 set
+  [/to-int32 /ob /ans] pushVariables
+  [
+    /ob arg1 def
+    /ans ob def
+    ob isArray {
+      ob {to_int32} map /ans set
+      /LLL.to_int32 goto
+    } {  } ifelse
+    ob isUniversalNumber {
+      ob (integer) dc /ans set
+      /LLL.to_int32 goto
+    } {  } ifelse
+    /LLL.to_int32
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+[(to_int32)
+[(obj to_int32 obj2)
+ $All universalNumber in obj are changed to integer (int32).$
+ (Example: /ff [1 (2).. [(hello) (0).]] def  ff { tag } map ::)
+ (         ff to_int32 { tag } map :: )
+ (cf. to_int, to_univNum )
+]] putUsages
+
 /define_ring_variables {
   [/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables
 %% You cannot use these names for names for polynomials.
@@ -3877,7 +3913,7 @@ $ [ff ff] fromVectors :: $ 
 [(to_univNum) 
 [(obj to_univNum obj2)
  (Example. [ 2 (3).. ] to_univNum)
- (cf. to_int)
+ $cf. to_int32. (to_int)$
 ]] putUsages
 
 [(lcm)
@@ -3954,6 +3990,7 @@ $ [ff ff] fromVectors :: $ 
  [ ([a b c ...] denominator r)
    ( a denominator r )
    (cf. dc, numerator)
+   (Output is Z or a polynomial.)
  ]
 ] putUsages
 % test data.
@@ -3964,6 +4001,7 @@ $ [ff ff] fromVectors :: $ 
   [/pp /dd /ii /rr] pushVariables
   [
     /pp arg1 def
+    pp to_univNum /pp set
     {
       pp isArray {
         pp { denominator } map /dd set        
@@ -3986,6 +4024,7 @@ $ [ff ff] fromVectors :: $ 
  [ ([a b c ...] numerator r)
    ( a numerator r )
    (cf. dc, denominator)
+   (Output is a list of Z or polynomials.)
  ]
 ] putUsages
 % test data.
@@ -3994,11 +4033,12 @@ $ [ff ff] fromVectors :: $ 
   [/pp /dd /ii /rr] pushVariables
   [
     /pp arg1 def
+    pp to_univNum /pp set
     {
       pp isArray {
         pp denominator /dd set        
         pp dd mul /rr set
-        rr reduce /rr set
+        rr cancel /rr set
         exit
       } {  } ifelse
 
@@ -4012,7 +4052,7 @@ $ [ff ff] fromVectors :: $ 
   arg1
 } def 
 
-/reduce.Q {
+/cancel.Q {
   /arg1 set
   [/aa /rr /nn /dd /gg]  pushVariables
   [
@@ -4039,7 +4079,7 @@ $ [ff ff] fromVectors :: $ 
   arg1
 } def 
 
-/reduce.one {
+/cancel.one {
   /arg1 set
   [/aa /rr /nn /dd /gg]  pushVariables
   [
@@ -4049,9 +4089,9 @@ $ [ff ff] fromVectors :: $ 
         aa (numerator) dc /nn set
         aa (denominator) dc /dd set
         nn isUniversalNumber dd isUniversalNumber and {
-          /rr aa reduce.Q def
+          /rr aa cancel.Q def
           exit
-        } { (reduce: not implemented) error } ifelse
+        } { (cancel: not implemented) error } ifelse
       } { } ifelse
 
       /rr aa def
@@ -4063,26 +4103,105 @@ $ [ff ff] fromVectors :: $ 
   arg1
 } def 
 
-[(reduce)
- [ (obj reduce r)
+[(cancel)
+ [ (obj cancel r)
    (Cancel numerators and denominators)
    (The implementation has not yet been completed. It works only for Q.) 
 ]] putUsages
-/reduce {
+/cancel {
   /arg1 set
   [/aa /rr] pushVariables
   [ 
     /aa arg1 def
     aa isArray {
-      aa {reduce} map /rr set
+      aa {cancel} map /rr set
     } { 
-      aa reduce.one /rr set
+      aa cancel.one /rr set
     } ifelse
     /arg1 rr def
   ] pop
   popVariables
   arg1
 } def
+
+/nnormalize_vec {
+  /arg1 set
+  [/pp /rr /dd ] pushVariables
+  [
+    /pp arg1 def
+    pp denominator /dd set
+    dd (0).. lt { (nnormalize_vec: internal error) error } { } ifelse
+    pp numerator dd mul cancel /pp set
+    /@@@.nnormalize_vec_c dd def
+    pp gcd /dd set
+    dd (0).. lt { (nnormalize_vec: internal error) error } { } ifelse
+    pp (1).. dd div mul cancel /rr set
+    @@@.nnormalize_vec_c dd div cancel /@@@.nnormalize_vec_c set
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def
+[(nnormalize_vec)
+[(pp nnormalize_vec npp)
+ (It normalizes a given vector of Q into a vector of Z with relatively prime)
+ (entries by multiplying a postive number.)
+]] putUsages
+
+/getNode {
+  /arg2 set
+  /arg1 set
+  [/in-getNode /ob /key /rr /rr /ii] pushVariables
+  [
+    /ob arg1 def
+    /key arg2 def
+    /rr null def
+    {
+      ob isClass {
+        ob (array) dc /ob set
+      } { exit } ifelse
+      ob 0 get key eq {
+        /rr ob def
+        exit
+      } {  } ifelse
+      ob 2 get /ob set
+      0 1 ob length 1 sub {
+         /ii set
+         ob ii get key getNode /rr set
+         rr tag 0 eq { } { exit } ifelse
+      } for 
+      exit
+    } loop 
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def
+[(getNode)
+[(ob key getNode)
+ (ob is a class object.)
+ (The operator getNode returns the node with the key in ob.)
+ (The node is an array of the format [key attr-list node-list])
+ (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 )
+]] putUsages 
+
+/cons {
+  /arg2 set /arg1 set
+  [/aa /bb] pushVariables
+  [
+    /aa arg1 def /bb arg2 def
+    [aa] (list) dc bb join /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+[(cons)
+[(obj list cons list)
+]] putUsages
 
 /usages {
   /arg1 set