===================================================================
RCS file: /home/cvs/OpenXM/src/k097/lib/minimal/new.sm1,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- OpenXM/src/k097/lib/minimal/new.sm1	2000/06/14 07:44:05	1.1
+++ OpenXM/src/k097/lib/minimal/new.sm1	2000/08/01 03:42:35	1.2
@@ -1,3 +1,118 @@
-% $OpenXM$
+% $OpenXM: OpenXM/src/k097/lib/minimal/new.sm1,v 1.1 2000/06/14 07:44:05 takayama Exp $
 %% These functions should be moved to complex.sm1
 %% homogenize<m>, ord_w<m>, init<m>, ...
+
+/.toSm1Integer {
+  /arg1 set
+  [/in-.toSm1Integer /ans /v] pushVariables
+  [
+    /v arg1 def
+    /ans v def
+    v isArray {
+     v { .toSm1Integer } map /ans set
+    }{  } ifelse
+    v isUniversalNumber {
+       v (integer) dc /ans set
+    }{  } ifelse
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+/.toUniversalNumber {
+  /arg1 set
+  [/in-.toUniversalNumber /ans /v] pushVariables
+  [
+    /v arg1 def
+    /ans v def
+    v isArray {
+     v { .toUniversalNumber } map /ans set
+    }{  } ifelse
+    v isInteger {
+       v (universalNumber) dc /ans set
+    }{  } ifelse
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+
+/ord_w<m>  {
+  /arg3 set /arg2 set /arg1 set
+  [/in-ord_w<m>  /f /weight /shift /www ] pushVariables
+  [
+    /f arg1 def
+    /weight arg2 def
+    /shift arg3 def
+    weight .toSm1Integer /weight set
+    shift  .toSm1Integer /shift  set
+    f isArray {
+      f { weight ord_w } map /www set
+    }{
+      [f weight ord_w ] /www set
+    }ifelse
+    www shift add /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+[(ord_w<m>)
+[(f weight shift ord_w<m> w)
+ (It returns the ord_w with the shift vector shift.)
+ (Example 1:)
+ $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
+ $    define_ring $
+ $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] ord_w<m> ::$
+]] putUsages
+
+
+/init_w<m>  {
+  /arg3 set /arg2 set /arg1 set
+  [/in-init_w<m>  /f /fv /weight /shift /www 
+   /maxw /i /ans /tmp] pushVariables
+  [
+    /f arg1 def
+    /weight arg2 def
+    /shift arg3 def
+    weight .toSm1Integer /weight set
+    shift  .toSm1Integer /shift  set
+    f isArray {
+      f { weight ord_w } map /www set
+      /fv f def
+    }{
+      [f weight ord_w ] /www set
+      /fv [f] def
+    }ifelse
+    www shift add /www set
+    /maxw www 0 get def
+    0 1 www length 1 sub {
+      /i set
+      www i get maxw gt {
+       /maxw www i get def
+      } { } ifelse
+    } for
+    /ans [ 0 1 www length 1 sub { pop (0). } for ] def
+    0 1 www length 1 sub {
+      /i set
+      www i get maxw eq {
+        fv i get weight weightv init /tmp set
+        ans i tmp put
+      }{ } ifelse    
+    }for
+    f isArray {
+      /arg1 ans def
+    }{
+      /arg1 ans 0 get def
+    } ifelse
+  ] pop
+  popVariables
+  arg1
+} def
+[(init_w<m>)
+[(f weight shift init_w<m> w)
+ (It returns the initial with the shift vector shift and the weight)
+ (Example 1:)
+ $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
+ $    define_ring $
+ $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] init_w<m> ::$
+]] putUsages