[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.33 and 1.46

version 1.33, 2004/08/31 05:30:20 version 1.46, 2004/09/17 00:47:08
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.32 2004/08/31 04:45:42 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.45 2004/09/17 00:10:41 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 1407 
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 1683 
Line 1689 
 [(ClassP) @.datatypeConstant.usage ] putUsages  [(ClassP) @.datatypeConstant.usage ] putUsages
 [(DoubleP) @.datatypeConstant.usage ] putUsages  [(DoubleP) @.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 1703 
Line 1709 
       /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 1714 
Line 1720 
  [( 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 1925  newline
Line 1932  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 1949  newline
Line 1956  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 2258  newline
Line 2265  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 2284  newline
Line 2291  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 2370  newline
Line 2377  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 2389  newline
Line 2396  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 2465  newline
Line 2472  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 2531  newline
Line 2538  newline
     /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 2560  newline
Line 2567  newline
     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 2614  newline
Line 2621  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 2987  newline
Line 2994  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 3066  newline
Line 3073  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 3098  newline
Line 3105  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 3870  $ [ff ff] fromVectors :: $ 
Line 3877  $ [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 4147  $ [ff ff] fromVectors :: $ 
Line 4154  $ [ff ff] fromVectors :: $ 
 /getNode {  /getNode {
   /arg2 set    /arg2 set
   /arg1 set    /arg1 set
   [/in-getNode /ob /key /rr /rr /ii] pushVariables    [/in-getNode /ob /key /rr /tt /ii] pushVariables
   [    [
     /ob arg1 def      /ob arg1 def
     /key arg2 def      /key arg2 def
     /rr null 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 isClass {
         ob (array) dc /ob set          ob (array) dc /ob set
       } { exit } ifelse        } { } ifelse
         ob isClass , ob isArray or { } { exit } ifelse
       ob 0 get key eq {        ob 0 get key eq {
         /rr ob def          /rr ob def
         exit          exit
Line 4174  $ [ff ff] fromVectors :: $ 
Line 4195  $ [ff ff] fromVectors :: $ 
   arg1    arg1
 } def  } def
 [(getNode)  [(getNode)
 [(ob key getNode)  [(ob key getNode node-value)
  (ob is a class object.)   (ob is a class object or an array.)
  (The operator getNode returns the node with the key in ob.)   (The operator getNode returns the node with the key in ob.)
  (The node is an array of the format [key attr-list node-list])   (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:)   (Example:)
  (  /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def)   (  /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def)
  (  /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def)   (  /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def)
  (  /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def)   (  /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def)
  (  ma (dog) getNode )   (  ma (dog) getNode )
    (Example 2:)
    ( [ [1 ] [2 3] [[(dog) 2]]] (dog) getNode ::)
 ]] putUsages  ]] 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 4222  $ [ff ff] fromVectors :: $ 
Line 4326  $ [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 4231  $ [ff ff] fromVectors :: $ 
Line 4338  $ [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
   
   
 ;  ;
   
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.46
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>