===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v
retrieving revision 1.1.1.1
retrieving revision 1.47
diff -u -p -r1.1.1.1 -r1.47
--- OpenXM/src/kan96xx/Kan/dr.sm1	1999/10/08 02:12:02	1.1.1.1
+++ OpenXM/src/kan96xx/Kan/dr.sm1	2004/09/20 02:11:22	1.47
@@ -1,8 +1,9 @@
+% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.46 2004/09/17 00:47:08 takayama Exp $
 %% dr.sm1 (Define Ring) 1994/9/25, 26
 %% This file is error clean.
 
 @@@.quiet {   }
-{ (macro package : dr.sm1,   9/26,1995 --- Version 9/8, 1999. ) message } ifelse
+{ (macro package : dr.sm1,   9/26,1995 --- Version 12/10, 2000. ) message } ifelse
 
 /ctrlC-hook {
 %%% define your own routing in case of error.
@@ -49,7 +50,7 @@
           } for
      ] /dList set
 
-     [(H)] xList join [@@@.esymbol] join /xList set
+     [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set
      [0 %% dummy characteristic
       << xList length >> << xList length >> << xList length >> 
@@ -166,7 +167,7 @@
      vars reverse /xList set         %[z y x]
      vars {@@@.Dsymbol 2 1 roll 2 cat_n} map
      reverse /dList set              %[Dz Dy Dx]
-     [(H)] xList join [@@@.esymbol] join /xList set
+     [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set
      [0 1 1 1 << xList length >>
         1 1 1 << xList length 1 sub >> ] /param set
@@ -256,6 +257,8 @@
   /arg1 set
   [/vars /n /i /xList /dList /param] pushVariables
   [
+     (This is an obsolete macro. Use ring_of_differential_difference_operators)
+      error 
      (mmLarger) (matrix) switch_function
      (mpMult)   (difference) switch_function
      (red@)     (module1) switch_function
@@ -266,7 +269,7 @@
      vars reverse /xList set         %[z y x]
      vars {@@@.diffEsymbol 2 1 roll 2 cat_n} map
      reverse /dList set              %[Dz Dy Dx]
-     [(H)] xList join [@@@.esymbol] join /xList set
+     [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set
      [0 1 1 << xList length >> << xList length >>
         1 1 << xList length 1 sub >> << xList length >> ] /param set
@@ -277,7 +280,44 @@
 } def
 
 
+/ring_of_differential_difference_operators {
+  /arg1 set
+  [/vars /n /i /xList /dList /param /dvar /evar /vars2 ] pushVariables
+  [
+     /vars arg1 def
+     vars tag 6 eq not {
+       ( List is expected as the argument for ring_of_differential_difference_operators ) error
+     } { } ifelse
+     vars 0 get /dvar set
+     vars 1 get /evar set
+     (mmLarger) (matrix) switch_function
+     (mpMult)   (difference) switch_function
+     (red@)     (module1) switch_function
+     (groebner) (standard) switch_function
+     (isSameComponent) (x) switch_function
 
+     [dvar to_records pop] /vars set %[x y z]
+     vars reverse /xList set         %[z y x]
+
+     [evar to_records pop] /vars2 set %[s1 s2]
+
+     vars2 reverse  {@@@.Esymbol 2 1 roll 2 cat_n} map
+     xList 
+     join /xList set   %[Es2 Es1 z y x]
+
+     vars2 reverse
+     vars {@@@.Dsymbol 2 1 roll 2 cat_n} map
+     reverse join /dList set              %[s2 s1 Dz Dy Dx]
+     [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
+     [(h)] dList join [@@@.Esymbol] join /dList set
+     [0 1 1 << vars2 length 1 add >>  << xList length >>
+        1 1 << vars2 length 1 add >> << xList length 1 sub >> ] /param set
+     [ xList dList param ] /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+
 /reverse {
   /arg1 set
   arg1 length 1 lt
@@ -302,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
@@ -321,6 +363,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 }
@@ -334,6 +378,8 @@
          ans [ j i ]  <<  mat i get j get >> put
       } for
     } for
+    exit
+   } loop
    /arg1 ans def
   ] pop
   popVariables
@@ -747,7 +793,7 @@
    (    Pointer to the ring. )
    (Example: [$x,y$ ring_of_q_difference_operators $Qx,Qy$ elimination_order)
    (          0] define_qring )
-   (cf. define_ring, set_up_ring@ <coefficient ring>, ring_def, << ,, >>)
+   (cf. define_ring, set_up_ring@ <coefficient ring>, ring_def, << __ >>)
   ]
 ] putUsages
 /define_qring {
@@ -799,7 +845,7 @@
   (one may use the command )
   (          f (ring) data_conversion /R set)
   (cf. define_ring, define_qring, system_variable, poly (ring) data_conversion)
-  (cf. << ,, >>)
+  (cf. << __ >>)
  ]
 ] putUsages
 
@@ -1288,6 +1334,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 >> 
     {
@@ -1310,7 +1357,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 >>
     {
@@ -1365,7 +1413,7 @@
        gg (0). eq 
        { 0 }
        { gg (ring) data_conversion /rr set 
-         gg  << var rr ,, >> degree
+         gg  << var rr __ >> degree
        } ifelse
     } map def
   %%degs message
@@ -1473,6 +1521,20 @@
   (type?) data_conversion  RationalFunctionP eq
 } def
 
+[(isRing)
+ [(obj isRing bool) ]
+] putUsages
+/isRing {
+  (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
@@ -1502,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
 
@@ -1527,7 +1591,7 @@
     /obj arg1 def
     obj isArray 
     { 
-       ( [ )
+       [(LeftBracket)] system_variable %%( [ )
        obj {toString.tmp2} map /r set
        /n r length 1 sub def
        [0 1  n  {
@@ -1539,7 +1603,7 @@
           ifelse
         } for
        ] aload length cat_n
-       ( ] )
+       [(RightBracket)] system_variable %%( ] )
        3 cat_n
      }
      {
@@ -1616,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
@@ -1633,18 +1698,19 @@
 [(RationalFunctionP) @.datatypeConstant.usage ] putUsages
 [(ClassP) @.datatypeConstant.usage ] putUsages
 [(DoubleP) @.datatypeConstant.usage ] putUsages
+[(ByteArrayP) @.datatypeConstant.usage ] putUsages
 
-[(,,)
- [( string ring ,, polynomial)
+[(__)
+ [( string ring __ polynomial)
   (Parse the <<string>> as an element in the <<ring>> and returns)
   (the polynomial.)
   (cf. define_ring, define_qring, ring_def)
   (Example: [(x,y) ring_of_polynomials [[(x) 1]] weight_vector 7]define_ring)
   (         /myring set)
-  (         ((x+y)^4) myring ,, /f set)
+  (         ((x+y)^4) myring __ /f set)
 ]] putUsages
  
-/,, {
+/__ {
   /arg2 set /arg1 set
   [/rrr] pushVariables
   [ arg1 tag StringP eq
@@ -1654,7 +1720,7 @@
       /arg1 arg1 expand def
       [(CurrentRingp) rrr] system_variable
     }
-    {(Argument Error for ,, ) error }
+    {(Argument Error for __ ) error }
     ifelse
   ] pop
   popVariables
@@ -1665,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.)
@@ -1719,7 +1786,11 @@
   /arg1 set
   [/f /k /i /ans] pushVariables
   [
-     /ans (1).. def
+   /ans (1).. def
+   [(QuoteMode)] system_variable {
+     /f arg1 def   /k arg2 def
+     [(ooPower) f k] extension /ans set
+   } {
      /f arg1 def   /k arg2 ..int def
      k 0 lt {
        1 1 << 0 k sub >> {
@@ -1732,7 +1803,8 @@
          /ans f ans {mul} sendmsg2 def
        } for
      } ifelse
-     /arg1 ans def
+   } ifelse
+   /arg1 ans def
   ] pop
   popVariables
   arg1
@@ -1871,8 +1943,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)
@@ -1895,7 +1967,7 @@ newline
         error
      } ifelse
      /myring  base 0 get (ring) dc def
-     /zero (0) myring ,, def
+     /zero (0) myring __ def
      base length 1 sub /n set
      /minbase [ 0 1 n { /i set base i get } for ] def
      0 1 n {
@@ -2204,7 +2276,7 @@ newline
         [(variableNames) M2N 0 get] system_variable
         f toString /f2 set
         [(variableNames) M2N 3 get] system_variable
-        f2 M2N 2 get ,, /f2 set
+        f2 M2N 2 get __ /f2 set
     } ifelse
     [(CurrentRingp) cp] system_variable
     /arg1 f2 def
@@ -2230,7 +2302,7 @@ newline
   $/R2 set$
   $[[(x) (Dx)] [((t-1) Dt) (z)]] /r0 set$
   $r0 R1 R2 makeRingMap /maptable set$
-  $(Dx-1) R1 ,, /ff set$
+  $(Dx-1) R1 __ /ff set$
   $ ff maptable ringmap :: $
  ]
 ] putUsages
@@ -2275,7 +2347,7 @@ newline
 
 /tolower.aux {
   /arg1 set
-  arg1 64 gt  arg1 96 lt and
+  arg1 64 gt  arg1 91 lt and
   { arg1 32 add }
   { arg1 } ifelse
 } def
@@ -2316,7 +2388,7 @@ newline
        /rrr set
        base { . } map /base set
      } ifelse
-     vlist { dup isPolynomial {  } { rrr ,, } ifelse } map /vlist set
+     vlist { dup isPolynomial {  } { rrr __ } ifelse } map /vlist set
 
      [(hilbert) base vlist] extension /ff set
      [(CurrentRingp) rrrorg] system_variable
@@ -2335,7 +2407,7 @@ newline
      /vv arg2 def
      /f hhh 1 get def
      f (0). eq { /ans [0] def /hilbReduce.label goto } { } ifelse
-     f vv << f (ring) dc >> ,,  degree /vv set
+     f vv << f (ring) dc >> __  degree /vv set
      hhh 0 get /d set  
      d   d  (integer) dc factorial /d set
      d << vv (universalNumber) dc vv factorial >> idiv /d set
@@ -2411,9 +2483,9 @@ newline
     { /fn (0). def }
     {
        f (ring) dc /rrr set
-       v toString (^) n toString 3 cat_n rrr ,,
+       v toString (^) n toString 3 cat_n rrr __
        f mul 
-       [[v (0).] [(h) rrr ,, (1) rrr ,,]] replace /fn set
+       [[v (0).] [(h) rrr __ (1) rrr __]] replace /fn set
      } ifelse
      fn /arg1 set
   ] pop
@@ -2459,7 +2531,7 @@ newline
 [(ord_w)
  [(ff [v1 w1 v2 w2 ... vm wm] ord_w d)
   (poly ff; string v1; integer w1; ...)
-  (order of ff by the weight vector [w1 w2 ...])
+  (order of the initial of ff by the weight vector [w1 w2 ...])
   (Example: [(x,y) ring_of_polynomials 0] define_ring )
   (          (x^2 y^3-x). [(x) 2 (y) 1] ord_w ::)
  ]
@@ -2470,13 +2542,14 @@ 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
     /ddd 0 def
     0 2 www length 1 sub {
       /iii set
-      fff << www iii get rrr ,, >> degree
+      fff << www iii get rrr __ >> degree
       << www iii 1 add get >> mul
       ddd add /ddd set
     } for
@@ -2487,6 +2560,47 @@ newline
   arg1
 } def
 
+[(ord_w_all)
+ [(ff [v1 w1 v2 w2 ... vm wm] ord_w d)
+  (poly ff; string v1; integer w1; ...)
+  (order of ff by the weight vector [w1 w2 ...])
+  (Example: [(x,y,t) ring_of_polynomials 0] define_ring )
+  (          (x^2 y^3-x-t). [(t) 1 ] ord_w_all ::)
+ ]
+] putUsages 
+/ord_w_all {
+  /arg2 set /arg1 set
+  [/ord_w_all-in /fff /fff-in /www /rrr /iii /ddd /zzz /ddd-tmp] pushVariables
+  [
+    /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
+    /zzz (0) rrr __ def
+    fff init /fff-in set
+    fff fff-in sub /fff set
+    {
+     /ddd-tmp 0 def
+     0 2 www length 1 sub {
+       /iii set
+       fff-in << www iii get rrr __ >> degree
+       << www iii 1 add get >> mul
+       ddd-tmp add /ddd-tmp set
+     } for
+     ddd-tmp ddd gt { /ddd ddd-tmp def }  {  } ifelse
+     fff zzz eq { exit } {  } ifelse
+     fff init /fff-in set
+     fff fff-in sub /fff set
+    } loop
+    /ord_w_all.LLL
+    /arg1 ddd def
+  ] pop
+  popVariables
+  arg1
+} def
+
 [(laplace0)
  [
  (f [v1 ... vn] laplace0 g)
@@ -2518,22 +2632,22 @@ newline
          /v0 vv ii get (string) dc def
          v0 (array) dc 0 get Dascii eq  %% If the first character is D?
          {  rule  %% Dx-->x
-            [v0 rr ,, 
-            v0 (array) dc rest { (string) dc} map aload length cat_n rr ,,]
+            [v0 rr __ 
+            v0 (array) dc rest { (string) dc} map aload length cat_n rr __]
             append /rule set
          }
          { rule   %% x --> -Dx
-           [v0 rr ,,
+           [v0 rr __
             (0). 
             [Dascii] v0 (array) dc join { (string) dc } map aload length 
-            cat_n rr ,,  sub
+            cat_n rr __  sub
            ]
            append /rule set
          } ifelse
       } ifelse
      } for
      % rule message
-     ff rule replace [[(h) rr ,, (1) rr ,,]] replace /ans1 set
+     ff rule replace [[(h) rr __ (1) rr __]] replace /ans1 set
      } ifelse
     }
    { 
@@ -2675,6 +2789,7 @@ newline
   [/in-ngcd /nlist /g.ngcd /ans] pushVariables
   [
      /nlist arg1 def
+     nlist to_univNum /nlist set
      nlist length 2 lt
      { /ans nlist 0 get def /L.ngcd goto }
      {
@@ -2890,9 +3005,9 @@ newline
      {
         /xx xx (string) dc def
         /dxx [@@@.Dsymbol xx] cat def
-        /xx xx f (ring) dc ,, def
-        /dxx dxx f (ring) dc ,, def
-        /one (1) f (ring) dc ,, def
+        /xx xx f (ring) dc __ def
+        /dxx dxx f (ring) dc __ def
+        /one (1) f (ring) dc __ def
 
         { 
           /g f init def
@@ -2969,9 +3084,9 @@ newline
     f (0). eq {  }
     {
       /rr f (ring) dc def
-      xx {toString rr ,, } map /xx set
-      dx {toString rr ,, } map /dx set
-      ss {toString rr ,, } map /ss set
+      xx {toString rr __ } map /xx set
+      dx {toString rr __ } map /dx set
+      ss {toString rr __ } map /ss set
       /n xx length  def
       0 1 n 1 sub {
          /i set
@@ -3001,7 +3116,7 @@ newline
   [
     /f arg1 def /xx arg2 def /dx arg3 def /ss arg4 def
     f (ring) dc /rr set
-    /one (1) rr ,, def %% 
+    /one (1) rr __ def %% 
     /ww [ xx toString -1 dx toString 1 ] weightv  def
     f ww init f sub (0). eq {   } 
     { [(destraction2.1 : inhomogeneous with respect to ) 
@@ -3027,6 +3142,50 @@ newline
    arg1
 } def
 
+/distraction2* {
+  /arg1 set
+  [/in-distraction2* /aa /f /vlist /xlist /dlist /slist ] pushVariables
+  [(CurrentRingp)] pushEnv
+  [
+     /aa arg1 def
+     /f aa 0 get def
+     /vlist aa 1 get def
+     /xlist aa 2 get def
+     /dlist aa 3 get def
+     /slist aa 4 get def
+     vlist isArray 
+     {
+        vlist { toString } map   /vlist set
+     }
+     {
+        vlist toString to_records  /vlist set
+      } ifelse
+     xlist isArray 
+     {
+        xlist { toString } map   /xlist set
+     }
+     {
+        xlist toString to_records  /xlist set
+      } ifelse
+     slist isArray 
+     {
+        slist { toString } map   /slist set
+     }
+     {
+        slist toString to_records  /slist set
+      } ifelse
+     [vlist from_records ring_of_differential_operators 0] define_ring pop
+     f toString .
+     xlist { . } map
+     dlist { toString . } map
+     slist { toString . } map
+     distraction2 /arg1 set
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+
 /message-quiet  {
   @@@.quiet { pop } { message } ifelse
 } def
@@ -3191,6 +3350,10 @@ newline
 ]] putUsages
 
 /cancelCoeff {
+  /arg1 set
+  [(reduceContent) arg1] gbext 0 get
+} def
+/cancelCoeff_org {
  /arg1 set
  [/in-cancelCoeff /ff /gg /dd /dd2] pushVariables
  [  /ff arg1 def
@@ -3488,6 +3651,738 @@ $ [ff ff] fromVectors :: $ 
 [(nl is the newline character.)
  $Example: [(You can break line) nl (here.)] cat message$
 ]] putUsages
+
+/to_int {
+  /arg1 set
+  [/to-int /ob /ans] pushVariables
+  [
+    /ob arg1 def
+    /ans ob def
+    ob isArray {
+      ob {to_int} map /ans set
+      /LLL.to_int goto
+    } {  } ifelse
+    ob isInteger {
+      ob (universalNumber) dc /ans set
+      /LLL.to_int goto
+    } {  } ifelse
+    /LLL.to_int
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+[(to_int)
+[(obj to_int obj2)
+ (All integers in obj are changed to universalNumber.)
+ (Example: /ff [1 2 [(hello) (0).]] def  ff { tag } map ::)
+ (         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.
+  [
+     /drv._v getVariableNames def
+     /drv._v0 drv._v def
+     drv._v { dup /drv._p set (/) 2 1 roll ( $) drv._p ($. def ) } map cat
+     /drv._v set
+%     drv._v message
+     [(parse) drv._v] extension 
+  ] pop
+  popVariables
+} def
+[(define_ring_variables)
+[(It binds  a variable <<a>> in the current ring to the sm1 variable <<a>>.)
+ (For example, if x is a variable in the current ring, it defines the sm1)
+ (variable x by /x (x) def)
+]] putUsages
+
+/boundp {
+  /arg1 set
+  [/a /ans] pushVariables
+  [
+    /a arg1 def
+    [(parse) [(/) a ( load tag 0 eq { /ans 0 def } )
+                    (               { /ans 1 def } ifelse )] cat ] extension
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+[(boundp)
+ [( a boundp b)
+  (string a, b is 0 or 1.)
+  (If the variable named << a >> is bounded to a value,)
+  (it returns 1 else it returns 0.)
+  $Example: (hoge) boundp ::$
+]] putUsages
+[(isSubstr) 
+ [
+  (s1 s2 isSubstr pos)
+  (If s1 is a substring of s2, isSubstr returns the position in s2 from which)
+  (s1 is contained in s2.)
+  (If s1 is not a substring of s2, then isSubstr returns -1.)
+ ]
+] putUsages
+/isSubstr {
+  /arg2 set /arg1 set
+  [/in-isSubstr /s1 /s2 /i1 /i2 /n1 /n2
+   /ans /flg
+  ]  pushVariables
+  [
+    /s1 arg1 def
+    /s2 arg2 def
+    s1 (array) dc /s1 set
+    s2 (array) dc /s2 set
+    /n1 s1 length def
+    /n2 s2 length def
+    /ans -1 def
+    0 1 n2 n1 sub {
+      /i2 set
+      /flg 1 def
+      0 1 n1 1 sub {
+        /i1 set
+        s1 i1 get s2 i2 i1 add get eq {
+        } { 
+          /flg 0 def exit
+        } ifelse
+      } for
+      flg {
+        /ans i2 def  
+        /isSubstr.L2 goto
+      } { /ans -1 def } ifelse
+    } for
+    /isSubstr.L2
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+
+[(execve)
+ [  
+   (command execve)
+   ([arg0 arg1 arg2 ...] execve )
+   (It executes the command by the system call execve.)
+   (cf. system, forkExec)
+ ] 
+] putUsages
+
+/execve {
+  /execve.arg set
+  [(forkExec) execve.arg [ ] 1] extension
+} def
+
+[(beginEcart)
+ [  
+   (beginEcart)
+   (Set the environments for the ecart division algorithm.)
+ ] 
+] putUsages
+
+/ecart.debug_reduction1 0 def
+/beginEcart {
+  (red@) (ecart) switch_function
+  [(Ecart) 1] system_variable
+  [(CheckHomogenization) 0] system_variable
+  [(ReduceLowerTerms) 0] system_variable
+  [(AutoReduce) 0] system_variable
+  [(EcartAutomaticHomogenization) 0] system_variable
+  ecart.debug_reduction1 {
+    (red@) (debug) switch_function
+  } {  } ifelse
+} def
+
+[(endEcart)
+ [  
+   (endEcart)
+   (End of using the ecart division algorithm.)
+ ] 
+] putUsages
+
+/endEcart {
+  (red@) (standard) switch_function
+  [(Ecart) 0] system_variable
+  [(degreeShift) (reset)] homogenize pop
+} def
+
+/ord_ws_all {
+  /arg2 set /arg1 set
+  [(ord_ws_all) arg1 arg2] gbext
+} def
+[(ord_ws_all)
+ [  
+   (fv wv ord_ws_all degree)
+   (  ord_ws_all returns the ord with respect to the weight vector wv.)
+   $Example: [(x,y) ring_of_differential_operators 0] define_ring  $
+   $        (Dx^2+x*Dx*Dy+2). [(Dx) 1 (Dy) 1] weightv ord_ws_all ::  $
+   (  )
+   (fv [wv shiftv] ord_ws_all degree)
+   (  ord_ws_all returns the ord with respect to the weight vector wv and)
+   (  the shift vector shiftv.)
+   $Example: [(x,y) ring_of_differential_operators 0] define_ring  $
+   $        [(Dx^2+x*Dx*Dy+2). (Dx).] [[(Dx) 1 (Dy) 1] weightv [0 2]] ord_ws_all ::$
+   (  )
+   (cf: init, gbext.   Obsolete: ord_w, ord_w_all)
+ ] 
+] putUsages
+
+[(newVector)
+ [( n newVector vec)
+]] putUsages
+/newVector {
+  /arg1 set
+  [/in-newVector /n] pushVariables
+  [
+    /n arg1 def
+    [(newVector) n] extension /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+
+[(newMatrix)
+ [( [m n] newMatrix mat)
+]] putUsages
+/newMatrix {
+  /arg1 set
+  [/in-newMatrix /n] pushVariables
+  [
+    /n arg1 def
+    [(newMatrix) n 0 get n 1 get] extension /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+
+/addStdoutStderr {
+  [(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join
+} def
+
+[(___)
+[(reparse a polynomial or polynomials)]
+] putUsages
+/___ {
+  /arg1 set
+  [/in-reparse /ff] pushVariables
+  [
+    /ff arg1 def
+    ff tag 6 eq {
+      ff { ___ } map /arg1 set
+    } {
+      ff toString . /arg1 set
+    } ifelse
+  ] pop
+  popVariables
+  arg1
+} def
+
+/to_univNum {
+  /arg1 set
+  [/rr  ] pushVariables
+  [
+    /rr arg1 def
+    rr isArray {
+      rr { to_univNum } map /rr set
+    } {  
+    } ifelse 
+    rr isInteger {
+      rr (universalNumber) dc /rr set
+    } {
+    } ifelse
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1 
+} def
+[(to_univNum) 
+[(obj to_univNum obj2)
+ (Example. [ 2 (3).. ] to_univNum)
+ $cf. to_int32. (to_int)$
+]] putUsages
+
+[(lcm)
+ [ ([a b c ...] lcm r)
+   (cf. polylcm, mpzext)
+ ]
+] putUsages
+/lcm {
+  /arg1 set
+  [/aa /bb /rr /pp /i] pushVariables
+  [
+    /aa arg1 def
+    /rr (1).. def
+    /pp 0 def % isPolynomial array?
+    0 1 aa length 1 sub {
+      /i set
+      aa i get  isPolynomial {
+        /pp 1 def
+        exit
+      } {  } ifelse
+    } for
+
+    0 1 aa length 1 sub {
+      /i set
+      pp {
+        [rr aa i get] polylcm /rr set
+      } {  
+        [(lcm) rr aa i get ] mpzext /rr set
+      } ifelse
+    } for
+    
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def
+[(gcd)
+ [ ([a b c ...] gcd r)
+   (cf. polygcd, mpzext)
+ ]
+] putUsages
+/gcd {
+  /arg1 set
+  [/aa /bb /rr /pp /i] pushVariables
+  [
+    /aa arg1 def
+    /rr (1).. def
+    /pp 0 def % isPolynomial array?
+    0 1 aa length 1 sub {
+      /i set
+      aa i get  isPolynomial {
+        /pp 1 def
+        /rr aa i get def
+        exit
+      } {  } ifelse
+    } for
+
+    pp {
+     0 1 aa length 1 sub {
+       /i set
+       [rr aa i get] polygcd /rr set
+     } for
+    } {
+      aa ngcd /rr set
+    } ifelse
+    
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def
+
+[(denominator)
+ [ ([a b c ...] denominator r)
+   ( a denominator r )
+   (cf. dc, numerator)
+   (Output is Z or a polynomial.)
+ ]
+] putUsages
+% test data.
+%  [(1).. (2).. div (1).. (3).. div ] denominator
+%  [(2).. (3).. (4).. ] denominator
+/denominator {
+  /arg1 set
+  [/pp /dd /ii /rr] pushVariables
+  [
+    /pp arg1 def
+    pp to_univNum /pp set
+    {
+      pp isArray {
+        pp { denominator } map /dd set        
+        /rr dd lcm def % rr = lcm(dd[0], dd[1], ... )
+        rr /dd set 
+        exit
+      } {  } ifelse
+
+      pp (denominator) dc /dd set
+      exit
+
+    } loop
+    /arg1 dd def
+  ] pop
+  popVariables
+  arg1
+} def 
+
+[(numerator)
+ [ ([a b c ...] numerator r)
+   ( a numerator r )
+   (cf. dc, denominator)
+   (Output is a list of Z or polynomials.)
+ ]
+] putUsages
+% test data.
+/numerator {
+  /arg1 set
+  [/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 cancel /rr set
+        exit
+      } {  } ifelse
+
+      pp (numerator) dc /rr set
+      exit
+
+    } loop
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def 
+
+/cancel.Q {
+  /arg1 set
+  [/aa /rr /nn /dd /gg]  pushVariables
+  [
+    /aa arg1 def
+    {
+      aa isRational {
+         [(cancel) aa] mpzext /rr set 
+         rr (denominator) dc (1).. eq {
+            /rr rr (numerator) dc def
+            exit
+         } { } ifelse
+         rr (denominator) dc (-1).. eq {
+            /rr rr (numerator) dc (-1).. mul def
+         } { } ifelse
+         exit
+      } { } ifelse
+
+      /rr aa def
+      exit 
+    } loop
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def 
+
+/cancel.one {
+  /arg1 set
+  [/aa /rr /nn /dd /gg]  pushVariables
+  [
+    /aa arg1 def
+    {
+      aa isRational {
+        aa (numerator) dc /nn set
+        aa (denominator) dc /dd set
+        nn isUniversalNumber dd isUniversalNumber and {
+          /rr aa cancel.Q def
+          exit
+        } { (cancel: not implemented) error } ifelse
+      } { } ifelse
+
+      /rr aa def
+      exit 
+    } loop
+    /arg1 rr def
+  ] pop
+  popVariables
+  arg1
+} def 
+
+[(cancel)
+ [ (obj cancel r)
+   (Cancel numerators and denominators)
+   (The implementation has not yet been completed. It works only for Q.) 
+]] putUsages
+/cancel {
+  /arg1 set
+  [/aa /rr] pushVariables
+  [ 
+    /aa arg1 def
+    aa isArray {
+      aa {cancel} map /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 /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
+      } { } ifelse
+      ob isClass , ob isArray or { } { 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 node-value)
+ (ob is a class object or an array.)
+ (The operator getNode returns the node with the key in ob.)
+ (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 {
+  /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
+/arrayToList {
+  /arg1 set
+  [/a /r] pushVariables
+  [
+    /a arg1 def
+    {
+      a isArray {
+       a { arrayToList } map /a set
+       a (list) dc  /r set
+       exit
+      } {  } ifelse
+      /r a def
+      exit
+    } loop
+    /arg1 r def
+  ] pop
+  popVariables
+  arg1
+} def 
+[(arrayToList)
+[(a arrayToList list)
+]] putUsages
+
+/listToArray {
+  /arg1 set
+  [/a /r] pushVariables
+  [
+    /a arg1 def
+    {
+      a tag 12 eq {
+       a (array) dc  /a set
+       a { listToArray } map /r set
+       exit
+      } {  } ifelse
+      a tag 0 eq {
+       /r [ ] def
+       exit
+      } {  } ifelse
+      /r a def
+      exit
+    } loop
+    /arg1 r def
+  ] pop
+  popVariables
+  arg1
+} def 
+[(listToArray)
+[(list listToArray a)
+]] putUsages
+
+% Body is moved to smacro.sm1
+[(makeInfix)
+[(literal makeInfix)
+ (Change literal to an infix operator.)
+ (Example: /+ { add } def )
+ (  /+ makeInfix)
+ (  /s 0 def 1 1 100 { /i set s + i /s set } for s message)
+ (  [ 1 2 3 ] { /i set i + 2 } map ::)
+]] putUsages
+
+/usages {
+  /arg1 set
+  [/name /flag /n /k /slist /m /i /sss /key /ukeys] pushVariables
+  [
+    /name arg1 def
+    /flag true def
+    {  % begin loop
+
+       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
+   @.usages length /n set  
+   0 1 << n 1 sub >> 
+   {   
+      /k set
+      name << @.usages k get 0 get >> eq
+      {
+        /slist @.usages k get 1 get def
+        /m slist length def
+        0 1 << m 1 sub >> {
+          /i set
+          sss slist i get append nl append /sss set
+        } for
+        /flag false def
+      }
+      { }
+      ifelse
+   } for
+      
+   %BUG:  cannot get usages of primitives.
+   flag
+   {name Usage  /sss [(Usage of ) name ( could not obtained.) nl ] def}
+   { }
+   ifelse
+   exit
+ } ifelse
+
+} loop
+   /arg1 sss cat def
+   ] pop
+   popVariables
+   arg1
+} def
+[(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
+
 
 ;