Annotation of OpenXM/src/k097/lib/tostr.sm1, Revision 1.1
1.1 ! maekawa 1:
! 2:
! 3: %% incmac.sm1 , 1996, 4/2
! 4: %% macros for the translator.
! 5: %%% /goto { pop } def %% should be changed later.
! 6: ( incmac.sm1: 7/22, 1996 ) messagen
! 7: /mapset {
! 8: /arg2 set /arg1 set
! 9: [/k ] pushVariables
! 10: 0 1 arg1 length 1 sub {
! 11: /k set
! 12: arg1 k get
! 13: arg2 k get
! 14: set
! 15: } for
! 16: popVariables
! 17: } def
! 18:
! 19: /a [[1 2] [3 4]] def
! 20: /@@@.indexMode {
! 21: 0 eq { %%% C-style
! 22: /Get {
! 23: /arg1 set
! 24: [/k ] pushVariables
! 25: [
! 26: arg1 0 get load
! 27: 1 1 arg1 length 1 sub {
! 28: /k set
! 29: arg1 k get ..int get
! 30: } for
! 31: /arg1 set
! 32: ] pop
! 33: popVariables
! 34: arg1
! 35: } def
! 36:
! 37: /Put {
! 38: /arg2 set
! 39: /arg1 set
! 40: [/k ] pushVariables
! 41: arg1 0 get load
! 42: [ 1 1 arg1 length 1 sub {
! 43: /k set
! 44: arg1 k get ..int
! 45: } for
! 46: ] arg2 put
! 47: popVariables
! 48: } def
! 49: } { %% else
! 50: /Get {
! 51: /arg1 set
! 52: [/k ] pushVariables
! 53: [
! 54: arg1 0 get load
! 55: 1 1 arg1 length 1 sub {
! 56: /k set
! 57: arg1 k get ..int 1 sub get
! 58: } for
! 59: /arg1 set
! 60: ] pop
! 61: popVariables
! 62: arg1
! 63: } def
! 64:
! 65: /Put {
! 66: /arg2 set
! 67: /arg1 set
! 68: [/k ] pushVariables
! 69: arg1 0 get load
! 70: [ 1 1 arg1 length 1 sub {
! 71: /k set
! 72: arg1 k get ..int 1 sub
! 73: } for
! 74: ] arg2 put
! 75: popVariables
! 76: } def
! 77: } ifelse
! 78: } def
! 79:
! 80: 0 @@@.indexMode %% Default index mode is C-style
! 81:
! 82:
! 83:
! 84:
! 85: %%%%%%%%%%%% 1996, 4/28
! 86: %% (2).. NewVector
! 87: /NewVector {
! 88: 0 get /arg1 set
! 89: arg1 (integer) dc /arg1 set
! 90: [ 1 1 arg1 { pop (0).. } for ]
! 91: } def
! 92:
! 93: %% (2).. (3).. NewMatrix
! 94: /NewMatrix {
! 95: dup 0 get /arg1 set
! 96: 1 get /arg2 set
! 97: arg1 (integer) dc /arg1 set
! 98: arg2 (integer) dc /arg2 set
! 99: [1 1 arg1 { pop [arg2] NewVector } for ]
! 100: } def
! 101:
! 102: /Join {
! 103: aload pop join
! 104: } def
! 105:
! 106:
! 107: /greaterThanOrEqual {
! 108: /arg2 set /arg1 set
! 109: arg1 arg2 gt { 1 }
! 110: { arg1 arg2 eq {1} {0} ifelse} ifelse
! 111: } def
! 112:
! 113: /lessThanOrEqual {
! 114: /arg2 set /arg1 set
! 115: arg1 arg2 lt { 1 }
! 116: { arg1 arg2 eq {1} {0} ifelse} ifelse
! 117: } def
! 118:
! 119: /k.mapReplace { {[[(h). (1).]] replace} map } def
! 120: /Dehomogenize {
! 121: 0 get /arg1 set
! 122: [
! 123: arg1 isArray not { arg1 [[(h). (1).]] replace }
! 124: { arg1 0 get isArray not { arg1 k.mapReplace }
! 125: { arg1 {k.mapReplace} map } ifelse
! 126: } ifelse
! 127: /arg1 set
! 128: ] pop
! 129: arg1
! 130: } def
! 131:
! 132:
! 133:
! 134:
! 135: ( slib.ccc: 5/16,1996 ) message /Print {
! 136: /Arglist set /FunctionValue [ ] def
! 137: [/a ] /ArgNames set ArgNames pushVariables [ %%function body
! 138: Arglist ArgNames mapset
! 139: a messagen /ExitPoint ]pop popVariables %%pop argValues
! 140: FunctionValue } def
! 141: %%end of function
! 142:
! 143: /Println {
! 144: /Arglist set /FunctionValue [ ] def
! 145: [/a ] /ArgNames set ArgNames pushVariables [ %%function body
! 146: Arglist ArgNames mapset
! 147: a message /ExitPoint ]pop popVariables %%pop argValues
! 148: FunctionValue } def
! 149: %%end of function
! 150:
! 151: /Ln {
! 152: /Arglist set /FunctionValue [ ] def
! 153: [ ] /ArgNames set ArgNames pushVariables [ %%function body
! 154: ( ) message /ExitPoint ]pop popVariables %%pop argValues
! 155: FunctionValue } def
! 156: %%end of function
! 157:
! 158: /Poly {
! 159: /Arglist set /FunctionValue [ ] def
! 160: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
! 161: Arglist ArgNames mapset
! 162: f expand /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 163: FunctionValue } def
! 164: %%end of function
! 165:
! 166: /PolyR {
! 167: /Arglist set /FunctionValue [ ] def
! 168: [/f /r ] /ArgNames set ArgNames pushVariables [ %%function body
! 169: Arglist ArgNames mapset
! 170: f r ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 171: FunctionValue } def
! 172: %%end of function
! 173:
! 174: /Degree {
! 175: /Arglist set /FunctionValue [ ] def
! 176: [/f /v ] /ArgNames set ArgNames pushVariables [ %%function body
! 177: Arglist ArgNames mapset
! 178: f v degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 179: FunctionValue } def
! 180: %%end of function
! 181:
! 182: /Append {
! 183: /Arglist set /FunctionValue [ ] def
! 184: [/f /g ] /ArgNames set ArgNames pushVariables [ %%function body
! 185: Arglist ArgNames mapset
! 186: [ %% function args
! 187: f [ g ] ] Join
! 188: /FunctionValue set {/ExitPoint goto} exec %%return
! 189: /ExitPoint ]pop popVariables %%pop argValues
! 190: FunctionValue } def
! 191: %%end of function
! 192:
! 193: /Length {
! 194: /Arglist set /FunctionValue [ ] def
! 195: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
! 196: Arglist ArgNames mapset
! 197: f length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 198: FunctionValue } def
! 199: %%end of function
! 200:
! 201: /Indexed {
! 202: /Arglist set /FunctionValue [ ] def
! 203: [/name /i ] /ArgNames set ArgNames pushVariables [ %%function body
! 204: Arglist ArgNames mapset
! 205: name i s.Indexed /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 206: FunctionValue } def
! 207: %%end of function
! 208:
! 209: /Indexed2 {
! 210: /Arglist set /FunctionValue [ ] def
! 211: [/name /i /j ] /ArgNames set ArgNames pushVariables [ %%function body
! 212: Arglist ArgNames mapset
! 213: name i j s.Indexed2 /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 214: FunctionValue } def
! 215: %%end of function
! 216:
! 217: /Transpose {
! 218: /Arglist set /FunctionValue [ ] def
! 219: [/mat ] /ArgNames set ArgNames pushVariables [ %%function body
! 220: Arglist ArgNames mapset
! 221: mat transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 222: FunctionValue } def
! 223: %%end of function
! 224:
! 225:
! 226: /s.Indexed {
! 227: (integer) dc /arg2 set
! 228: /arg1 set
! 229: arg1 ([) arg2 (dollar) dc (]) 4 cat_n
! 230: } def
! 231:
! 232: /s.Indexed2 {
! 233: (integer) dc /arg3 set
! 234: (integer) dc /arg2 set
! 235: /arg1 set
! 236: arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
! 237: } def
! 238: /Groebner {
! 239: /Arglist set /FunctionValue [ ] def
! 240: [/F ] /ArgNames set ArgNames pushVariables [ %%function body
! 241: Arglist ArgNames mapset
! 242: [ %% function args
! 243: (Input is ) ] Print
! 244: [ %% function args
! 245: F ] Println
! 246: F {[[(h). (1).]] replace homogenize} map /arg1 set
! 247: [arg1] groebner 0 get
! 248: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 249: FunctionValue } def
! 250: %%end of function
! 251:
! 252: /LiftStd {
! 253: /Arglist set /FunctionValue [ ] def
! 254: [/F ] /ArgNames set ArgNames pushVariables [ %%function body
! 255: Arglist ArgNames mapset
! 256: [ %% function args
! 257: (Input is ) ] Print
! 258: [ %% function args
! 259: F ] Println
! 260: F {[[(h). (1).]] replace homogenize} map /arg1 set
! 261: [arg1 [(needBack)]] groebner
! 262: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 263: FunctionValue } def
! 264: %%end of function
! 265:
! 266: /Reduction {
! 267: /Arglist set /FunctionValue [ ] def
! 268: [/f /G ] /ArgNames set ArgNames pushVariables [ %%function body
! 269: Arglist ArgNames mapset
! 270: f G reduction /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 271: FunctionValue } def
! 272: %%end of function
! 273:
! 274: /IntegerToMachineInteger {
! 275: /Arglist set /FunctionValue [ ] def
! 276: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
! 277: Arglist ArgNames mapset
! 278: f (integer) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 279: FunctionValue } def
! 280: %%end of function
! 281:
! 282: /RingD {
! 283: /Arglist set /FunctionValue [ ] def
! 284: [/vList /weightMatrix ] /ArgNames set ArgNames pushVariables [ %%function body
! 285: Arglist ArgNames mapset
! 286: [ %%start of local variables
! 287: /new /tmp /size /n /i /j /newtmp ] pushVariables [ %%local variables
! 288: [ %% function args
! 289: Arglist ] Length
! 290: (2).. lt
! 291: %% if-condition
! 292: { %%ifbody
! 293: [ vList ring_of_differential_operators ( ) elimination_order 0 ] define_ring
! 294: /tmp set tmp /FunctionValue set {/ExitPoint goto} exec %%return
! 295: }%%end if if body
! 296: { %%if- else part
! 297: } ifelse
! 298: /size [ %% function args
! 299: weightMatrix ] Length
! 300: def
! 301: /new [ %% function args
! 302: size ] NewVector
! 303: def
! 304: /i (1).. def
! 305: %%for init.
! 306: %%for
! 307: { i size lessThanOrEqual
! 308: { } {exit} ifelse
! 309: [ {%%increment
! 310: /i i (1).. add def
! 311: } %%end of increment{A}
! 312: {%%start of B part{B}
! 313: /tmp [/weightMatrix i ] Get
! 314: def
! 315: /n [ %% function args
! 316: tmp ] Length
! 317: def
! 318: /newtmp [ %% function args
! 319: n ] NewVector
! 320: def
! 321: /j (2).. def
! 322: %%for init.
! 323: %%for
! 324: { j n lessThanOrEqual
! 325: { } {exit} ifelse
! 326: [ {%%increment
! 327: /j j (2).. add
! 328: def
! 329: } %%end of increment{A}
! 330: {%%start of B part{B}
! 331: [/newtmp j (1).. sub
! 332: ] [/tmp j (1).. sub
! 333: ] Get
! 334: Put
! 335: [/newtmp j ] [ %% function args
! 336: [/tmp j ] Get
! 337: ] IntegerToMachineInteger
! 338: Put
! 339: } %% end of B part. {B}
! 340: 2 1 roll] {exec} map
! 341: } loop %%end of for
! 342: [/new i ] newtmp Put
! 343: } %% end of B part. {B}
! 344: 2 1 roll] {exec} map
! 345: } loop %%end of for
! 346: [ vList ring_of_differential_operators new weight_vector 0 ] define_ring
! 347: /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables
! 348: /ExitPoint ]pop popVariables %%pop argValues
! 349: FunctionValue } def
! 350: %%end of function
! 351:
! 352: /AddString {
! 353: /Arglist set /FunctionValue [ ] def
! 354: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
! 355: Arglist ArgNames mapset
! 356: f aload length cat_n /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 357: FunctionValue } def
! 358: %%end of function
! 359:
! 360: /IntegerToString {
! 361: /Arglist set /FunctionValue [ ] def
! 362: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
! 363: Arglist ArgNames mapset
! 364: f (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 365: FunctionValue } def
! 366: %%end of function
! 367:
! 368: /Replace {
! 369: /Arglist set /FunctionValue [ ] def
! 370: [/f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
! 371: Arglist ArgNames mapset
! 372: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 373: FunctionValue } def
! 374: %%end of function
! 375:
! 376: /AsciiToString {
! 377: /Arglist set /FunctionValue [ ] def
! 378: [/c ] /ArgNames set ArgNames pushVariables [ %%function body
! 379: Arglist ArgNames mapset
! 380: c (integer) dc (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 381: FunctionValue } def
! 382: %%end of function
! 383:
! 384: /ToString {
! 385: /Arglist set /FunctionValue [ ] def
! 386: [/p ] /ArgNames set ArgNames pushVariables [ %%function body
! 387: Arglist ArgNames mapset
! 388: [ %%start of local variables
! 389: /n /ans /i ] pushVariables [ %%local variables
! 390: /ans [ ] def
! 391: [ %% function args
! 392: p ] IsArray
! 393: %% if-condition
! 394: { %%ifbody
! 395: /n [ %% function args
! 396: p ] Length
! 397: def
! 398: /ans [ %% function args
! 399: ans ([ ) ] Append
! 400: def
! 401: /i (0).. def
! 402: %%for init.
! 403: %%for
! 404: { i n lt
! 405: { } {exit} ifelse
! 406: [ {%%increment
! 407: /i i (1).. add def
! 408: } %%end of increment{A}
! 409: {%%start of B part{B}
! 410: /ans [ %% function args
! 411: ans [ %% function args
! 412: [/p i ] Get
! 413: ] ToString
! 414: ] Append
! 415: def
! 416: i n (1).. sub
! 417: eq not
! 418: %% if-condition
! 419: { %%ifbody
! 420: /ans [ %% function args
! 421: ans ( , ) ] Append
! 422: def
! 423: }%%end if if body
! 424: { %%if- else part
! 425: } ifelse
! 426: } %% end of B part. {B}
! 427: 2 1 roll] {exec} map
! 428: } loop %%end of for
! 429: /ans [ %% function args
! 430: ans ( ] ) ] Append
! 431: def
! 432: }%%end if if body
! 433: { %%if- else part
! 434: /ans [ p (dollar) dc ] def
! 435: } ifelse
! 436: [ %% function args
! 437: ans ] AddString
! 438: /FunctionValue set {/ExitPoint goto} exec %%return
! 439: /ExitPoint ]pop popVariables %%pop the local variables
! 440: /ExitPoint ]pop popVariables %%pop argValues
! 441: FunctionValue } def
! 442: %%end of function
! 443:
! 444: /IsArray {
! 445: /Arglist set /FunctionValue [ ] def
! 446: [/p ] /ArgNames set ArgNames pushVariables [ %%function body
! 447: Arglist ArgNames mapset
! 448: p isArray /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 449: FunctionValue } def
! 450: %%end of function
! 451:
! 452: 0 @@@.indexMode /tostr2 {
! 453: /Arglist set /FunctionValue [ ] def
! 454: [/p ] /ArgNames set ArgNames pushVariables [ %%function body
! 455: Arglist ArgNames mapset
! 456: [ %%start of local variables
! 457: /n /ans /i ] pushVariables [ %%local variables
! 458: /ans [ ] def
! 459: [ %% function args
! 460: p ] IsArray
! 461: %% if-condition
! 462: { %%ifbody
! 463: /n [ %% function args
! 464: p ] Length
! 465: def
! 466: /ans [ %% function args
! 467: ans ([ ) ] Append
! 468: def
! 469: /i (0).. def
! 470: %%for init.
! 471: %%for
! 472: { i n lt
! 473: { } {exit} ifelse
! 474: [ {%%increment
! 475: /i i (1).. add def
! 476: } %%end of increment{A}
! 477: {%%start of B part{B}
! 478: /ans [ %% function args
! 479: ans [ %% function args
! 480: [/p i ] Get
! 481: ] tostr2
! 482: ] Append
! 483: def
! 484: i n (1).. sub
! 485: eq not
! 486: %% if-condition
! 487: { %%ifbody
! 488: /ans [ %% function args
! 489: ans ( , ) ] Append
! 490: def
! 491: }%%end if if body
! 492: { %%if- else part
! 493: } ifelse
! 494: } %% end of B part. {B}
! 495: 2 1 roll] {exec} map
! 496: } loop %%end of for
! 497: /ans [ %% function args
! 498: ans ( ] ) ] Append
! 499: def
! 500: }%%end if if body
! 501: { %%if- else part
! 502: /ans [ p (dollar) dc ] def
! 503: } ifelse
! 504: [ %% function args
! 505: ans ] AddString
! 506: /FunctionValue set {/ExitPoint goto} exec %%return
! 507: /ExitPoint ]pop popVariables %%pop the local variables
! 508: /ExitPoint ]pop popVariables %%pop argValues
! 509: FunctionValue } def
! 510: %%end of function
! 511:
! 512: /IsArray {
! 513: /Arglist set /FunctionValue [ ] def
! 514: [/p ] /ArgNames set ArgNames pushVariables [ %%function body
! 515: Arglist ArgNames mapset
! 516: p isArray /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
! 517: FunctionValue } def
! 518: %%end of function
! 519:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to tostr.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / lib