===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v
retrieving revision 1.31
retrieving revision 1.35
diff -u -p -r1.31 -r1.35
--- OpenXM/src/kan96xx/Doc/ecart.sm1	2004/08/31 04:45:42	1.31
+++ OpenXM/src/kan96xx/Doc/ecart.sm1	2004/09/14 03:12:17	1.35
@@ -1,14 +1,15 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.30 2004/07/29 08:13:42 takayama Exp $ 
+% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.34 2004/09/13 11:24:10 takayama Exp $ 
 (hol_loaded) boundp { }
 { [(parse) (hol.sm1) pushfile] extension } ifelse
 %[(parse) (appell.sm1) pushfile] extension
 
-(ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
+(ecart.sm1 : ecart division for D, 2003/07/25, 2004/09/14 ) message-quiet
 /ecart.begin { beginEcart } def
 /ecart.end   { endEcart } def
 /ecart.autoHomogenize 1 def
 /ecart.needSyz 0 def
 /ecartd.gb.oxRingStructure [[ ] [ ] ] def
+/ecart.partialEcartGlobalVarX [ ] def
 
 /ecartd.begin { 
   ecart.begin
@@ -26,6 +27,10 @@
 /ecart.messagen {
   ecart.message.quiet { pop } { messagen } ifelse
 } def
+/ecart.setOpt.init {
+% Initialize
+    /ecart.partialEcartGlobalVarX [ ] def
+} def
 /ecart.setOpt {
   /arg1 set
   [/in-ecart.setOpt /opt /i /n /ans] pushVariables
@@ -33,6 +38,9 @@
     /opt arg1 def
     /ans [ ] def
     /n opt length def
+
+    ecart.setOpt.init 
+
     0 2 n 1 sub {
       /i set
       opt i get tag StringP eq not {
@@ -60,7 +68,13 @@
         exit
       } {  } ifelse
 
-      ans [opt i get opt i 1 add get ]  append /ans set
+% Global:  ecart.partialEcartGlobalVarX
+      opt i get (partialEcartGlobalVarX) eq {
+        /ecart.partialEcartGlobalVarX opt , i 1 add , get def
+        % do not exit.
+      } {  } ifelse
+
+      ans [opt i get opt i 1 add get ]  join /ans set
       exit
      } loop
     } for 
@@ -90,8 +104,8 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] 
-            [ (h) rr ,, (1) rr ,, ]] replace
+       ll [ [ @@@.Hsymbol rr __ (1) rr __ ] 
+            [ (h) rr __ (1) rr __ ]] replace
        /ll set
      } ifelse
    } ifelse
@@ -116,7 +130,7 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace
+       ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace
        /ll set
      } ifelse
    } ifelse
@@ -269,6 +283,12 @@
   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  $
   $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
   (  )
+  $Example 6:  [ [(1-z) (-x+1-y-z)] (x,y,z)  $
+  $              [[(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]] $
+  $              [(partialEcartGlobalVarX) [(x)]] ] /std set $
+  $             std ecart.gb pmat ; $
+  $             std ecart.gb getRing :: $
+  (  )
   (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
   (    ecart.dehomogenize, ecart.dehomogenizeH)
   ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
@@ -297,6 +317,7 @@
     /hdShift 0 def 
     /opt [(weightedHomogenization) 1] def
     /ecart.useSugar 0 def
+    ecart.setOpt.init
     aa { tag } map /typev set
     typev [ ArrayP ] eq
     {  /f aa 0 get def
@@ -419,7 +440,7 @@
     } { } ifelse
 
     %%BUG: case of v is integer
-    v ecart.checkOrder
+    [v ecart.partialEcartGlobalVarX] ecart.checkOrder
 
     ecart.begin
 
@@ -599,6 +620,7 @@
     /wv 0 def
     /degreeShift 0 def
     /opt [(weightedHomogenization) 1] def
+    ecart.setOpt.init
     aa { tag } map /typev set
     typev [ ArrayP ] eq
     {  /f aa 0 get def
@@ -718,7 +740,7 @@
     } { } ifelse
 
     %%BUG: case of v is integer
-    v ecart.checkOrder
+    [v ecart.partialEcartGlobalVarX] ecart.checkOrder
 
     ecartn.begin
 
@@ -796,6 +818,7 @@
     /hdShift 0 def
     /ecart.useSugar 0 def
     /opt [(weightedHomogenization) 1] def
+    ecart.setOpt.init
     aa { tag } map /typev set
     typev [ ArrayP ] eq
     {  /f aa 0 get def
@@ -908,8 +931,9 @@
     } { } ifelse
 
     %%BUG: case of v is integer
-    v ecart.checkOrder
+    [v ecart.partialEcartGlobalVarX] ecart.checkOrder
 
+
     ecartd.begin
 
     ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
@@ -989,9 +1013,23 @@
 
 /ecart.checkOrder {
   /arg1 set
-  [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
+  [/vv] pushVariables
   [
     /vv arg1 def
+    vv length 1 eq {
+      vv 0 get ecart.checkOrder.noGlobal /arg1 set
+    }{
+      vv ecart.checkOrder.global /arg1 set
+    } ifelse
+  ] pop
+  popVariables
+  /arg1
+} def
+/ecart.checkOrder.noglobal {
+  /arg1 set
+  [/vv /tt /dd /n /i] pushVariables
+  [
+    /vv arg1 def
     vv isArray
     { } { [vv to_records pop] /vv set } ifelse
     vv {toString} map /vv set
@@ -1015,8 +1053,54 @@
   popVariables
   arg1
 } def
+
+/ecart.checkOrder.global {
+  /arg1 set
+  [/vv /vvGlobal /tt /dd /n /i] pushVariables
+  [
+    /vv arg1 def
+    /vvGlobal vv 1 get def
+    vv 0 get /vv set
+    vv isArray
+    { } { [vv to_records pop] /vv set } ifelse
+    vv {toString} map /vv set
+    vvGlobal isArray
+    { } { [vvGlobal to_records pop] /vvGlobal set } ifelse
+    vvGlobal {toString} map /vv set
+
+    vv vvGlobal setMinus /vv set
+    vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
+    % Starting the checks.  Check for local variables.
+    0 1 vv length 1 sub {
+       /i set
+       vv i get . dd i get . mul /tt set
+       tt @@@.hsymbol . add init tt eq { }
+       { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
+    } for
+
+    0 1 vv length 1 sub {
+       /i set
+       vv i get . /tt set
+       tt (1). add init (1). eq { }
+       { [vv i get ( is larger than 1 ) ] cat error} ifelse
+    } for
+
+    % check for global variables. 
+    0 1 vvGlobal length 1 sub {
+       /i set
+       vvGlobal i get . /tt set
+       tt (1). add init (1). eq { [vvGlobal i get ( is smaller than 1 ) ] cat error }
+       { } ifelse
+    } for
+
+
+    /arg1 1 def
+  ] pop
+  popVariables
+  arg1
+} def
 [(ecart.checkOrder)
- [(v ecart.checkOrder bool checks if the given order is relevant)
+ [([v vGlobal] ecart.checkOrder bool checks if the given order is relevant)
   (for the ecart division.)
   (cf. ecartd.gb, ecart.gb, ecartn.gb)
  ]
@@ -1557,7 +1641,7 @@
     /univ vars 0 get reverse
           vars 1 get reverse join
     def
-    w-vectors to_int /w-vectors set
+    w-vectors to_int32 /w-vectors set
     [
     0 1 << w-vectors length 1 sub >> 
     {
@@ -1593,11 +1677,11 @@
        /gbasis2 gbasis 0 get def
      } {
        [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def
-       /gbasis2 gbasis 0 get ,,, def
+       /gbasis2 gbasis 0 get ___ def
      } ifelse
      ecartd.begin
 
-     flist ,,, /flist set
+     flist ___ /flist set
      flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set
      }{
@@ -1659,11 +1743,11 @@
        /gbasis2 gbasis 0 get def
      } {
        [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def
-       /gbasis2 gbasis 0 get ,,, def
+       /gbasis2 gbasis 0 get ___ def
      } ifelse
      ecarth.begin
 
-     flist ,,, /flist set
+     flist ___ /flist set
      flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set
      }{
@@ -1849,14 +1933,14 @@
    vv isArray { vv from_records /vv set } {  } ifelse
    vv ecart.01Order /wv set
    [vv ring_of_differential_operators 0] define_ring
-   ll ,,, /ll set ll dehomogenize /ll set
+   ll ___ /ll set ll dehomogenize /ll set
    [ll vv wv] gb 0 get /ll set
 
    ecart.begin
    [vv ring_of_differential_operators
     vv ecart.stdOrder weight_vector 0
     [(weightedHomogenization) 1]] define_ring
-   ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
+   ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
    ecart.end
    /arg1 ans def
  ] pop