===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- OpenXM/src/kan96xx/Doc/hol.sm1	1999/10/08 02:12:02	1.1
+++ OpenXM/src/kan96xx/Doc/hol.sm1	1999/12/07 09:35:22	1.2
@@ -1,3 +1,4 @@
+% $OpenXM$
 %% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5.
 %% rank, rrank, characteristic
 %% This file is error clean.
@@ -9,7 +10,7 @@ hol.version [(Version)] system_variable gt
   error
 } { } ifelse
 
-$hol.sm1, basic package for holonomic systems (C) N.Takayama, 1999, 6/05 $ 
+$hol.sm1, basic package for holonomic systems (C) N.Takayama, 1999, 12/07 $ 
 message-quiet
 
 /rank.v [(x) (y) (z)] def   %% default value of v (variables).
@@ -1163,7 +1164,116 @@ message-quiet
  $Example 2:  [(x^2+y^2+z^2) (x,y,z)] genericAnnWithL ::$
  $Example 3:  [(x^3-y^2 z^2) (x,y,z)] genericAnnWithL ::$
 ]] putUsages
- 
+
+/reduction*.noH 0 def
+/reduction* {
+  /arg1 set
+  [/in-reduction* /aa /typev /setarg /f /v 
+   /gg /wv /termorder /vec /ans /rr /mm /h /size /a0 /a3
+  ] pushVariables 
+  [(CurrentRingp) (KanGBmessage)] pushEnv
+  [
+
+    /aa arg1 def
+    aa isArray { } { ( << array >> reduction*) error } ifelse
+    /setarg 0 def
+    /wv 0 def
+    aa { tag } map /typev set
+    typev [StringP ArrayP ArrayP] eq
+    typev [ArrayP ArrayP ArrayP] eq or
+    typev [PolyP ArrayP ArrayP] eq or
+    {  /h aa 0 get def
+       /f aa 1 get def
+       /v aa 2 get from_records def
+       /setarg 1 def
+    } { } ifelse
+    typev [StringP ArrayP ArrayP ArrayP] eq
+    typev [ArrayP ArrayP ArrayP ArrayP] eq or
+    typev [PolyP ArrayP ArrayP ArrayP] eq or
+    {  /h aa 0 get def
+       /f aa 1 get def
+       /v aa 2 get from_records def
+       /wv aa 3 get def
+       /setarg 1 def
+    } { } ifelse
+
+    setarg { } { (reduction* : Argument mismatch) error } ifelse
+    
+    [(KanGBmessage) gb.verbose ] system_variable
+
+    %%% Start of the preprocess
+    f getRing /rr set
+    
+
+    rr tag 0 eq {
+      %% Define our own ring
+      v isInteger {
+        (Error in reduction*: Specify variables) error
+      } {  } ifelse
+      wv isInteger {        
+        [v ring_of_differential_operators 
+        0] define_ring
+        /termorder 1 def
+      }{
+        [v ring_of_differential_operators 
+         wv weight_vector
+        0] define_ring
+        wv gb.isTermOrder /termorder set
+      } ifelse
+    } {
+      %% Use the ring structre given by the input.
+      v isInteger not {
+        (Warning : the given ring definition is not used.) message
+      } {  } ifelse
+      rr ring_def
+      /wv rr gb.getWeight def
+      wv gb.isTermOrder /termorder set
+    } ifelse
+    %%% Enf of the preprocess
+
+    f 0 get isArray {
+      /size f 0 get length def
+      f { { toString . } map } map /f set
+      f fromVectors /f set
+    }{
+      /size -1 def
+      f { toString . } map /f set
+    } ifelse 
+
+    h isArray {
+      h { toString . } map /h set
+      [h] fromVectors 0 get /h set
+    }{ 
+      h toString . /h set
+    } ifelse
+    f { toString . } map /f set
+    reduction*.noH {
+      h f reduction-noH /ans set
+    } {
+      h f reduction /ans set
+    } ifelse
+    size -1 eq not {
+      [size ans 0 get] toVectors /a0 set
+      [size ans 3 get] toVectors /a3 set
+      /ans [a0 ans 1 get ans 2 get a3] def
+    } { } ifelse
+    /arg1 ans def
+  ] pop
+  popEnv
+  popVariables
+  arg1  
+} def 
+
+
+[(reduction*)
+[([f base v] reduction* [h c0 syz input])
+ ([f base v weight] reduction* [h c0 syz input])
+ (reduction* is an user interface for reduction and reduction-noH.)
+ (If reduction*.noH is one, then reduction-noH will be called.)
+ (Example 1: [(x^2) [(x^2+y^2-4) (x y-1)] [(x) (y)]] reduction* )
+ (Example 2: [[(1) (y^2-1)] [ [(0) (y-1)] [(1) (y+1)]] [(x) (y)]] reduction*)
+ (Example 3: [(x^2) [(x^2+y^2-4) (x y-1)] [(x) (y)] [[(x) 10]] ] reduction* )
+]] putUsages
 
 ( ) message-quiet ;