[BACK]Return to dr.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/dr.sm1 between version 1.28 and 1.49

version 1.28, 2004/05/13 05:33:10 version 1.49, 2005/06/16 06:21:21
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.27 2004/04/29 11:20:37 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.48 2005/02/27 05:28:06 takayama Exp $
 %% dr.sm1 (Define Ring) 1994/9/25, 26  %% dr.sm1 (Define Ring) 1994/9/25, 26
 %% This file is error clean.  %% This file is error clean.
   
Line 342 
Line 342 
      0 1 << set0 length 1 sub >>       0 1 << set0 length 1 sub >>
      {       {
         /i set          /i set
         << set0 i get >> a eq          set0 i get tag , a tag , eq {
         {            << set0 i get >> a eq
            /flag 1 def            {
          }               /flag 1 def  exit
         { }             }
         ifelse            { }
             ifelse
           } {  } ifelse
      } for       } for
   ] pop    ] pop
   /arg1 flag def    /arg1 flag def
Line 361 
Line 363 
   [    [
     /mat arg1 def      /mat arg1 def
     /m mat length def      /m mat length def
     {
       m 0 eq { /ans [ ] def exit } { } ifelse
     mat 0 get isArray      mat 0 get isArray
     {   }      {   }
     { (transpose: Argument must be an array of arrays.) error }      { (transpose: Argument must be an array of arrays.) error }
Line 374 
Line 378 
          ans [ j i ]  <<  mat i get j get >> put           ans [ j i ]  <<  mat i get j get >> put
       } for        } for
     } for      } for
       exit
      } loop
    /arg1 ans def     /arg1 ans def
   ] pop    ] pop
   popVariables    popVariables
Line 787 
Line 793 
    (    Pointer to the ring. )     (    Pointer to the ring. )
    (Example: [$x,y$ ring_of_q_difference_operators $Qx,Qy$ elimination_order)     (Example: [$x,y$ ring_of_q_difference_operators $Qx,Qy$ elimination_order)
    (          0] define_qring )     (          0] define_qring )
    (cf. define_ring, set_up_ring@ <coefficient ring>, ring_def, << ,, >>)     (cf. define_ring, set_up_ring@ <coefficient ring>, ring_def, << __ >>)
   ]    ]
 ] putUsages  ] putUsages
 /define_qring {  /define_qring {
Line 839 
Line 845 
   (one may use the command )    (one may use the command )
   (          f (ring) data_conversion /R set)    (          f (ring) data_conversion /R set)
   (cf. define_ring, define_qring, system_variable, poly (ring) data_conversion)    (cf. define_ring, define_qring, system_variable, poly (ring) data_conversion)
   (cf. << ,, >>)    (cf. << __ >>)
  ]   ]
 ] putUsages  ] putUsages
   
Line 1328 
Line 1334 
     /univ vars 0 get reverse      /univ vars 0 get reverse
           vars 1 get reverse join            vars 1 get reverse join
     def      def
       w-vectors to_int32 /w-vectors set
     [      [
     0 1 << w-vectors length 1 sub >>      0 1 << w-vectors length 1 sub >>
     {      {
Line 1350 
Line 1357 
   /arg2 set  /arg1 set    /arg2 set  /arg1 set
   [/univ /www /k /vname /vweight /ans] pushVariables    [/univ /www /k /vname /vweight /ans] pushVariables
   /univ arg1 def /www arg2 def    /univ arg1 def /www arg2 def
   [    [
       www to_int32 /www set
     /ans << univ length >> -1 0 evecw def      /ans << univ length >> -1 0 evecw def
     0  2  << www length 2 sub >>      0  2  << www length 2 sub >>
     {      {
Line 1405 
Line 1413 
        gg (0). eq         gg (0). eq
        { 0 }         { 0 }
        { gg (ring) data_conversion /rr set         { gg (ring) data_conversion /rr set
          gg  << var rr ,, >> degree           gg  << var rr __ >> degree
        } ifelse         } ifelse
     } map def      } map def
   %%degs message    %%degs message
Line 1520 
Line 1528 
   (type?) data_conversion  RingP eq    (type?) data_conversion  RingP eq
 } def  } def
   
   [(isByteArray)
    [(obj isByteArray bool) ]
   ] putUsages
   /isByteArray {
     (type?) data_conversion  ByteArrayP eq
   } def
   
 /toString.tmp {  /toString.tmp {
   /arg1 set    /arg1 set
   [/obj /fname] pushVariables    [/obj /fname] pushVariables
Line 1549 
Line 1564 
     { obj (string) data_conversion } { } ifelse      { obj (string) data_conversion } { } ifelse
     obj isRational      obj isRational
     { obj (string) data_conversion } { } ifelse      { obj (string) data_conversion } { } ifelse
       obj isByteArray
       { obj (array) data_conversion toString } { } ifelse
     obj tag 0 eq      obj tag 0 eq
     { (null) } { } ifelse      { (null) } { } ifelse
   
Line 1663 
Line 1680 
 /RationalFunctionP 16 def  /RationalFunctionP 16 def
 /ClassP 17 def  /ClassP 17 def
 /DoubleP 18 def  /DoubleP 18 def
   /ByteArrayP 19 def
 /@.datatypeConstant.usage [  /@.datatypeConstant.usage [
  (IntegerP, LiteralP, StringP, ExecutableArrayP, ArrayP, PolyP, FileP, RingP,)   (IntegerP, LiteralP, StringP, ExecutableArrayP, ArrayP, PolyP, FileP, RingP,)
  (UniversalNumberP, RationalFunctionP, ClassP, DoubleP)   (UniversalNumberP, RationalFunctionP, ClassP, DoubleP, ByteArrayP)
  (      return data type identifiers.)   (      return data type identifiers.)
  (Example:  7 tag IntegerP eq  ---> 1)   (Example:  7 tag IntegerP eq  ---> 1)
 ] def  ] def
Line 1680 
Line 1698 
 [(RationalFunctionP) @.datatypeConstant.usage ] putUsages  [(RationalFunctionP) @.datatypeConstant.usage ] putUsages
 [(ClassP) @.datatypeConstant.usage ] putUsages  [(ClassP) @.datatypeConstant.usage ] putUsages
 [(DoubleP) @.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)    (Parse the <<string>> as an element in the <<ring>> and returns)
   (the polynomial.)    (the polynomial.)
   (cf. define_ring, define_qring, ring_def)    (cf. define_ring, define_qring, ring_def)
   (Example: [(x,y) ring_of_polynomials [[(x) 1]] weight_vector 7]define_ring)    (Example: [(x,y) ring_of_polynomials [[(x) 1]] weight_vector 7]define_ring)
   (         /myring set)    (         /myring set)
   (         ((x+y)^4) myring ,, /f set)    (         ((x+y)^4) myring __ /f set)
 ]] putUsages  ]] putUsages
   
 /,, {  /__ {
   /arg2 set /arg1 set    /arg2 set /arg1 set
   [/rrr] pushVariables    [/rrr] pushVariables
   [ arg1 tag StringP eq    [ arg1 tag StringP eq
Line 1701 
Line 1720 
       /arg1 arg1 expand def        /arg1 arg1 expand def
       [(CurrentRingp) rrr] system_variable        [(CurrentRingp) rrr] system_variable
     }      }
     {(Argument Error for ,, ) error }      {(Argument Error for __ ) error }
     ifelse      ifelse
   ] pop    ] pop
   popVariables    popVariables
Line 1712 
Line 1731 
  [( string .. universalNumber)   [( string .. universalNumber)
   (Parse the << string >> as a universalNumber.)    (Parse the << string >> as a universalNumber.)
   (Example:  (123431232123123).. /n set)    (Example:  (123431232123123).. /n set)
     ({ commands }..  executes the commands.  << .. >> is equivalent to exec.)
 ]] putUsages  ]] putUsages
 /.. { (universalNumber) data_conversion } def  /.. { dup tag 3 eq { exec } { (universalNumber) data_conversion} ifelse } def
   
 [(dc)  [(dc)
  [(Abbreviation of data_conversion.)   [(Abbreviation of data_conversion.)
Line 1923  newline
Line 1943  newline
 } def  } def
 %%end of function  %%end of function
   
 /rest { % returns remainder of a given list  /rest {
   [ 2 1 roll  aload length -1 roll pop ]    /arg1 set [(Krest) arg1] extension
 } def  } def
 [(rest)  [(rest)
  [(array rest the-rest-of-the-array)   [(array rest the-rest-of-the-array)
Line 1947  newline
Line 1967  newline
         error          error
      } ifelse       } ifelse
      /myring  base 0 get (ring) dc def       /myring  base 0 get (ring) dc def
      /zero (0) myring ,, def       /zero (0) myring __ def
      base length 1 sub /n set       base length 1 sub /n set
      /minbase [ 0 1 n { /i set base i get } for ] def       /minbase [ 0 1 n { /i set base i get } for ] def
      0 1 n {       0 1 n {
Line 2256  newline
Line 2276  newline
         [(variableNames) M2N 0 get] system_variable          [(variableNames) M2N 0 get] system_variable
         f toString /f2 set          f toString /f2 set
         [(variableNames) M2N 3 get] system_variable          [(variableNames) M2N 3 get] system_variable
         f2 M2N 2 get ,, /f2 set          f2 M2N 2 get __ /f2 set
     } ifelse      } ifelse
     [(CurrentRingp) cp] system_variable      [(CurrentRingp) cp] system_variable
     /arg1 f2 def      /arg1 f2 def
Line 2282  newline
Line 2302  newline
   $/R2 set$    $/R2 set$
   $[[(x) (Dx)] [((t-1) Dt) (z)]] /r0 set$    $[[(x) (Dx)] [((t-1) Dt) (z)]] /r0 set$
   $r0 R1 R2 makeRingMap /maptable set$    $r0 R1 R2 makeRingMap /maptable set$
   $(Dx-1) R1 ,, /ff set$    $(Dx-1) R1 __ /ff set$
   $ ff maptable ringmap :: $    $ ff maptable ringmap :: $
  ]   ]
 ] putUsages  ] putUsages
Line 2368  newline
Line 2388  newline
        /rrr set         /rrr set
        base { . } map /base set         base { . } map /base set
      } ifelse       } ifelse
      vlist { dup isPolynomial {  } { rrr ,, } ifelse } map /vlist set       vlist { dup isPolynomial {  } { rrr __ } ifelse } map /vlist set
   
      [(hilbert) base vlist] extension /ff set       [(hilbert) base vlist] extension /ff set
      [(CurrentRingp) rrrorg] system_variable       [(CurrentRingp) rrrorg] system_variable
Line 2387  newline
Line 2407  newline
      /vv arg2 def       /vv arg2 def
      /f hhh 1 get def       /f hhh 1 get def
      f (0). eq { /ans [0] def /hilbReduce.label goto } { } ifelse       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       hhh 0 get /d set
      d   d  (integer) dc factorial /d set       d   d  (integer) dc factorial /d set
      d << vv (universalNumber) dc vv factorial >> idiv /d set       d << vv (universalNumber) dc vv factorial >> idiv /d set
Line 2463  newline
Line 2483  newline
     { /fn (0). def }      { /fn (0). def }
     {      {
        f (ring) dc /rrr set         f (ring) dc /rrr set
        v toString (^) n toString 3 cat_n rrr ,,         v toString (^) n toString 3 cat_n rrr __
        f mul         f mul
        [[v (0).] [(h) rrr ,, (1) rrr ,,]] replace /fn set         [[v (0).] [(h) rrr __ (1) rrr __]] replace /fn set
      } ifelse       } ifelse
      fn /arg1 set       fn /arg1 set
   ] pop    ] pop
Line 2522  newline
Line 2542  newline
   [    [
     /fff arg1 def      /fff arg1 def
     /www arg2 def      /www arg2 def
       www to_int32 /www set
     fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse      fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse
     fff (ring) dc /rrr set      fff (ring) dc /rrr set
     fff init /fff set      fff init /fff set
     /ddd 0 def      /ddd 0 def
     0 2 www length 1 sub {      0 2 www length 1 sub {
       /iii set        /iii set
       fff << www iii get rrr ,, >> degree        fff << www iii get rrr __ >> degree
       << www iii 1 add get >> mul        << www iii 1 add get >> mul
       ddd add /ddd set        ddd add /ddd set
     } for      } for
Line 2553  newline
Line 2574  newline
   [    [
     /fff arg1 def      /fff arg1 def
     /www arg2 def      /www arg2 def
       www to_int32 /www set
     fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse      fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse
     /ddd -intInfinity def      /ddd -intInfinity def
     fff (ring) dc /rrr set      fff (ring) dc /rrr set
     /zzz (0) rrr ,, def      /zzz (0) rrr __ def
     fff init /fff-in set      fff init /fff-in set
     fff fff-in sub /fff set      fff fff-in sub /fff set
     {      {
      /ddd-tmp 0 def       /ddd-tmp 0 def
      0 2 www length 1 sub {       0 2 www length 1 sub {
        /iii set         /iii set
        fff-in << www iii get rrr ,, >> degree         fff-in << www iii get rrr __ >> degree
        << www iii 1 add get >> mul         << www iii 1 add get >> mul
        ddd-tmp add /ddd-tmp set         ddd-tmp add /ddd-tmp set
      } for       } for
Line 2610  newline
Line 2632  newline
          /v0 vv ii get (string) dc def           /v0 vv ii get (string) dc def
          v0 (array) dc 0 get Dascii eq  %% If the first character is D?           v0 (array) dc 0 get Dascii eq  %% If the first character is D?
          {  rule  %% Dx-->x           {  rule  %% Dx-->x
             [v0 rr ,,              [v0 rr __
             v0 (array) dc rest { (string) dc} map aload length cat_n rr ,,]              v0 (array) dc rest { (string) dc} map aload length cat_n rr __]
             append /rule set              append /rule set
          }           }
          { rule   %% x --> -Dx           { rule   %% x --> -Dx
            [v0 rr ,,             [v0 rr __
             (0).              (0).
             [Dascii] v0 (array) dc join { (string) dc } map aload length              [Dascii] v0 (array) dc join { (string) dc } map aload length
             cat_n rr ,,  sub              cat_n rr __  sub
            ]             ]
            append /rule set             append /rule set
          } ifelse           } ifelse
       } ifelse        } ifelse
      } for       } for
      % rule message       % rule message
      ff rule replace [[(h) rr ,, (1) rr ,,]] replace /ans1 set       ff rule replace [[(h) rr __ (1) rr __]] replace /ans1 set
      } ifelse       } ifelse
     }      }
    {     {
Line 2767  newline
Line 2789  newline
   [/in-ngcd /nlist /g.ngcd /ans] pushVariables    [/in-ngcd /nlist /g.ngcd /ans] pushVariables
   [    [
      /nlist arg1 def       /nlist arg1 def
        nlist to_univNum /nlist set
      nlist length 2 lt       nlist length 2 lt
      { /ans nlist 0 get def /L.ngcd goto }       { /ans nlist 0 get def /L.ngcd goto }
      {       {
Line 2982  newline
Line 3005  newline
      {       {
         /xx xx (string) dc def          /xx xx (string) dc def
         /dxx [@@@.Dsymbol xx] cat def          /dxx [@@@.Dsymbol xx] cat def
         /xx xx f (ring) dc ,, def          /xx xx f (ring) dc __ def
         /dxx dxx f (ring) dc ,, def          /dxx dxx f (ring) dc __ def
         /one (1) f (ring) dc ,, def          /one (1) f (ring) dc __ def
   
         {          {
           /g f init def            /g f init def
Line 3061  newline
Line 3084  newline
     f (0). eq {  }      f (0). eq {  }
     {      {
       /rr f (ring) dc def        /rr f (ring) dc def
       xx {toString rr ,, } map /xx set        xx {toString rr __ } map /xx set
       dx {toString rr ,, } map /dx set        dx {toString rr __ } map /dx set
       ss {toString rr ,, } map /ss set        ss {toString rr __ } map /ss set
       /n xx length  def        /n xx length  def
       0 1 n 1 sub {        0 1 n 1 sub {
          /i set           /i set
Line 3093  newline
Line 3116  newline
   [    [
     /f arg1 def /xx arg2 def /dx arg3 def /ss arg4 def      /f arg1 def /xx arg2 def /dx arg3 def /ss arg4 def
     f (ring) dc /rr set      f (ring) dc /rr set
     /one (1) rr ,, def %%      /one (1) rr __ def %%
     /ww [ xx toString -1 dx toString 1 ] weightv  def      /ww [ xx toString -1 dx toString 1 ] weightv  def
     f ww init f sub (0). eq {   }      f ww init f sub (0). eq {   }
     { [(destraction2.1 : inhomogeneous with respect to )      { [(destraction2.1 : inhomogeneous with respect to )
Line 3656  $ [ff ff] fromVectors :: $ 
Line 3679  $ [ff ff] fromVectors :: $ 
  (         ff to_int { tag } map :: )   (         ff to_int { tag } map :: )
 ]] putUsages  ]] 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 {  /define_ring_variables {
   [/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables    [/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables
 %% You cannot use these names for names for polynomials.  %% You cannot use these names for names for polynomials.
Line 3837  $ [ff ff] fromVectors :: $ 
Line 3888  $ [ff ff] fromVectors :: $ 
   [(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join    [(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join
 } def  } def
   
 [(,,,)  [(___)
 [(reparse a polynomial or polynomials)]  [(reparse a polynomial or polynomials)]
 ] putUsages  ] putUsages
 /,,, {  /___ {
   /arg1 set    /arg1 set
   [/in-reparse /ff] pushVariables    [/in-reparse /ff] pushVariables
   [    [
     /ff arg1 def      /ff arg1 def
     ff tag 6 eq {      ff tag 6 eq {
       ff { ,,, } map /arg1 set        ff { ___ } map /arg1 set
     } {      } {
       ff toString . /arg1 set        ff toString . /arg1 set
     } ifelse      } ifelse
Line 3855  $ [ff ff] fromVectors :: $ 
Line 3906  $ [ff ff] fromVectors :: $ 
   arg1    arg1
 } def  } 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 {  /usages {
   /arg1 set    /arg1 set
   [/name /flag /n /k /slist /m /i /sss] pushVariables    [/name /flag /n /k /slist /m /i /sss /key /ukeys] pushVariables
   [    [
     /name arg1 def      /name arg1 def
     /flag true def      /flag true def
       {  % begin loop
   
  %BUG: should use regular expression in a future.         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 {   name tag 1 eq {
    @.usages { 0 get } map shell { (, ) nl } map /sss set     @.usages { 0 get } map shell { (, ) nl } map /sss set
      exit
  } {   } {
   
     /sss [ ] def      /sss [ ] def
Line 3891  $ [ff ff] fromVectors :: $ 
Line 4337  $ [ff ff] fromVectors :: $ 
    {name Usage  /sss [(Usage of ) name ( could not obtained.) nl ] def}     {name Usage  /sss [(Usage of ) name ( could not obtained.) nl ] def}
    { }     { }
    ifelse     ifelse
      exit
  } ifelse   } ifelse
   
   } loop
    /arg1 sss cat def     /arg1 sss cat def
    ] pop     ] pop
    popVariables     popVariables
Line 3900  $ [ff ff] fromVectors :: $ 
Line 4349  $ [ff ff] fromVectors :: $ 
 [(usages)  [(usages)
  [(key usages usages-as-a-string)   [(key usages usages-as-a-string)
   (num usages list-of-key-words)    (num usages list-of-key-words)
     ([key1 key2 ... ] usages list-of-key-words  : it accepts regular expressions.)
 ]] putUsages  ]] 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
   
   /toTokensBySpace {
     /arg1 set
     [(cgiToTokens) arg1 [ ]] extension
   } def
   [(toTokensBySpace)
   [
    ( string toTokensBySpace token_array )
   ]] putUsages
   
   /setAttributeList {
     /arg2 set
     /arg1 set
     [
       [(setAttributeList) arg1 arg2] extension /arg1 set
     ] pop
     arg1
   } def
   /getAttributeList {
     /arg1 set
     [(getAttributeList) arg1] extension
   } def
   /setAttribute {
     /arg3 set
     /arg2 set
     /arg1 set
     [
       [(setAttribute) arg1 arg2 arg3] extension /arg1 set
     ] pop
     arg1
   } def
   /getAttribute {
     /arg2 set
     /arg1 set
     [(getAttribute) arg1 arg2] extension
   } def
   [(setAttributeList)
   [
    (ob attr setAttributeList new-obj )
    (Example: [(x-1) (y-1)] [(gb) 1] setAttributeList /ff set )
   ]] putUsages
   [(setAttribute)
   [
    (ob key value setAttribute new-obj )
    (Example: [(x-1) (y-1)] (gb) 1 setAttribute /ff set )
   ]] putUsages
   [(getAttributeList)
   [
    (ob getAttributeList attr-obj )
    (Example: [(x-1) (y-1)] [(gb) 1] setAttributeList /ff set )
    (         ff getAttributeList :: )
   ]] putUsages
   [(getAttribute)
   [
    (ob key getAttribute value )
    (Example: [(x-1) (y-1)] (gb) 1 setAttribute /ff set )
    (         ff (gb) getAttribute :: )
   ]] putUsages
 ;  ;
   
   
Legend:
Removed from v.1.28  
changed lines
  Added in v.1.49
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>