Annotation of OpenXM/src/kan96xx/Kan/smacro.sm1.old1, Revision 1.1
1.1 ! maekawa 1: /; %%% prompt of the sm1
! 2: {
! 3: [$PrintDollar$ 0] system_variable pop
! 4: $sm1>$ print
! 5: [$PrintDollar$ 1] system_variable pop
! 6: } def
! 7:
! 8: /?
! 9: {
! 10: show_systemdictionary
! 11: (------------ Use show_user_dictionary to see the user dictionary.---)
! 12: message
! 13: (------------ Use $keyWord$ usage to see the usages. ---------------)
! 14: message
! 15: } def
! 16:
! 17: /??
! 18: {
! 19: show_systemdictionary
! 20: (------------ system macros defined in the UserDictionary -----------)
! 21: message
! 22: show_user_dictionary %% it should use other command
! 23: (------------ Use $keyWord$ usage to see the usages. ---------------)
! 24: message
! 25: } def
! 26:
! 27: /::
! 28: {
! 29: print newline ;
! 30: } def
! 31:
! 32: /. {expand} def
! 33:
! 34: /, { } def
! 35:
! 36: /false 0 def
! 37:
! 38: /expand {
! 39: $poly$ data_conversion
! 40: } def
! 41:
! 42: /<< { } def
! 43: />> { } def
! 44:
! 45: % v1 v2 join
! 46: /join {
! 47: /arg2 set /arg1 set
! 48: [/v1 /v2] pushVariables
! 49: /v1 arg1 def /v2 arg2 def
! 50: [
! 51: [v1 aload pop v2 aload pop] /arg1 set
! 52: ] pop
! 53: popVariables
! 54: arg1
! 55: } def
! 56:
! 57: /n.map 0 def /i.map 0 def /ar.map 0 def /res.map 0 def %% declare variables
! 58: /map.old { %% recursive
! 59: /arg1.map set %% arg1.map = { }
! 60: /arg2.map set %% arg2.map = [ ]
! 61: %%%debug: /arg1.map load print arg2.map print
! 62: [n.map /com.map load i.map ar.map %% local variables. Don't push com!
! 63: %%It's better to use load for all variables.
! 64: /com.map /arg1.map load def
! 65: /ar.map arg2.map def %% set variables
! 66: /n.map ar.map length 1 sub def
! 67: [
! 68: 0 1 n.map {
! 69: /i.map set
! 70: << ar.map i.map get >> com.map
! 71: } for
! 72: ] /res.map set
! 73: /ar.map set /i.map set /com.map set /n.map set ] pop %% pop local variables
! 74: res.map %% push the result
! 75: } def
! 76:
! 77: /message {
! 78: [$PrintDollar$ 0] system_variable pop
! 79: print newline
! 80: [$PrintDollar$ 1] system_variable pop
! 81: } def
! 82:
! 83: /messagen {
! 84: [$PrintDollar$ 0] system_variable pop
! 85: print
! 86: [$PrintDollar$ 1] system_variable pop
! 87: } def
! 88:
! 89: /newline {
! 90: [$PrintDollar$ 0] system_variable pop
! 91: 10 $string$ data_conversion print
! 92: [$PrintDollar$ 1] system_variable pop
! 93: } def
! 94:
! 95: /pushVariables {
! 96: { dup [ 3 1 roll load ] } map
! 97: } def
! 98:
! 99: /popVariables {
! 100: % dup print
! 101: { aload pop def } map pop
! 102: } def
! 103:
! 104:
! 105:
! 106: /timer {
! 107: set_timer
! 108: exec
! 109: set_timer
! 110: } def
! 111:
! 112: /true 1 def
! 113:
! 114:
! 115:
! 116: %%% prompter
! 117: ;
! 118:
! 119:
! 120:
! 121:
! 122: %% dr.sm1 (Define Ring) 1994/9/25, 26
! 123:
! 124: (dr.sm1 Version 11/9,1994. ) message
! 125: %% n evenQ bool
! 126: /evenQ {
! 127: /arg1 set
! 128: arg1 2 idiv 2 mul arg1 sub 0 eq
! 129: { true }
! 130: { false } ifelse
! 131: } def
! 132:
! 133: %% (x,y,z) polynomial_ring [x-list, d-list , paramList]
! 134: /ring_of_polynomials {
! 135: /arg1 set
! 136: [/vars /n /i /xList /dList /param] pushVariables
! 137: %dup print (-----) message
! 138: [
! 139: (mmLarger) (matrix) switch_function
! 140: (mpMult) (poly) switch_function
! 141: (red@) (module1) switch_function
! 142: (groebner) (standard) switch_function
! 143:
! 144: [arg1 to_records pop] /vars set
! 145: vars length evenQ
! 146: { }
! 147: { vars [(PAD)] join /vars set }
! 148: ifelse
! 149: vars length 2 idiv /n set
! 150: [ << n 1 sub >> -1 0
! 151: { /i set
! 152: vars i get
! 153: } for
! 154: ] /xList set
! 155: [ << n 1 sub >> -1 0
! 156: { /i set
! 157: vars << i n add >> get
! 158: } for
! 159: ] /dList set
! 160:
! 161: [(H)] xList join [(e)] join /xList set
! 162: [(h)] dList join [(E)] join /dList set
! 163: [0 %% dummy characteristic
! 164: << xList length >> << xList length >> << xList length >>
! 165: << xList length >>
! 166: << xList length 1 sub >> << xList length >> << xList length >>
! 167: << xList length >>
! 168: ] /param set
! 169:
! 170: [xList dList param] /arg1 set
! 171: ] pop
! 172: popVariables
! 173: arg1
! 174: } def
! 175:
! 176: %% (x,y,z) polynomial_ring [x-list, d-list , paramList]
! 177: %% with no graduation and homogenization variables.
! 178: /ring_of_polynomials2 {
! 179: /arg1 set
! 180: [/vars /n /i /xList /dList /param] pushVariables
! 181: %dup print (-----) message
! 182: [
! 183: (mmLarger) (matrix) switch_function
! 184: (mpMult) (poly) switch_function
! 185: (red@) (module1) switch_function
! 186: (groebner) (standard) switch_function
! 187:
! 188: [arg1 to_records pop] /vars set
! 189: vars length evenQ
! 190: { }
! 191: { vars [(PAD)] join /vars set }
! 192: ifelse
! 193: vars length 2 idiv /n set
! 194: [ << n 1 sub >> -1 0
! 195: { /i set
! 196: vars i get
! 197: } for
! 198: ] /xList set
! 199: [ << n 1 sub >> -1 0
! 200: { /i set
! 201: vars << i n add >> get
! 202: } for
! 203: ] /dList set
! 204:
! 205: [0 %% dummy characteristic
! 206: << xList length >> << xList length >> << xList length >>
! 207: << xList length >>
! 208: << xList length >> << xList length >> << xList length >>
! 209: << xList length >>
! 210: ] /param set
! 211:
! 212: [xList dList param] /arg1 set
! 213: ] pop
! 214: popVariables
! 215: arg1
! 216: } def
! 217:
! 218: %% (x,y,z) polynomial_ring [x-list, d-list , paramList]
! 219: %% with no homogenization variables.
! 220: /ring_of_polynomials3 {
! 221: /arg1 set
! 222: [/vars /n /i /xList /dList /param] pushVariables
! 223: %dup print (-----) message
! 224: [
! 225: (mmLarger) (matrix) switch_function
! 226: (mpMult) (poly) switch_function
! 227: (red@) (module1) switch_function
! 228: (groebner) (standard) switch_function
! 229:
! 230: [arg1 to_records pop] /vars set
! 231: vars length evenQ
! 232: { }
! 233: { vars [(PAD)] join /vars set }
! 234: ifelse
! 235: vars length 2 idiv /n set
! 236: [ << n 1 sub >> -1 0
! 237: { /i set
! 238: vars i get
! 239: } for
! 240: ] /xList set
! 241: xList [(e)] join /xList set
! 242: [ << n 1 sub >> -1 0
! 243: { /i set
! 244: vars << i n add >> get
! 245: } for
! 246: ] /dList set
! 247: dList [(E)] join /dList set
! 248:
! 249: [0 %% dummy characteristic
! 250: << xList length >> << xList length >> << xList length >>
! 251: << xList length >>
! 252: << xList length >> << xList length >> << xList length >>
! 253: << xList length >>
! 254: ] /param set
! 255:
! 256: [xList dList param] /arg1 set
! 257: ] pop
! 258: popVariables
! 259: arg1
! 260: } def
! 261:
! 262: /ring_of_differential_operators {
! 263: /arg1 set
! 264: [/vars /n /i /xList /dList /param] pushVariables
! 265: [
! 266: (mmLarger) (matrix) switch_function
! 267: (mpMult) (diff) switch_function
! 268: (red@) (module1) switch_function
! 269: (groebner) (standard) switch_function
! 270:
! 271: [arg1 to_records pop] /vars set %[x y z]
! 272: vars reverse /xList set %[z y x]
! 273: vars {(D) 2 1 roll 2 cat_n} map
! 274: reverse /dList set %[Dz Dy Dx]
! 275: [(H)] xList join [(e)] join /xList set
! 276: [(h)] dList join [(E)] join /dList set
! 277: [0 1 1 1 << xList length >>
! 278: 1 1 1 << xList length 1 sub >> ] /param set
! 279: [ xList dList param ] /arg1 set
! 280: ] pop
! 281: popVariables
! 282: arg1
! 283: } def
! 284:
! 285: /ring_of_differential_operators3 {
! 286: %% with no homogenization variables.
! 287: /arg1 set
! 288: [/vars /n /i /xList /dList /param] pushVariables
! 289: [
! 290: (mmLarger) (matrix) switch_function
! 291: (mpMult) (diff) switch_function
! 292: (red@) (module1) switch_function
! 293: (groebner) (standard) switch_function
! 294:
! 295: [arg1 to_records pop] /vars set %[x y z]
! 296: vars reverse /xList set %[z y x]
! 297: vars {(D) 2 1 roll 2 cat_n} map
! 298: reverse /dList set %[Dz Dy Dx]
! 299: xList [(e)] join /xList set
! 300: dList [(E)] join /dList set
! 301: [0 0 0 0 << xList length >>
! 302: 0 0 0 << xList length 1 sub >> ] /param set
! 303: [ xList dList param ] /arg1 set
! 304: ] pop
! 305: popVariables
! 306: arg1
! 307: } def
! 308:
! 309: /ring_of_q_difference_operators {
! 310: /arg1 set
! 311: [/vars /n /i /xList /dList /param] pushVariables
! 312: [
! 313: (mmLarger) (qmatrix) switch_function
! 314: (mpMult) (diff) switch_function
! 315: (red@) (qmodule1) switch_function
! 316: (groebner) (standard) switch_function
! 317:
! 318: [arg1 to_records pop] /vars set %[x y z]
! 319: vars reverse /xList set %[z y x]
! 320: vars {(Q) 2 1 roll 2 cat_n} map
! 321: reverse /dList set %[Dz Dy Dx]
! 322: [(q)] xList join [(e)] join /xList set
! 323: [(h)] dList join [(E)] join /dList set
! 324: [0 1 << xList length >> << xList length >> << xList length >>
! 325: 1 << xList length 1 sub >> << xList length >> << xList length >> ]
! 326: /param set
! 327: [ xList dList param ] /arg1 set
! 328: ] pop
! 329: popVariables
! 330: arg1
! 331: } def
! 332:
! 333: /ring_of_q_difference_operators3 {
! 334: %% with no homogenization and q variables.
! 335: /arg1 set
! 336: [/vars /n /i /xList /dList /param] pushVariables
! 337: [
! 338: (mmLarger) (qmatrix) switch_function
! 339: (mpMult) (diff) switch_function
! 340: (red@) (qmodule1) switch_function
! 341: (groebner) (standard) switch_function
! 342:
! 343: [arg1 to_records pop] /vars set %[x y z]
! 344: vars reverse /xList set %[z y x]
! 345: vars {(Q) 2 1 roll 2 cat_n} map
! 346: reverse /dList set %[Dz Dy Dx]
! 347: xList [(e)] join /xList set
! 348: dList [(E)] join /dList set
! 349: [0 0 << xList length >> << xList length >> << xList length >>
! 350: 0 << xList length 1 sub >> << xList length >> << xList length >> ]
! 351: /param set
! 352: [ xList dList param ] /arg1 set
! 353: ] pop
! 354: popVariables
! 355: arg1
! 356: } def
! 357:
! 358: /reverse {
! 359: /arg1 set
! 360: arg1 length 1 lt
! 361: { [ ] }
! 362: {
! 363: [
! 364: << arg1 length 1 sub >> -1 0
! 365: {
! 366: arg1 2 1 roll get
! 367: } for
! 368: ]
! 369: } ifelse
! 370: } def
! 371:
! 372: /memberQ {
! 373: %% a set0 memberQ bool
! 374: /arg2 set /arg1 set
! 375: [/a /set0 /flag /i ] pushVariables
! 376: [
! 377: /a arg1 def /set0 arg2 def
! 378: /flag 0 def
! 379: 0 1 << set0 length 1 sub >>
! 380: {
! 381: /i set
! 382: << set0 i get >> a eq
! 383: {
! 384: /flag 1 def
! 385: }
! 386: { }
! 387: ifelse
! 388: } for
! 389: ] pop
! 390: /arg1 flag def
! 391: popVariables
! 392: arg1
! 393: } def
! 394:
! 395: /transpose {
! 396: %% mat transpose mat2
! 397: /arg1 set
! 398: [/i /j /m /n /flat /mat] pushVariables
! 399: [
! 400: /mat arg1 def
! 401: /n mat length def
! 402: /m mat 0 get length def
! 403:
! 404: [
! 405: 0 1 << n 1 sub >>
! 406: {
! 407: /i set
! 408: mat i get aload pop
! 409: } for
! 410: ] /flat set
! 411: %% [[1 2] [3 4]] ---> flat == [1 2 3 4]
! 412:
! 413: [
! 414: 0 1 << m 1 sub >>
! 415: {
! 416: /i set
! 417: [
! 418: 0 1 << n 1 sub >>
! 419: {
! 420: /j set
! 421: flat
! 422: << j m mul >> i add
! 423: get
! 424: } for
! 425: ]
! 426: } for
! 427: ] /arg1 set
! 428: ] pop
! 429: popVariables
! 430: arg1
! 431: } def
! 432:
! 433:
! 434: /getPerm {
! 435: %% old new getPerm perm
! 436: /arg2 set /arg1 set
! 437: [/old /new /i /j /p] pushVariables
! 438: [
! 439: /old arg1 def
! 440: /new arg2 def
! 441: [
! 442: /p old length def
! 443: 0 1 << p 1 sub >>
! 444: {
! 445: /i set
! 446: 0 1 << p 1 sub >>
! 447: {
! 448: /j set
! 449: old i get
! 450: new j get
! 451: eq
! 452: { j }
! 453: { } ifelse
! 454: } for
! 455: } for
! 456: ] /arg1 set
! 457: ] pop
! 458: popVariables
! 459: arg1
! 460: } def
! 461:
! 462: /permuteOrderMatrix {
! 463: %% order perm puermuteOrderMatrix newOrder
! 464: /arg2 set /arg1 set
! 465: [/order /perm /newOrder /k ] pushVariables
! 466: [
! 467: /order arg1 def
! 468: /perm arg2 def
! 469: order transpose /order set
! 470: order 1 copy /newOrder set pop
! 471:
! 472: 0 1 << perm length 1 sub >>
! 473: {
! 474: /k set
! 475: newOrder << perm k get >> << order k get >> put
! 476: } for
! 477: newOrder transpose /newOrder set
! 478: ] pop
! 479: /arg1 newOrder def
! 480: popVariables
! 481: arg1
! 482: } def
! 483:
! 484:
! 485:
! 486: /complement {
! 487: %% set0 universe complement compl
! 488: /arg2 set /arg1 set
! 489: [/set0 /universe /compl /i] pushVariables
! 490: /set0 arg1 def /universe arg2 def
! 491: [
! 492: 0 1 << universe length 1 sub >>
! 493: {
! 494: /i set
! 495: << universe i get >> set0 memberQ
! 496: { }
! 497: { universe i get }
! 498: ifelse
! 499: } for
! 500: ] /arg1 set
! 501: popVariables
! 502: arg1
! 503: } def
! 504:
! 505:
! 506: %%% from order.sm1
! 507:
! 508: %% size i evec [0 0 ... 0 1 0 ... 0]
! 509: /evec {
! 510: /arg2 set /arg1 set
! 511: [/size /iii] pushVariables
! 512: /size arg1 def /iii arg2 def
! 513: [
! 514: 0 1 << size 1 sub >>
! 515: {
! 516: iii eq
! 517: { 1 }
! 518: { 0 }
! 519: ifelse
! 520: } for
! 521: ] /arg1 set
! 522: popVariables
! 523: arg1
! 524: } def
! 525:
! 526: %% size i evec_neg [0 0 ... 0 -1 0 ... 0]
! 527: /evec_neg {
! 528: /arg2 set /arg1 set
! 529: [/size /iii] pushVariables
! 530: /size arg1 def /iii arg2 def
! 531: [
! 532: 0 1 << size 1 sub >>
! 533: {
! 534: iii eq
! 535: { -1 }
! 536: { 0 }
! 537: ifelse
! 538: } for
! 539: ] /arg1 set
! 540: popVariables
! 541: arg1
! 542: } def
! 543:
! 544:
! 545: %% size i j e_ij << matrix e(i,j) >>
! 546: /e_ij {
! 547: /arg3 set /arg2 set /arg1 set
! 548: [/size /k /i /j] pushVariables
! 549: [
! 550: /size arg1 def /i arg2 def /j arg3 def
! 551: [ 0 1 << size 1 sub >>
! 552: {
! 553: /k set
! 554: k i eq
! 555: { size j evec }
! 556: {
! 557: k j eq
! 558: { size i evec }
! 559: { size k evec }
! 560: ifelse
! 561: } ifelse
! 562: } for
! 563: ] /arg1 set
! 564: ] pop
! 565: popVariables
! 566: arg1
! 567: } def
! 568:
! 569:
! 570: %% size i j d_ij << matrix E_{ij} >>
! 571: /d_ij {
! 572: /arg3 set /arg2 set /arg1 set
! 573: [/size /k /i /j] pushVariables
! 574: [
! 575: /size arg1 def /i arg2 def /j arg3 def
! 576: [ 0 1 << size 1 sub >>
! 577: {
! 578: /k set
! 579: k i eq
! 580: { size j evec }
! 581: {
! 582: [ 0 1 << size 1 sub >> { pop 0} for ]
! 583: } ifelse
! 584: } for
! 585: ] /arg1 set
! 586: ] pop
! 587: popVariables
! 588: arg1
! 589: } def
! 590:
! 591: %% size matid << id matrix >>
! 592: /matid {
! 593: /arg1 set
! 594: [/size /k ] pushVariables
! 595: [
! 596: /size arg1 def
! 597: [ 0 1 << size 1 sub >>
! 598: {
! 599: /k set
! 600: size k evec
! 601: } for
! 602: ] /arg1 set
! 603: ] pop
! 604: popVariables
! 605: arg1
! 606: } def
! 607:
! 608:
! 609: %% m1 m2 oplus
! 610: /oplus {
! 611: /arg2 set /arg1 set
! 612: [/m1 /m2 /n /m /k ] pushVariables
! 613: [
! 614: /m1 arg1 def /m2 arg2 def
! 615: m1 length /n set
! 616: m2 length /m set
! 617: [
! 618: 0 1 << n m add 1 sub >>
! 619: {
! 620: /k set
! 621: k n lt
! 622: {
! 623: << m1 k get >> << m -1 evec >> join
! 624: }
! 625: {
! 626: << n -1 evec >> << m2 << k n sub >> get >> join
! 627: } ifelse
! 628: } for
! 629: ] /arg1 set
! 630: ] pop
! 631: popVariables
! 632: arg1
! 633: } def
! 634:
! 635: %%%%%%%%%%%%%%%%%%%%%%%
! 636:
! 637: /eliminationOrderTemplate { %% esize >= 1
! 638: %% if esize == 0, it returns reverse lexicographic order.
! 639: %% m esize eliminationOrderTemplate mat
! 640: /arg2 set /arg1 set
! 641: [/m /esize /m1 /m2 /k ] pushVariables
! 642: [
! 643: /m arg1 def /esize arg2 def
! 644: /m1 m esize sub 1 sub def
! 645: /m2 esize 1 sub def
! 646: [esize 0 gt
! 647: {
! 648: [1 1 esize
! 649: { pop 1 } for
! 650: esize 1 << m 1 sub >>
! 651: { pop 0 } for
! 652: ] %% 1st vector
! 653: }
! 654: { } ifelse
! 655:
! 656: m esize gt
! 657: {
! 658: [1 1 esize
! 659: { pop 0 } for
! 660: esize 1 << m 1 sub >>
! 661: { pop 1 } for
! 662: ] %% 2nd vector
! 663: }
! 664: { } ifelse
! 665:
! 666: m1 0 gt
! 667: {
! 668: m 1 sub -1 << m m1 sub >>
! 669: {
! 670: /k set
! 671: m k evec_neg
! 672: } for
! 673: }
! 674: { } ifelse
! 675:
! 676: m2 0 gt
! 677: {
! 678: << esize 1 sub >> -1 1
! 679: {
! 680: /k set
! 681: m k evec_neg
! 682: } for
! 683: }
! 684: { } ifelse
! 685:
! 686: ] /arg1 set
! 687: ] pop
! 688: popVariables
! 689: arg1
! 690: } def
! 691:
! 692: /elimination_order {
! 693: %% [x-list d-list params] (x,y,z) elimination_order
! 694: %% vars evars
! 695: %% [x-list d-list params order]
! 696: /arg2 set /arg1 set
! 697: [/vars /evars /univ /order /perm /univ0 /compl] pushVariables
! 698: /vars arg1 def /evars [arg2 to_records pop] def
! 699: [
! 700: /univ vars 0 get reverse
! 701: vars 1 get reverse join
! 702: def
! 703:
! 704: << univ length 2 sub >>
! 705: << evars length >>
! 706: eliminationOrderTemplate /order set
! 707:
! 708: [[1]] order oplus [[1]] oplus /order set
! 709:
! 710: /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
! 711:
! 712: /compl
! 713: [univ 0 get] evars join evars univ0 complement join
! 714: def
! 715: compl univ
! 716: getPerm /perm set
! 717: %%perm :: univ :: compl ::
! 718:
! 719: order perm permuteOrderMatrix /order set
! 720:
! 721:
! 722: vars [order] join /arg1 set
! 723: ] pop
! 724: popVariables
! 725: arg1
! 726: } def
! 727:
! 728: /elimination_order2 {
! 729: %% [x-list d-list params] (x,y,z) elimination_order
! 730: %% vars evars
! 731: %% [x-list d-list params order]
! 732: %% with no graduation and homogenization variables.
! 733: /arg2 set /arg1 set
! 734: [/vars /evars /univ /order /perm /compl] pushVariables
! 735: /vars arg1 def /evars [arg2 to_records pop] def
! 736: [
! 737: /univ vars 0 get reverse
! 738: vars 1 get reverse join
! 739: def
! 740:
! 741: << univ length >>
! 742: << evars length >>
! 743: eliminationOrderTemplate /order set
! 744: /compl
! 745: evars << evars univ complement >> join
! 746: def
! 747: compl univ
! 748: getPerm /perm set
! 749: %%perm :: univ :: compl ::
! 750:
! 751: order perm permuteOrderMatrix /order set
! 752:
! 753: vars [order] join /arg1 set
! 754: ] pop
! 755: popVariables
! 756: arg1
! 757: } def
! 758:
! 759:
! 760: /elimination_order3 {
! 761: %% [x-list d-list params] (x,y,z) elimination_order
! 762: %% vars evars
! 763: %% [x-list d-list params order]
! 764: /arg2 set /arg1 set
! 765: [/vars /evars /univ /order /perm /univ0 /compl] pushVariables
! 766: /vars arg1 def /evars [arg2 to_records pop] def
! 767: [
! 768: /univ vars 0 get reverse
! 769: vars 1 get reverse join
! 770: def
! 771:
! 772: << univ length 1 sub >>
! 773: << evars length >>
! 774: eliminationOrderTemplate /order set
! 775:
! 776: [[1]] order oplus /order set
! 777:
! 778: /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y] --> [x,y]
! 779:
! 780: /compl
! 781: [univ 0 get] evars join evars univ0 complement join
! 782: def
! 783: compl univ
! 784: getPerm /perm set
! 785: %%perm :: univ :: compl ::
! 786:
! 787: order perm permuteOrderMatrix /order set
! 788:
! 789: vars [order] join /arg1 set
! 790: ] pop
! 791: popVariables
! 792: arg1
! 793: } def
! 794:
! 795:
! 796: /define_ring {
! 797: %[ (x,y,z) ring_of_polynominals
! 798: % (x,y) elimination_order
! 799: % 17
! 800: %] define_ring
! 801: /arg1 set
! 802: [/rp /param /foo] pushVariables
! 803: [/rp arg1 def
! 804: [
! 805: rp 0 get 0 get
! 806: rp 0 get 1 get
! 807: rp 0 get 2 get /param set
! 808: param 0 << rp 1 get >> put
! 809: param
! 810: rp 0 get 3 get
! 811: ] /foo set
! 812: foo aload pop set_up_ring@
! 813: ] pop
! 814: popVariables
! 815: } def
! 816:
! 817: /defineTests1 {
! 818: /test {
! 819: [[1 2 3]
! 820: [0 1 0]
! 821: [0 1 2]]
! 822: [0 2 1] permuteOrderMatrix ::
! 823: } def
! 824:
! 825: /test2 { (x,y,z) ring_of_polynomials (z,y) elimination_order /ans set } def
! 826:
! 827: /test3 {
! 828: [ (x,y,z) ring_of_polynomials
! 829: (x,y) elimination_order
! 830: 17
! 831: ] define_ring
! 832: } def
! 833:
! 834: /test4 {
! 835: [ (x,y,z) ring_of_polynomials
! 836: ( ) elimination_order
! 837: 17
! 838: ] define_ring
! 839: } def
! 840:
! 841: } def
! 842:
! 843: %% misterious bug (x,y) miss
! 844: /miss {
! 845: /arg1 set
! 846: %[/vars /n /i /xList /dList /param] pushVariables
! 847: [/vars /i] pushVariables
! 848: [ arg1 print
! 849: [arg1 to_records pop] /vars set
! 850:
! 851: ] pop
! 852: dup print
! 853: popVariables
! 854: arg1
! 855: } def
! 856:
! 857:
! 858: /lexicographicOrderTemplate {
! 859: % size lexicographicOrderTemplate matrix
! 860: /arg1 set
! 861: [/k /size] pushVariables
! 862: [
! 863: /size arg1 def
! 864: [ 0 1 << size 1 sub >>
! 865: {
! 866: /k set
! 867: size k evec
! 868: } for
! 869: ] /arg1 set
! 870: ] pop
! 871: popVariables
! 872: arg1
! 873: } def
! 874:
! 875: /lexicographic_order {
! 876: %% [x-list d-list params] (x,y,z) lexicograhic_order
! 877: %% vars evars
! 878: %% [x-list d-list params order]
! 879: /arg2 set /arg1 set
! 880: [/vars /evars /univ /order /perm /univ0 /compl] pushVariables
! 881: /vars arg1 def /evars [arg2 to_records pop] def
! 882: [
! 883: /univ vars 0 get reverse
! 884: vars 1 get reverse join
! 885: def
! 886:
! 887: << univ length 2 sub >>
! 888: lexicographicOrderTemplate /order set
! 889:
! 890: [[1]] order oplus [[1]] oplus /order set
! 891:
! 892: /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
! 893:
! 894: /compl
! 895: [univ 0 get] evars join evars univ0 complement join
! 896: def
! 897: compl univ
! 898: getPerm /perm set
! 899: %%perm :: univ :: compl ::
! 900:
! 901: order perm permuteOrderMatrix /order set
! 902:
! 903: vars [order] join /arg1 set
! 904: ] pop
! 905: popVariables
! 906: arg1
! 907: } def
! 908:
! 909: /lexicographic_order2 {
! 910: %% [x-list d-list params] (x,y,z) lexicograhic_order
! 911: %% vars evars
! 912: %% [x-list d-list params order]
! 913: %% with no graduation and homogenization variables
! 914: /arg2 set /arg1 set
! 915: [/vars /evars /univ /order /perm /compl] pushVariables
! 916: /vars arg1 def /evars [arg2 to_records pop] def
! 917: [
! 918: /univ vars 0 get reverse
! 919: vars 1 get reverse join
! 920: def
! 921:
! 922: << univ length >>
! 923: lexicographicOrderTemplate /order set
! 924:
! 925: /compl
! 926: evars << evars univ complement >> join
! 927: def
! 928: compl univ
! 929: getPerm /perm set
! 930:
! 931: order perm permuteOrderMatrix /order set
! 932:
! 933: vars [order] join /arg1 set
! 934: ] pop
! 935: popVariables
! 936: arg1
! 937: } def
! 938:
! 939: /lexicographic_order3 {
! 940: %% [x-list d-list params] (x,y,z) lexicograhic_order
! 941: %% vars evars
! 942: %% [x-list d-list params order]
! 943: %% with no homogenization variable.
! 944: /arg2 set /arg1 set
! 945: [/vars /evars /univ /order /perm /univ0 /compl] pushVariables
! 946: /vars arg1 def /evars [arg2 to_records pop] def
! 947: [
! 948: /univ vars 0 get reverse
! 949: vars 1 get reverse join
! 950: def
! 951:
! 952: << univ length 1 sub >>
! 953: lexicographicOrderTemplate /order set
! 954:
! 955: [[1]] order oplus /order set
! 956:
! 957: /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y] --> [x,y]
! 958:
! 959: /compl
! 960: [univ 0 get] evars join evars univ0 complement join
! 961: def
! 962: compl univ
! 963: getPerm /perm set
! 964: %%perm :: univ :: compl ::
! 965:
! 966: order perm permuteOrderMatrix /order set
! 967:
! 968: vars [order] join /arg1 set
! 969: ] pop
! 970: popVariables
! 971: arg1
! 972: } def
! 973:
! 974: %%%%%% add_rings %%%%%%%%%%%%%% 10/5
! 975:
! 976: /graded_reverse_lexicographic_order {
! 977: ( ) elimination_order
! 978: } def
! 979:
! 980:
! 981: /getX {
! 982: %% param [1|2|3|4] getX [var-lists] ; 1->c,2->l,3->m,4->n
! 983: /arg2 set /arg1 set
! 984: [/k /param /func /low /top] pushVariables
! 985: [
! 986: /param arg1 def /func arg2 def
! 987: func 1 eq
! 988: {
! 989: /low 0 def
! 990: }
! 991: {
! 992: /low << param 2 get >> << func 1 sub >> get def
! 993: } ifelse
! 994: /top << param 2 get >> << func 4 add >> get 1 sub def
! 995: [
! 996: low 1 top
! 997: {
! 998: /k set
! 999: param 0 get k get
! 1000: } for
! 1001: ] /arg1 set
! 1002: ] pop
! 1003: popVariables
! 1004: arg1
! 1005: } def
! 1006:
! 1007: /getD {
! 1008: %% param [1|2|3|4] getD [var-lists] ; 1->c,2->l,3->m,4->n
! 1009: /arg2 set /arg1 set
! 1010: [/k /param /func /low /top] pushVariables
! 1011: [
! 1012: /param arg1 def /func arg2 def
! 1013: func 1 eq
! 1014: {
! 1015: /low 0 def
! 1016: }
! 1017: {
! 1018: /low << param 2 get >> << func 1 sub >> get def
! 1019: } ifelse
! 1020: /top << param 2 get >> << func 4 add >> get 1 sub def
! 1021: [
! 1022: low 1 top
! 1023: {
! 1024: /k set
! 1025: param 1 get k get
! 1026: } for
! 1027: ] /arg1 set
! 1028: ] pop
! 1029: popVariables
! 1030: arg1
! 1031: } def
! 1032:
! 1033: /getXV {
! 1034: %% param [1|2|3|4] getXV [var-lists] ; 1->c,2->l,3->m,4->n
! 1035: /arg2 set /arg1 set
! 1036: [/k /param /func /low /top] pushVariables
! 1037: [
! 1038: /param arg1 def /func arg2 def
! 1039: /low << param 2 get >> << func 4 add >> get def
! 1040: /top << param 2 get >> func get 1 sub def
! 1041: [
! 1042: low 1 top
! 1043: {
! 1044: /k set
! 1045: param 0 get k get
! 1046: } for
! 1047: ] /arg1 set
! 1048: ] pop
! 1049: popVariables
! 1050: arg1
! 1051: } def
! 1052:
! 1053: /getDV {
! 1054: %% param [1|2|3|4] getDV [var-lists] ; 1->c,2->l,3->m,4->n
! 1055: /arg2 set /arg1 set
! 1056: [/k /param /func /low /top] pushVariables
! 1057: [
! 1058: /param arg1 def /func arg2 def
! 1059: /low << param 2 get >> << func 4 add >> get def
! 1060: /top << param 2 get >> func get 1 sub def
! 1061: [
! 1062: low 1 top
! 1063: {
! 1064: /k set
! 1065: param 1 get k get
! 1066: } for
! 1067: ] /arg1 set
! 1068: ] pop
! 1069: popVariables
! 1070: arg1
! 1071: } def
! 1072:
! 1073: /reNaming {
! 1074: %% It also changes oldx2 and oldd2, which are globals.
! 1075: /arg1 set
! 1076: [/i /j /new /count /ostr /k] pushVariables
! 1077: [
! 1078: /new arg1 def
! 1079: /count 0 def
! 1080: 0 1 << new length 1 sub >> {
! 1081: /i set
! 1082: << i 1 add >> 1 << new length 1 sub >> {
! 1083: /j set
! 1084: << new i get >> << new j get >> eq
! 1085: {
! 1086: new j get /ostr set
! 1087: (The two rings have the same name :) messagen
! 1088: new i get messagen (.) message
! 1089: (The name ) messagen
! 1090: new i get messagen ( is changed into ) messagen
! 1091: new j << new i get << 48 count add $string$ data_conversion >>
! 1092: 2 cat_n >> put
! 1093: new j get messagen (.) message
! 1094: /oldx2 ostr << new j get >> reNaming2
! 1095: /oldd2 ostr << new j get >> reNaming2
! 1096: /count count 1 add def
! 1097: }
! 1098: { }
! 1099: ifelse
! 1100: } for
! 1101: } for
! 1102: /arg1 new def
! 1103: ] pop
! 1104: popVariables
! 1105: arg1
! 1106: } def
! 1107:
! 1108: /reNaming2 {
! 1109: %% array oldString newString reNaming2
! 1110: %% /aa (x) (y) reNaming2
! 1111: /arg3 set /arg2 set /arg1 set
! 1112: [/array /oldString /newString /k] pushVariables
! 1113: [
! 1114: /array arg1 def /oldString arg2 def /newString arg3 def
! 1115: 0 1 << array load length 1 sub >>
! 1116: {
! 1117: /k set
! 1118: << array load k get >> oldString eq
! 1119: {
! 1120: array load k newString put
! 1121: }
! 1122: { } ifelse
! 1123: } for
! 1124: ] pop
! 1125: popVariables
! 1126: } def
! 1127:
! 1128: /add_rings {
! 1129: /arg2 set /arg1 set
! 1130: [/param1 /param2
! 1131: /newx /newd /newv
! 1132: /k /const /od1 /od2 /od
! 1133: /oldx2 /oldd2 % these will be changed in reNaming.
! 1134: /oldv
! 1135: ] pushVariables
! 1136: [
! 1137: /param1 arg1 def /param2 arg2 def
! 1138: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! 1139: /newx
! 1140: [ ]
! 1141: param2 1 getX join param1 1 getX join
! 1142: param2 1 getXV join param1 1 getXV join
! 1143:
! 1144: param2 2 getX join param1 2 getX join
! 1145: param2 2 getXV join param1 2 getXV join
! 1146:
! 1147: param2 3 getX join param1 3 getX join
! 1148: param2 3 getXV join param1 3 getXV join
! 1149:
! 1150: param2 4 getX join param1 4 getX join
! 1151: param2 4 getXV join param1 4 getXV join
! 1152: def
! 1153: /newd
! 1154: [ ]
! 1155: param2 1 getD join param1 1 getD join
! 1156: param2 1 getDV join param1 1 getDV join
! 1157:
! 1158: param2 2 getD join param1 2 getD join
! 1159: param2 2 getDV join param1 2 getDV join
! 1160:
! 1161: param2 3 getD join param1 3 getD join
! 1162: param2 3 getDV join param1 3 getDV join
! 1163:
! 1164: param2 4 getD join param1 4 getD join
! 1165: param2 4 getDV join param1 4 getDV join
! 1166: def
! 1167:
! 1168: /newv newx newd join def
! 1169: /oldx2 param2 0 get def /oldd2 param2 1 get def
! 1170: /oldx2 oldx2 {1 copy 2 1 roll pop} map def
! 1171: /oldd2 oldd2 {1 copy 2 1 roll pop} map def
! 1172: /newv newv reNaming def
! 1173:
! 1174: /newx [
! 1175: 0 1 << newv length 2 idiv 1 sub >>
! 1176: {
! 1177: /k set
! 1178: newv k get
! 1179: } for
! 1180: ] def
! 1181: /newd [
! 1182: 0 1 << newv length 2 idiv 1 sub >>
! 1183: {
! 1184: /k set
! 1185: newv << newv length 2 idiv k add >> get
! 1186: } for
! 1187: ] def
! 1188: /const [
! 1189: << param1 2 get 0 get >>
! 1190: << param1 2 get 1 get param2 2 get 1 get add >>
! 1191: << param1 2 get 2 get param2 2 get 2 get add >>
! 1192: << param1 2 get 3 get param2 2 get 3 get add >>
! 1193: << param1 2 get 4 get param2 2 get 4 get add >>
! 1194: << param1 2 get 5 get param2 2 get 5 get add >>
! 1195: << param1 2 get 6 get param2 2 get 6 get add >>
! 1196: << param1 2 get 7 get param2 2 get 7 get add >>
! 1197: << param1 2 get 8 get param2 2 get 8 get add >>
! 1198: ] def
! 1199:
! 1200: /od1 param1 3 get def /od2 param2 3 get def
! 1201: od1 od2 oplus /od set
! 1202:
! 1203: %%oldx2 :: oldd2 ::
! 1204: << param1 0 get reverse >> << param1 1 get reverse >> join
! 1205: << oldx2 reverse >> << oldd2 reverse >> join
! 1206: join /oldv set
! 1207:
! 1208:
! 1209: od << oldv << newx reverse newd reverse join >> getPerm >>
! 1210: permuteOrderMatrix /od set
! 1211:
! 1212: /arg1 [newx newd const od] def
! 1213: ] pop
! 1214: popVariables
! 1215: arg1
! 1216: } def
! 1217:
! 1218:
! 1219: /test5 {
! 1220: (t) ring_of_polynomials ( ) elimination_order /r1 set
! 1221: (x) ring_of_differential_operators (Dx) elimination_order /r2 set
! 1222: r2 r1 add_rings
! 1223: } def
! 1224:
! 1225: /test6 {
! 1226: (H,h) ring_of_polynomials2 (H,h) lexicographic_order2 /r0 set
! 1227: (x,y,z) ring_of_polynomials2 (x,y) elimination_order2 /r1 set
! 1228: (t) ring_of_differential_operators3 (Dt) elimination_order3 /r2 set
! 1229: [r2 r1 add_rings r0 add_rings 0] define_ring
! 1230: } def
! 1231:
! 1232: /test7 {
! 1233: (H,h) ring_of_polynomials2 (H,h) lexicographic_order2 /r0 set
! 1234: (a,b,c,cp) ring_of_polynomials2 ( ) elimination_order2 /r1 set
! 1235: (x,y) ring_of_differential_operators3 (Dx,Dy) elimination_order3 /r2 set
! 1236: [r2 r1 add_rings r0 add_rings 0] define_ring
! 1237: [(Dx (x Dx + c-1) - (x Dx + y Dy + a) (x Dx + y Dy + b)).
! 1238: (Dy (y Dy + cp-1) - (x Dx + y Dy + a) (x Dx + y Dy + b)).] /ff set
! 1239: ff {[[$h$. $1$.]] replace} map homogenize /ff set
! 1240: } def
! 1241: %%%% end of add_rings
! 1242:
! 1243: %%%%%%%% usages %%%%%%%%%%%%%%%%
! 1244: /@.usages [ ] def
! 1245: /putUsages {
! 1246: /arg1 set
! 1247: /@.usages @.usages [ arg1 ] join def
! 1248: } def
! 1249:
! 1250: /showKeywords {
! 1251: @.usages { 0 get } map print ( ) message
! 1252: } def
! 1253:
! 1254: /Usage {
! 1255: /arg1 set
! 1256: [/name /flag /n /k /slist /m /i] pushVariables
! 1257: [
! 1258: /name arg1 def
! 1259: /flag true def
! 1260: @.usages length /n set
! 1261: 0 1 << n 1 sub >>
! 1262: {
! 1263: /k set
! 1264: name << @.usages k get 0 get >> eq
! 1265: {
! 1266: /slist @.usages k get 1 get def
! 1267: /m slist length def
! 1268: 0 1 << m 1 sub >> {
! 1269: /i set
! 1270: slist i get message
! 1271: } for
! 1272: /flag false def
! 1273: }
! 1274: { }
! 1275: ifelse
! 1276: } for
! 1277:
! 1278: flag
! 1279: {name usage}
! 1280: { }
! 1281: ifelse
! 1282: ] pop
! 1283: popVariables
! 1284: } def
! 1285:
! 1286:
! 1287: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! 1288:
! 1289:
! 1290: [(swap01) [
! 1291: $[ .... ] swap01 [....]$
! 1292: $Examples: [(x,y) ring_of_polynomials (x) elmination_order 0] swap01 $
! 1293: $ define_ring$
! 1294: ]] putUsages
! 1295: %
! 1296: /swap01 {
! 1297: /arg1 set
! 1298: [/rg /ch ] pushVariables
! 1299: [
! 1300: arg1 0 get /rg set % ring
! 1301: arg1 1 get /ch set % characteristics
! 1302: [rg 0 get , rg 1 get , rg 2 get ,
! 1303: << rg 3 get length >> 0 1 e_ij << rg 3 get >> mul ] /rg set
! 1304: /arg1 [ rg ch ] def
! 1305: ] pop
! 1306: popVariables
! 1307: arg1
! 1308: } def
! 1309:
! 1310: [(swap0k) [
! 1311: $[ .... ] k swap0k [....]$
! 1312: $Examples: [(x,y) ring_of_polynomials (x) elmination_order 0] 1 swap0k $
! 1313: $ define_ring$
! 1314: $swap01 == 1 swap0k$
! 1315: ]] putUsages
! 1316: %
! 1317: /swap0k {
! 1318: /arg2 set
! 1319: /arg1 set
! 1320: [/rg /ch /kk] pushVariables
! 1321: [
! 1322: arg2 /kk set
! 1323: arg1 0 get /rg set % ring
! 1324: arg1 1 get /ch set % characteristics
! 1325: [rg 0 get , rg 1 get , rg 2 get ,
! 1326: << rg 3 get length >> 0 kk e_ij << rg 3 get >> mul ] /rg set
! 1327: /arg1 [ rg ch ] def
! 1328: ] pop
! 1329: popVariables
! 1330: arg1
! 1331: } def
! 1332:
! 1333:
! 1334: ;
! 1335: /toVectors {
! 1336: { $array$ data_conversion } map
! 1337: } def
! 1338:
! 1339: /resolution {
! 1340: /arg1 set
! 1341: [/resol /gen /syz /maxLength] pushVariables
! 1342: [
! 1343: /gen arg1 0 get def
! 1344: arg1 length 1 eq
! 1345: { /maxLength -1 def }
! 1346: { /maxLength arg1 1 get def }
! 1347: ifelse
! 1348: /resol [ ] def
! 1349: {
! 1350: resol [gen] join /resol set
! 1351: (Betti Number = ) messagen
! 1352: gen length print
! 1353: ( ) message
! 1354:
! 1355: /maxLength maxLength 1 sub def
! 1356: maxLength 0 eq
! 1357: {(<<Stop the resolution because of the given max depth.>>) message exit}
! 1358: { }
! 1359: ifelse
! 1360:
! 1361: [gen [$needBack$ $needSyz$]] groebner 2 get /syz set
! 1362:
! 1363: syz length 0 eq
! 1364: {exit}
! 1365: { }
! 1366: ifelse
! 1367:
! 1368: /gen syz def
! 1369: %% homogenization %%%%%%%%%%%%%%%%%%
! 1370: (Note: The next line is removed for a test. 11/9.) message
! 1371: %gen { {[[$h$. $1$.]] replace} map } map /gen set
! 1372: gen {homogenize} map /gen set
! 1373: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! 1374: } loop
! 1375: /arg1 resol def
! 1376: ] pop
! 1377: popVariables
! 1378: arg1
! 1379: } def
! 1380:
! 1381: /TESTS {
! 1382: /test1 {
! 1383: $red@$ $module1$ switch_function
! 1384: [ [ (x^2) . (x^2-x h) . ] [ (x) . (x-h) . ] ] /ff set ;
! 1385: (ff is the input data.) message
! 1386: } def
! 1387:
! 1388: /test2 {
! 1389: $red@$ $module1$ switch_function
! 1390: [ [ (1) . (0) . ] [ (0) . (1) . ] ] /ff set ;
! 1391: (ff is the input data.) message
! 1392: } def
! 1393:
! 1394: /test3 {
! 1395: $red@$ $module1$ switch_function
! 1396: [ (x,y) ring_of_polynomials
! 1397: ( ) elimination_order
! 1398: 0
! 1399: ] define_ring
! 1400: [ [ (h) . (x) . (y ) .]
! 1401: [ (y) . (0) . (h) .]
! 1402: [ (x^2) . (x h) . (0) .]] /ff set
! 1403: (ff is the input data.) message
! 1404:
! 1405: } def
! 1406:
! 1407: /test4 {
! 1408: $red@$ $module1$ switch_function
! 1409: [ ${x,y}$ ring_of_polynomials
! 1410: ( ) elimination_order
! 1411: 0
! 1412: ] define_ring
! 1413: [ [ (x^2 + y^2 - h^2) . ]
! 1414: [ (x y - h^2) . ] ] /ff set
! 1415: (ff is the input data.) message
! 1416:
! 1417: } def
! 1418: %% characteristic variety
! 1419: /test4 {
! 1420: %% Test 1.
! 1421: [(x,y) ring_of_differential_operators (Dx,Dy) elimination_order 0]
! 1422: swap01 define_ring
! 1423:
! 1424: [((x Dx^2+Dy^2-1)+e*(Dx)). (0+e*(Dx^2)). (Dx+Dy+1). ] /ff set
! 1425:
! 1426: ff print ( ------------------ ) message
! 1427: ff characteristic print ( ) message ( ) message
! 1428:
! 1429: %% Test 2.
! 1430: [(a,b,c,d,x) ring_of_differential_operators (Dx) elimination_order 0]
! 1431: swap01 define_ring
! 1432:
! 1433: [[(x*Dx-a). (-b).] [(-c). ((x-1)*Dx-d).]] /ff set
! 1434: /ff ff homogenize def
! 1435: [ff] groebner /ans set
! 1436: ans 0 get toVectors print ( ) message
! 1437: ans 0 get characteristic print ( ) message ( ) message
! 1438:
! 1439: %% Test 3.
! 1440: [(a,b,c,d,x) ring_of_differential_operators (Dx) elimination_order 0]
! 1441: define_ring
! 1442:
! 1443: [[(x*Dx-a). (-b).] [(-c). ((x-1)*Dx-d).]] /ff set
! 1444: /ff ff homogenize def
! 1445: [ff] groebner /ans set
! 1446: ans 0 get toVectors print ( ) message ( ) message
! 1447:
! 1448: } def
! 1449:
! 1450:
! 1451: %%%%%%%%%%%%%%%%%%%%%%%%%%
! 1452:
! 1453: (type in test1,2,3.) message
! 1454: (Use toVectors to get vector representations.) message
! 1455:
! 1456: } def
! 1457:
! 1458:
! 1459:
! 1460: /lpoint { init (e). degree } def
! 1461: /characteristic {
! 1462: /arg1 set
! 1463: [/gb /lps /i /n /ans /maxp /ansp /k] pushVariables
! 1464: [ /gb arg1 def
! 1465: /ans [ ] def
! 1466: /maxp 0 def
! 1467: /lps gb {lpoint} map def
! 1468: 0 1 << lps length 1 sub >>
! 1469: {
! 1470: /i set
! 1471: lps i get maxp gt
! 1472: { /maxp lps i get def }
! 1473: { }
! 1474: ifelse
! 1475: } for
! 1476:
! 1477: %%lps print
! 1478: /ans [
! 1479: 0 1 maxp { pop [ ] } for
! 1480: ] def
! 1481:
! 1482: gb toVectors /gb set
! 1483:
! 1484: 0 1 << lps length 1 sub >>
! 1485: {
! 1486: /i set /k lps i get def
! 1487: /ansp ans k get def
! 1488: << gb i get >> k get principal /f set
! 1489: /ansp ansp [f] join def
! 1490: ans k ansp put
! 1491: } for
! 1492:
! 1493: /arg1 ans def
! 1494: ] pop
! 1495: popVariables
! 1496: arg1
! 1497: } def
! 1498:
! 1499: ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to smacro.sm1.old1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan