% $OpenXM: OpenXM/src/k097/lib/minimal/new.sm1,v 1.2 2000/08/01 03:42:35 takayama Exp $
%% These functions should be moved to complex.sm1
%% homogenize<m>, ord_w<m>, init<m>, ...

/.toSm1Integer {
  /arg1 set
  [/in-.toSm1Integer /ans /v] pushVariables
  [
    /v arg1 def
    /ans v def
    v isArray {
     v { .toSm1Integer } map /ans set
    }{  } ifelse
    v isUniversalNumber {
       v (integer) dc /ans set
    }{  } ifelse
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def
/.toUniversalNumber {
  /arg1 set
  [/in-.toUniversalNumber /ans /v] pushVariables
  [
    /v arg1 def
    /ans v def
    v isArray {
     v { .toUniversalNumber } map /ans set
    }{  } ifelse
    v isInteger {
       v (universalNumber) dc /ans set
    }{  } ifelse
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def

/ord_w<m>  {
  /arg3 set /arg2 set /arg1 set
  [/in-ord_w<m>  /f /weight /shift /www ] pushVariables
  [
    /f arg1 def
    /weight arg2 def
    /shift arg3 def
    weight .toSm1Integer /weight set
    shift  .toSm1Integer /shift  set
    f isArray {
      f { weight ord_w } map /www set
    }{
      [f weight ord_w ] /www set
    }ifelse
    www shift add /arg1 set
  ] pop
  popVariables
  arg1
} def
[(ord_w<m>)
[(f weight shift ord_w<m> w)
 (It returns the ord_w with the shift vector shift.)
 (Example 1:)
 $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
 $    define_ring $
 $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] ord_w<m> ::$
]] putUsages


/init_w<m>  {
  /arg3 set /arg2 set /arg1 set
  [/in-init_w<m>  /f /fv /weight /shift /www 
   /maxw /i /ans /tmp] pushVariables
  [
    /f arg1 def
    /weight arg2 def
    /shift arg3 def
    weight .toSm1Integer /weight set
    shift  .toSm1Integer /shift  set
    f isArray {
      f { weight ord_w } map /www set
      /fv f def
    }{
      [f weight ord_w ] /www set
      /fv [f] def
    }ifelse
    www shift add /www set
    /maxw www 0 get def
    0 1 www length 1 sub {
      /i set
      www i get maxw gt {
       /maxw www i get def
      } { } ifelse
    } for
    /ans [ 0 1 www length 1 sub { pop (0). } for ] def
    0 1 www length 1 sub {
      /i set
      www i get maxw eq {
        fv i get weight weightv init /tmp set
        ans i tmp put
      }{ } ifelse    
    }for
    f isArray {
      /arg1 ans def
    }{
      /arg1 ans 0 get def
    } ifelse
  ] pop
  popVariables
  arg1
} def
[(init_w<m>)
[(f weight shift init_w<m> w)
 (It returns the initial with the shift vector shift and the weight)
 (Example 1:)
 $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
 $    define_ring $
 $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] init_w<m> ::$
]] putUsages