Return to new.sm1 CVS log

Up to [local] / OpenXM / src / k097 / lib / minimal

Annotation of OpenXM/src/k097/lib/minimal/new.sm1, Revision 1.2

1.2     ! takayama    1: % $OpenXM: OpenXM/src/k097/lib/minimal/new.sm1,v 1.1 2000/06/14 07:44:05 takayama Exp $
1.1       takayama    2: %% These functions should be moved to complex.sm1
                      3: %% homogenize<m>, ord_w<m>, init<m>, ...
1.2     ! takayama    4:
        !             5: /.toSm1Integer {
        !             6:   /arg1 set
        !             7:   [/in-.toSm1Integer /ans /v] pushVariables
        !             8:   [
        !             9:     /v arg1 def
        !            10:     /ans v def
        !            11:     v isArray {
        !            12:      v { .toSm1Integer } map /ans set
        !            13:     }{  } ifelse
        !            14:     v isUniversalNumber {
        !            15:        v (integer) dc /ans set
        !            16:     }{  } ifelse
        !            17:     /arg1 ans def
        !            18:   ] pop
        !            19:   popVariables
        !            20:   arg1
        !            21: } def
        !            22: /.toUniversalNumber {
        !            23:   /arg1 set
        !            24:   [/in-.toUniversalNumber /ans /v] pushVariables
        !            25:   [
        !            26:     /v arg1 def
        !            27:     /ans v def
        !            28:     v isArray {
        !            29:      v { .toUniversalNumber } map /ans set
        !            30:     }{  } ifelse
        !            31:     v isInteger {
        !            32:        v (universalNumber) dc /ans set
        !            33:     }{  } ifelse
        !            34:     /arg1 ans def
        !            35:   ] pop
        !            36:   popVariables
        !            37:   arg1
        !            38: } def
        !            39:
        !            40: /ord_w<m>  {
        !            41:   /arg3 set /arg2 set /arg1 set
        !            42:   [/in-ord_w<m>  /f /weight /shift /www ] pushVariables
        !            43:   [
        !            44:     /f arg1 def
        !            45:     /weight arg2 def
        !            46:     /shift arg3 def
        !            47:     weight .toSm1Integer /weight set
        !            48:     shift  .toSm1Integer /shift  set
        !            49:     f isArray {
        !            50:       f { weight ord_w } map /www set
        !            51:     }{
        !            52:       [f weight ord_w ] /www set
        !            53:     }ifelse
        !            54:     www shift add /arg1 set
        !            55:   ] pop
        !            56:   popVariables
        !            57:   arg1
        !            58: } def
        !            59: [(ord_w<m>)
        !            60: [(f weight shift ord_w<m> w)
        !            61:  (It returns the ord_w with the shift vector shift.)
        !            62:  (Example 1:)
        !            63:  $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
        !            64:  $    define_ring $
        !            65:  $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] ord_w<m> ::$
        !            66: ]] putUsages
        !            67:
        !            68:
        !            69: /init_w<m>  {
        !            70:   /arg3 set /arg2 set /arg1 set
        !            71:   [/in-init_w<m>  /f /fv /weight /shift /www
        !            72:    /maxw /i /ans /tmp] pushVariables
        !            73:   [
        !            74:     /f arg1 def
        !            75:     /weight arg2 def
        !            76:     /shift arg3 def
        !            77:     weight .toSm1Integer /weight set
        !            78:     shift  .toSm1Integer /shift  set
        !            79:     f isArray {
        !            80:       f { weight ord_w } map /www set
        !            81:       /fv f def
        !            82:     }{
        !            83:       [f weight ord_w ] /www set
        !            84:       /fv [f] def
        !            85:     }ifelse
        !            86:     www shift add /www set
        !            87:     /maxw www 0 get def
        !            88:     0 1 www length 1 sub {
        !            89:       /i set
        !            90:       www i get maxw gt {
        !            91:        /maxw www i get def
        !            92:       } { } ifelse
        !            93:     } for
        !            94:     /ans [ 0 1 www length 1 sub { pop (0). } for ] def
        !            95:     0 1 www length 1 sub {
        !            96:       /i set
        !            97:       www i get maxw eq {
        !            98:         fv i get weight weightv init /tmp set
        !            99:         ans i tmp put
        !           100:       }{ } ifelse
        !           101:     }for
        !           102:     f isArray {
        !           103:       /arg1 ans def
        !           104:     }{
        !           105:       /arg1 ans 0 get def
        !           106:     } ifelse
        !           107:   ] pop
        !           108:   popVariables
        !           109:   arg1
        !           110: } def
        !           111: [(init_w<m>)
        !           112: [(f weight shift init_w<m> w)
        !           113:  (It returns the initial with the shift vector shift and the weight)
        !           114:  (Example 1:)
        !           115:  $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
        !           116:  $    define_ring $
        !           117:  $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] init_w<m> ::$
        !           118: ]] putUsages