Annotation of OpenXM/src/k097/slib.sm1, Revision 1.6
1.1 maekawa 1: K00_verbose %% if-condition
2: { %%ifbody
3: ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message }%%end if if body
4: { %%if- else part
5: } ifelse
6: [ ] /Helplist set
7: /HelpAdd {
8: db.DebugStack setstack $In function : HelpAdd of class PrimitiveObject$ stdstack
9: /Arglist set /Argthis set /FunctionValue [ ] def
10: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
11: [Argthis] Arglist join ArgNames mapset
12: this [ %% function args
13: Helplist s ] {Append} sendmsg2
14: /Helplist set
15: /ExitPoint ]pop popVariables %%pop argValues
16: db.DebugStack setstack pop stdstack
17: } def
18: %%end of function
19:
20: /Print {
21: db.DebugStack setstack $In function : Print of class PrimitiveObject$ stdstack
22: /Arglist set /Argthis set /FunctionValue [ ] def
23: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
24: [Argthis] Arglist join ArgNames mapset
25: a messagen /ExitPoint ]pop popVariables %%pop argValues
26: db.DebugStack setstack pop stdstack
27: FunctionValue } def
28: %%end of function
29:
30: /Println {
31: db.DebugStack setstack $In function : Println of class PrimitiveObject$ stdstack
32: /Arglist set /Argthis set /FunctionValue [ ] def
33: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
34: [Argthis] Arglist join ArgNames mapset
35: a message /ExitPoint ]pop popVariables %%pop argValues
36: db.DebugStack setstack pop stdstack
37: FunctionValue } def
38: %%end of function
39:
40: /Ln {
41: db.DebugStack setstack $In function : Ln of class PrimitiveObject$ stdstack
42: /Arglist set /Argthis set /FunctionValue [ ] def
43: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
44: [Argthis] ArgNames mapset
45: ( ) message /ExitPoint ]pop popVariables %%pop argValues
46: db.DebugStack setstack pop stdstack
47: FunctionValue } def
48: %%end of function
49:
50: /Poly {
51: db.DebugStack setstack $In function : Poly of class PrimitiveObject$ stdstack
52: /Arglist set /Argthis set /FunctionValue [ ] def
53: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
54: [Argthis] Arglist join ArgNames mapset
55: f (poly) data_conversion /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
56: db.DebugStack setstack pop stdstack
57: FunctionValue } def
58: %%end of function
59:
60: /PolyR {
61: db.DebugStack setstack $In function : PolyR of class PrimitiveObject$ stdstack
62: /Arglist set /Argthis set /FunctionValue [ ] def
63: [/this /f /r ] /ArgNames set ArgNames pushVariables [ %%function body
64: [Argthis] Arglist join ArgNames mapset
65: f r ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
66: db.DebugStack setstack pop stdstack
67: FunctionValue } def
68: %%end of function
69:
70: /Degree {
71: db.DebugStack setstack $In function : Degree of class PrimitiveObject$ stdstack
72: /Arglist set /Argthis set /FunctionValue [ ] def
73: [/this /f /v ] /ArgNames set ArgNames pushVariables [ %%function body
74: [Argthis] Arglist join ArgNames mapset
75: f v degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
76: db.DebugStack setstack pop stdstack
77: FunctionValue } def
78: %%end of function
79:
80: /Append {
81: db.DebugStack setstack $In function : Append of class PrimitiveObject$ stdstack
82: /Arglist set /Argthis set /FunctionValue [ ] def
83: [/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body
84: [Argthis] Arglist join ArgNames mapset
85: this [ %% function args
86: f [ g ] ] {Join} sendmsg2
87: /FunctionValue set {/ExitPoint goto} exec %%return
88: /ExitPoint ]pop popVariables %%pop argValues
89: db.DebugStack setstack pop stdstack
90: FunctionValue } def
91: %%end of function
92:
93: /Length {
94: db.DebugStack setstack $In function : Length of class PrimitiveObject$ stdstack
95: /Arglist set /Argthis set /FunctionValue [ ] def
96: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
97: [Argthis] Arglist join ArgNames mapset
98: f length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
99: db.DebugStack setstack pop stdstack
100: FunctionValue } def
101: %%end of function
102:
103: /Indexed {
104: db.DebugStack setstack $In function : Indexed of class PrimitiveObject$ stdstack
105: /Arglist set /Argthis set /FunctionValue [ ] def
106: [/this /name /i ] /ArgNames set ArgNames pushVariables [ %%function body
107: [Argthis] Arglist join ArgNames mapset
108: name i s.Indexed /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
109: db.DebugStack setstack pop stdstack
110: FunctionValue } def
111: %%end of function
112:
113: /Indexed2 {
114: db.DebugStack setstack $In function : Indexed2 of class PrimitiveObject$ stdstack
115: /Arglist set /Argthis set /FunctionValue [ ] def
116: [/this /name /i /j ] /ArgNames set ArgNames pushVariables [ %%function body
117: [Argthis] Arglist join ArgNames mapset
118: name i j s.Indexed2 /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
119: db.DebugStack setstack pop stdstack
120: FunctionValue } def
121: %%end of function
122:
123: /Transpose {
124: db.DebugStack setstack $In function : Transpose of class PrimitiveObject$ stdstack
125: /Arglist set /Argthis set /FunctionValue [ ] def
126: [/this /mat ] /ArgNames set ArgNames pushVariables [ %%function body
127: [Argthis] Arglist join ArgNames mapset
128: mat transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
129: db.DebugStack setstack pop stdstack
130: FunctionValue } def
131: %%end of function
132:
133:
134: /s.Indexed {
135: (integer) dc /arg2 set
136: /arg1 set
137: arg1 ([) arg2 (dollar) dc (]) 4 cat_n
138: } def
139:
140: /s.Indexed2 {
141: (integer) dc /arg3 set
142: (integer) dc /arg2 set
143: /arg1 set
144: arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
145: } def
146: /Groebner {
147: db.DebugStack setstack $In function : Groebner of class PrimitiveObject$ stdstack
148: /Arglist set /Argthis set /FunctionValue [ ] def
149: [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
150: [Argthis] Arglist join ArgNames mapset
151: F {[[(h). (1).]] replace homogenize} map /arg1 set
152: [arg1] groebner 0 get
153: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
154: db.DebugStack setstack pop stdstack
155: FunctionValue } def
156: %%end of function
157:
158: /GroebnerTime {
159: db.DebugStack setstack $In function : GroebnerTime of class PrimitiveObject$ stdstack
160: /Arglist set /Argthis set /FunctionValue [ ] def
161: [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
162: [Argthis] Arglist join ArgNames mapset
163: F {[[(h). (1).]] replace homogenize} map /arg1 set
164: { [arg1] groebner 0 get } timer
165: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
166: db.DebugStack setstack pop stdstack
167: FunctionValue } def
168: %%end of function
169:
170: /LiftStd {
171: db.DebugStack setstack $In function : LiftStd of class PrimitiveObject$ stdstack
172: /Arglist set /Argthis set /FunctionValue [ ] def
173: [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
174: [Argthis] Arglist join ArgNames mapset
175: F {[[(h). (1).]] replace homogenize} map /arg1 set
176: [arg1 [(needBack)]] groebner
177: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
178: db.DebugStack setstack pop stdstack
179: FunctionValue } def
180: %%end of function
181:
182: /Reduction {
183: db.DebugStack setstack $In function : Reduction of class PrimitiveObject$ stdstack
184: /Arglist set /Argthis set /FunctionValue [ ] def
1.6 ! takayama 185: [/this /f /myset ] /ArgNames set ArgNames pushVariables [ %%function body
1.1 maekawa 186: [Argthis] Arglist join ArgNames mapset
1.6 ! takayama 187: [ %%start of local variables
! 188: /n /indexTable /set2 /i /j /tmp /t_syz /r /rng /vsize /tt ] pushVariables [ %%local variables
! 189: null /vsize set
! 190: this [ %% function args
! 191: this [ %% function args
! 192: (1) ] {Poly} sendmsg2
! 193: ] {GetRing} sendmsg2
! 194: /r set
! 195: this [ %% function args
! 196: f ] {GetRing} sendmsg2
! 197: /rng set
! 198: this [ %% function args
! 199: rng ] {Tag} sendmsg2
! 200: (0).. eq
! 201: %% if-condition
! 202: { %%ifbody
! 203: this [ %% function args
! 204: myset ] {GetRing} sendmsg2
! 205: /rng set
! 206: }%%end if if body
! 207: { %%if- else part
! 208: } ifelse
! 209: this [ %% function args
! 210: rng ] {Tag} sendmsg2
! 211: (0).. eq not
! 212: %% if-condition
! 213: { %%ifbody
! 214: this [ %% function args
! 215: rng ] {SetRing} sendmsg2
! 216: }%%end if if body
! 217: { %%if- else part
! 218: } ifelse
! 219: this [ %% function args
! 220: f ] {IsArray} sendmsg2
! 221: %% if-condition
! 222: { %%ifbody
! 223: this [ %% function args
! 224: f ] {Length} sendmsg2
! 225: /vsize set
! 226: [f] fromVectors 0 get /f set }%%end if if body
! 227: { %%if- else part
! 228: } ifelse
! 229: this [ %% function args
! 230: myset ] {Length} sendmsg2
! 231: /n set
! 232: n (0).. gt
! 233: %% if-condition
! 234: { %%ifbody
! 235: this [ %% function args
! 236: myset [(0).. ] Get
! 237: ] {IsArray} sendmsg2
! 238: %% if-condition
! 239: { %%ifbody
! 240: vsize this [ %% function args
! 241: myset [(0).. ] Get
! 242: ] {Length} sendmsg2
! 243: eq not
! 244: %% if-condition
! 245: { %%ifbody
! 246: this [ %% function args
! 247: (Reduction: size mismatch.) ] {Error} sendmsg2
! 248: }%%end if if body
! 249: { %%if- else part
! 250: } ifelse
! 251: myset fromVectors /myset set }%%end if if body
! 252: { %%if- else part
! 253: } ifelse
! 254: }%%end if if body
! 255: { %%if- else part
! 256: } ifelse
! 257: this [ %% function args
! 258: n ] {NewArray} sendmsg2
! 259: /indexTable set
! 260: [ ] /set2 set
! 261: (0).. /j set
! 262: (0).. /i set
! 263: %%for init.
! 264: %%for
! 265: { i n lt
! 266: { } {exit} ifelse
! 267: [ {%%increment
! 268: /i i (1).. {add} sendmsg2 def
! 269: } %%end of increment{A}
! 270: {%%start of B part{B}
! 271: this [ %% function args
! 272: myset [i ] Get
! 273: ] {Tag} sendmsg2
! 274: (0).. eq
! 275: %% if-condition
! 276: { %%ifbody
! 277: indexTable [i ] (1).. (0).. 2 1 roll {sub} sendmsg
! 278: Put
! 279: }%%end if if body
! 280: { %%if- else part
! 281: myset [i ] Get
! 282: this [ %% function args
! 283: (0) ] {Poly} sendmsg2
! 284: eq
! 285: %% if-condition
! 286: { %%ifbody
! 287: indexTable [i ] (1).. (0).. 2 1 roll {sub} sendmsg
! 288: Put
! 289: }%%end if if body
! 290: { %%if- else part
! 291: this [ %% function args
! 292: set2 myset [i ] Get
! 293: ] {Append} sendmsg2
! 294: /set2 set
! 295: indexTable [i ] j Put
! 296: /j j (1).. {add} sendmsg2 def
! 297: } ifelse
! 298: } ifelse
! 299: } %% end of B part. {B}
! 300: 2 1 roll] {exec} map pop
! 301: } loop %%end of for
! 302: f set2 (gradedPolySet) dc reduction /tmp set this [ %% function args
! 303: n ] {NewArray} sendmsg2
! 304: /t_syz set
! 305: (0).. /i set
! 306: %%for init.
! 307: %%for
! 308: { i n lt
! 309: { } {exit} ifelse
! 310: [ {%%increment
! 311: /i i (1).. {add} sendmsg2 def
! 312: } %%end of increment{A}
! 313: {%%start of B part{B}
! 314: indexTable [i ] Get
! 315: (1).. (0).. 2 1 roll {sub} sendmsg
! 316: eq not
! 317: %% if-condition
! 318: { %%ifbody
! 319: t_syz [i ] tmp [(2).. indexTable [i ] Get
! 320: ] Get
! 321: Put
! 322: }%%end if if body
! 323: { %%if- else part
! 324: t_syz [i ] this [ %% function args
! 325: (0) ] {Poly} sendmsg2
! 326: Put
! 327: } ifelse
! 328: } %% end of B part. {B}
! 329: 2 1 roll] {exec} map pop
! 330: } loop %%end of for
! 331: this [ %% function args
! 332: vsize ] {Tag} sendmsg2
! 333: (0).. eq not
! 334: %% if-condition
! 335: { %%ifbody
! 336: tmp [(0).. ] Get
! 337: /tt set
! 338: [vsize (integer) dc tt] toVectors /tt set tmp [(0).. ] tt Put
! 339: }%%end if if body
! 340: { %%if- else part
! 341: } ifelse
! 342: this [ %% function args
! 343: r ] {SetRing} sendmsg2
! 344: [ tmp [(0).. ] Get
! 345: tmp [(1).. ] Get
! 346: t_syz ] /FunctionValue set {/ExitPoint goto} exec %%return
! 347: /ExitPoint ]pop popVariables %%pop the local variables
! 348: /ExitPoint ]pop popVariables %%pop argValues
1.1 maekawa 349: db.DebugStack setstack pop stdstack
350: FunctionValue } def
351: %%end of function
352:
353: /IntegerToSm1Integer {
354: db.DebugStack setstack $In function : IntegerToSm1Integer of class PrimitiveObject$ stdstack
355: /Arglist set /Argthis set /FunctionValue [ ] def
356: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
357: [Argthis] Arglist join ArgNames mapset
358: f (integer) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
359: db.DebugStack setstack pop stdstack
360: FunctionValue } def
361: %%end of function
362:
363: /RingD {
364: db.DebugStack setstack $In function : RingD of class PrimitiveObject$ stdstack
365: /Arglist set /Argthis set /FunctionValue [ ] def
366: [/this /vList /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body
367: [Argthis] Arglist join ArgNames mapset
368: [ %%start of local variables
369: /new0 /tmp /size /n /i /j /newtmp /ringpp /argsize ] pushVariables [ %%local variables
370: this [ %% function args
371: Arglist ] {Length} sendmsg2
372: /argsize set
373: argsize (1).. eq
374: %% if-condition
375: { %%ifbody
376: [ vList ring_of_differential_operators ( ) elimination_order 0 ] define_ring
1.4 takayama 377: /tmp set this [ %% function args
378: ] {SetRingVariables} sendmsg2
379: tmp /FunctionValue set {/ExitPoint goto} exec %%return
1.1 maekawa 380: }%%end if if body
381: { %%if- else part
382: } ifelse
383: argsize (2).. eq
384: %% if-condition
385: { %%ifbody
386: (0).. /pp set
387: }%%end if if body
388: { %%if- else part
389: } ifelse
390: this [ %% function args
391: pp ] {IntegerToSm1Integer} sendmsg2
392: /pp set
393: this [ %% function args
394: weightMatrix ] {Length} sendmsg2
395: /size set
396: this [ %% function args
397: size ] {NewVector} sendmsg2
398: /new0 set
399: /@@@.indexMode.flag.save @@@.indexMode.flag def 0 @@@.indexMode (0).. %%PSfor initvalue.
400: (integer) data_conversion
401: size (1).. sub (integer) data_conversion 1 2 -1 roll
402: { %% for body
403: (universalNumber) data_conversion /i set
404: weightMatrix [i ] Get
405: /tmp set
406: this [ %% function args
407: tmp ] {Length} sendmsg2
408: /n set
409: this [ %% function args
410: n ] {NewVector} sendmsg2
411: /newtmp set
412: (1).. /j set
413: %%for init.
414: %%for
415: { j n lt
416: { } {exit} ifelse
417: [ {%%increment
418: j (2).. {add} sendmsg2
419: /j set
420: } %%end of increment{A}
421: {%%start of B part{B}
422: newtmp [j (1).. {sub} sendmsg2
423: ] tmp [j (1).. {sub} sendmsg2
424: ] Get
425: Put
426: newtmp [j ] this [ %% function args
427: tmp [j ] Get
428: ] {IntegerToSm1Integer} sendmsg2
429: Put
430: } %% end of B part. {B}
431: 2 1 roll] {exec} map pop
432: } loop %%end of for
433: new0 [i ] newtmp Put
434: } for
435: [ vList ring_of_differential_operators new0 weight_vector pp ] define_ring /ringpp set
1.4 takayama 436: this [ %% function args
437: ] {SetRingVariables} sendmsg2
1.1 maekawa 438: @@@.indexMode.flag.save @@@.indexMode ringpp /FunctionValue set {/ExitPoint goto} exec %%return
439: /ExitPoint ]pop popVariables %%pop the local variables
440: /ExitPoint ]pop popVariables %%pop argValues
441: db.DebugStack setstack pop stdstack
442: FunctionValue } def
443: %%end of function
444:
445: /getxvar {
446: db.DebugStack setstack $In function : getxvar of class PrimitiveObject$ stdstack
447: /Arglist set /Argthis set /FunctionValue [ ] def
448: [/this /i ] /ArgNames set ArgNames pushVariables [ %%function body
449: [Argthis] Arglist join ArgNames mapset
450: [(x) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
451: db.DebugStack setstack pop stdstack
452: FunctionValue } def
453: %%end of function
454:
455: /getdvar {
456: db.DebugStack setstack $In function : getdvar of class PrimitiveObject$ stdstack
457: /Arglist set /Argthis set /FunctionValue [ ] def
458: [/this /i ] /ArgNames set ArgNames pushVariables [ %%function body
459: [Argthis] Arglist join ArgNames mapset
460: [(D) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
461: db.DebugStack setstack pop stdstack
462: FunctionValue } def
463: %%end of function
464:
465: /getvarn {
466: db.DebugStack setstack $In function : getvarn of class PrimitiveObject$ stdstack
467: /Arglist set /Argthis set /FunctionValue [ ] def
468: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
469: [Argthis] ArgNames mapset
470: [(N)] system_variable (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
471: db.DebugStack setstack pop stdstack
472: FunctionValue } def
473: %%end of function
474:
1.4 takayama 475: false /SetRingVariables_Verbose set
1.1 maekawa 476: /SetRingVariables {
477: db.DebugStack setstack $In function : SetRingVariables of class PrimitiveObject$ stdstack
478: /Arglist set /Argthis set /FunctionValue [ ] def
479: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
480: [Argthis] ArgNames mapset
481: SetRingVariables_Verbose %% if-condition
482: { %%ifbody
483: this [ %% function args
484: (SetRingVariables() Setting the global variables : ) ] {Print} sendmsg2
485: }%%end if if body
486: { %%if- else part
487: } ifelse
488: this [ %% function args
1.4 takayama 489: (0).. [(N)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
490: %% if-condition
491: { %%ifbody
492: define_ring_variables }%%end if if body
493: { %%if- else part
494: } ifelse
1.1 maekawa 495: SetRingVariables_Verbose %% if-condition
496: { %%ifbody
497: this [ %% function args
498: ] {Ln} sendmsg2
499: }%%end if if body
500: { %%if- else part
501: } ifelse
502: /ExitPoint ]pop popVariables %%pop argValues
503: db.DebugStack setstack pop stdstack
504: FunctionValue } def
505: %%end of function
506:
507: /k00AreThereLeftBrace {
508: db.DebugStack setstack $In function : k00AreThereLeftBrace of class PrimitiveObject$ stdstack
509: /Arglist set /Argthis set /FunctionValue [ ] def
510: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
511: [Argthis] Arglist join ArgNames mapset
512: [ %%start of local variables
513: /leftBrace /jj /slist ] pushVariables [ %%local variables
514: $[$ (array) dc 0 get (universalNumber) dc /leftBrace set
515: this [ %% function args
516: this [ %% function args
517: s ] {StringToIntegerArray} sendmsg2
518: leftBrace ] {Position} sendmsg2
519: /jj set
520: jj (1).. (0).. 2 1 roll {sub} sendmsg
521: eq not
522: %% if-condition
523: { %%ifbody
524: true /FunctionValue set {/ExitPoint goto} exec %%return
525: }%%end if if body
526: { %%if- else part
527: false /FunctionValue set {/ExitPoint goto} exec %%return
528: } ifelse
529: /ExitPoint ]pop popVariables %%pop the local variables
530: /ExitPoint ]pop popVariables %%pop argValues
531: db.DebugStack setstack pop stdstack
532: FunctionValue } def
533: %%end of function
534:
535: /k00setRingVariables {
536: db.DebugStack setstack $In function : k00setRingVariables of class PrimitiveObject$ stdstack
537: /Arglist set /Argthis set /FunctionValue [ ] def
1.4 takayama 538: [/this /p /q ] /ArgNames set ArgNames pushVariables [ %%function body
1.1 maekawa 539: [Argthis] Arglist join ArgNames mapset
540: [ %%start of local variables
1.4 takayama 541: /v /i ] pushVariables [ %%local variables
542: p /i set
543: %%for init.
544: %%for
545: { i q lt
546: { } {exit} ifelse
547: [ {%%increment
548: /i i (1).. {add} sendmsg2 def
549: } %%end of increment{A}
550: {%%start of B part{B}
1.1 maekawa 551: this [ %% function args
1.4 takayama 552: i ] {getxvar} sendmsg2
553: /v set
1.1 maekawa 554: this [ %% function args
1.4 takayama 555: v ] {k00AreThereLeftBrace} sendmsg2
1.1 maekawa 556: %% if-condition
557: { %%ifbody
1.4 takayama 558: false /FunctionValue set {/ExitPoint goto} exec %%return
1.1 maekawa 559: }%%end if if body
560: { %%if- else part
561: } ifelse
562: this [ %% function args
1.4 takayama 563: i ] {getdvar} sendmsg2
564: /v set
1.1 maekawa 565: this [ %% function args
1.4 takayama 566: v ] {k00AreThereLeftBrace} sendmsg2
1.1 maekawa 567: %% if-condition
568: { %%ifbody
1.4 takayama 569: false /FunctionValue set {/ExitPoint goto} exec %%return
1.1 maekawa 570: }%%end if if body
571: { %%if- else part
572: } ifelse
1.4 takayama 573: } %% end of B part. {B}
574: 2 1 roll] {exec} map pop
575: } loop %%end of for
576: true /FunctionValue set {/ExitPoint goto} exec %%return
1.1 maekawa 577: /ExitPoint ]pop popVariables %%pop the local variables
578: /ExitPoint ]pop popVariables %%pop argValues
579: db.DebugStack setstack pop stdstack
1.4 takayama 580: FunctionValue } def
1.1 maekawa 581: %%end of function
582:
583: /AddString {
584: db.DebugStack setstack $In function : AddString of class PrimitiveObject$ stdstack
585: /Arglist set /Argthis set /FunctionValue [ ] def
586: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
587: [Argthis] Arglist join ArgNames mapset
588: f aload length cat_n /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
589: db.DebugStack setstack pop stdstack
590: FunctionValue } def
591: %%end of function
592:
593: /IntegerToString {
594: db.DebugStack setstack $In function : IntegerToString of class PrimitiveObject$ stdstack
595: /Arglist set /Argthis set /FunctionValue [ ] def
596: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
597: [Argthis] Arglist join ArgNames mapset
598: f (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
599: db.DebugStack setstack pop stdstack
600: FunctionValue } def
601: %%end of function
602:
603: /Replace {
604: db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack
605: /Arglist set /Argthis set /FunctionValue [ ] def
606: [/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
607: [Argthis] Arglist join ArgNames mapset
608: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
609: db.DebugStack setstack pop stdstack
610: FunctionValue } def
611: %%end of function
612:
613: /AsciiToString {
614: db.DebugStack setstack $In function : AsciiToString of class PrimitiveObject$ stdstack
615: /Arglist set /Argthis set /FunctionValue [ ] def
616: [/this /c ] /ArgNames set ArgNames pushVariables [ %%function body
617: [Argthis] Arglist join ArgNames mapset
618: c (integer) dc (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
619: db.DebugStack setstack pop stdstack
620: FunctionValue } def
621: %%end of function
622:
623: /ToString {
624: db.DebugStack setstack $In function : ToString of class PrimitiveObject$ stdstack
625: /Arglist set /Argthis set /FunctionValue [ ] def
626: [/this /p ] /ArgNames set ArgNames pushVariables [ %%function body
627: [Argthis] Arglist join ArgNames mapset
628: [ %%start of local variables
629: /n /ans /i ] pushVariables [ %%local variables
630: [ ] /ans set
631: this [ %% function args
632: p ] {IsArray} sendmsg2
633: %% if-condition
634: { %%ifbody
635: this [ %% function args
636: p ] {Length} sendmsg2
637: /n set
638: this [ %% function args
639: ans ([ ) ] {Append} sendmsg2
640: /ans set
641: (0).. /i set
642: %%for init.
643: %%for
644: { i n lt
645: { } {exit} ifelse
646: [ {%%increment
647: /i i (1).. {add} sendmsg2 def
648: } %%end of increment{A}
649: {%%start of B part{B}
650: this [ %% function args
651: ans this [ %% function args
652: p [i ] Get
653: ] {ToString} sendmsg2
654: ] {Append} sendmsg2
655: /ans set
656: i n (1).. {sub} sendmsg2
657: eq not
658: %% if-condition
659: { %%ifbody
660: this [ %% function args
661: ans ( , ) ] {Append} sendmsg2
662: /ans set
663: }%%end if if body
664: { %%if- else part
665: } ifelse
666: } %% end of B part. {B}
667: 2 1 roll] {exec} map pop
668: } loop %%end of for
669: this [ %% function args
670: ans ( ] ) ] {Append} sendmsg2
671: /ans set
672: }%%end if if body
673: { %%if- else part
674: [ p (dollar) dc ] /ans set
675: } ifelse
676: this [ %% function args
677: ans ] {AddString} sendmsg2
678: /FunctionValue set {/ExitPoint goto} exec %%return
679: /ExitPoint ]pop popVariables %%pop the local variables
680: /ExitPoint ]pop popVariables %%pop argValues
681: db.DebugStack setstack pop stdstack
682: FunctionValue } def
683: %%end of function
684:
685: /IsArray {
686: db.DebugStack setstack $In function : IsArray of class PrimitiveObject$ stdstack
687: /Arglist set /Argthis set /FunctionValue [ ] def
688: [/this /p ] /ArgNames set ArgNames pushVariables [ %%function body
689: [Argthis] Arglist join ArgNames mapset
690: p isArray /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
691: db.DebugStack setstack pop stdstack
692: FunctionValue } def
693: %%end of function
694:
695: /Denominator {
696: db.DebugStack setstack $In function : Denominator of class PrimitiveObject$ stdstack
697: /Arglist set /Argthis set /FunctionValue [ ] def
698: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
699: [Argthis] Arglist join ArgNames mapset
700: f (denominator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
701: db.DebugStack setstack pop stdstack
702: FunctionValue } def
703: %%end of function
704:
705: /Numerator {
706: db.DebugStack setstack $In function : Numerator of class PrimitiveObject$ stdstack
707: /Arglist set /Argthis set /FunctionValue [ ] def
708: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
709: [Argthis] Arglist join ArgNames mapset
710: f (numerator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
711: db.DebugStack setstack pop stdstack
712: FunctionValue } def
713: %%end of function
714:
715: /Replace {
716: db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack
717: /Arglist set /Argthis set /FunctionValue [ ] def
718: [/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
719: [Argthis] Arglist join ArgNames mapset
720: [ %%start of local variables
721: /ans /n /tmp /i /num /den ] pushVariables [ %%local variables
722: this [ %% function args
723: f ] {IsArray} sendmsg2
724: %% if-condition
725: { %%ifbody
726: this [ %% function args
727: f ] {Length} sendmsg2
728: /n set
729: [ ] /ans set
730: (0).. /i set
731: %%for init.
732: %%for
733: { i n lt
734: { } {exit} ifelse
735: [ {%%increment
736: /i i (1).. {add} sendmsg2 def
737: } %%end of increment{A}
738: {%%start of B part{B}
739: this [ %% function args
740: ans this [ %% function args
741: f [i ] Get
742: rule ] {Replace} sendmsg2
743: ] {Append} sendmsg2
744: /ans set
745: } %% end of B part. {B}
746: 2 1 roll] {exec} map pop
747: } loop %%end of for
748: ans /FunctionValue set {/ExitPoint goto} exec %%return
749: }%%end if if body
750: { %%if- else part
751: } ifelse
752: f tag RationalFunctionP eq %% if-condition
753: { %%ifbody
754: this [ %% function args
755: f ] {Numerator} sendmsg2
756: /num set
757: this [ %% function args
758: f ] {Denominator} sendmsg2
759: /den set
760: num rule replace /num set
761: den rule replace /den set
762: num den {div} sendmsg2
763: /FunctionValue set {/ExitPoint goto} exec %%return
764: }%%end if if body
765: { %%if- else part
766: } ifelse
767: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables
768: /ExitPoint ]pop popVariables %%pop argValues
769: db.DebugStack setstack pop stdstack
770: FunctionValue } def
771: %%end of function
772:
773: /Map {
774: db.DebugStack setstack $In function : Map of class PrimitiveObject$ stdstack
775: /Arglist set /Argthis set /FunctionValue [ ] def
776: [/this /karg /func ] /ArgNames set ArgNames pushVariables [ %%function body
777: [Argthis] Arglist join ArgNames mapset
778: karg { [ 2 -1 roll ] this 2 -1 roll [(parse) func ] extension pop } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
779: db.DebugStack setstack pop stdstack
780: FunctionValue } def
781: %%end of function
782:
783: this [ %% function args
784: [ (Map) [ (Map(karg,func) applies the function <<func>> to the <<karg>>(string func).) ( Ex. Map([82,83,85],"AsciiToString"):) ] ] ] {HelpAdd} sendmsg2
785: /Position {
786: db.DebugStack setstack $In function : Position of class PrimitiveObject$ stdstack
787: /Arglist set /Argthis set /FunctionValue [ ] def
788: [/this /list /elem ] /ArgNames set ArgNames pushVariables [ %%function body
789: [Argthis] Arglist join ArgNames mapset
790: [ %%start of local variables
791: /n /pos /i ] pushVariables [ %%local variables
792: this [ %% function args
793: list ] {Length} sendmsg2
794: /n set
795: (1).. (0).. 2 1 roll {sub} sendmsg
796: /pos set
797: (0).. /i set
798: %%for init.
799: %%for
800: { i n lt
801: { } {exit} ifelse
802: [ {%%increment
803: /i i (1).. {add} sendmsg2 def
804: } %%end of increment{A}
805: {%%start of B part{B}
806: elem list [i ] Get
807: eq
808: %% if-condition
809: { %%ifbody
810: i /pos set
811: /k00.label0 goto }%%end if if body
812: { %%if- else part
813: } ifelse
814: } %% end of B part. {B}
815: 2 1 roll] {exec} map pop
816: } loop %%end of for
817: /k00.label0 pos /FunctionValue set {/ExitPoint goto} exec %%return
818: /ExitPoint ]pop popVariables %%pop the local variables
819: /ExitPoint ]pop popVariables %%pop argValues
820: db.DebugStack setstack pop stdstack
821: FunctionValue } def
822: %%end of function
823:
824: this [ %% function args
825: [ (Position) [ (Position(list,elem) returns the position p of the element <<elem>> in) ( the array <<list>>. If <<elem>> is not in <<list>>, it return -1) ( (array list).) (Ex. Position([1,34,2],34): ) ] ] ] {HelpAdd} sendmsg2
826: /StringToIntegerArray {
827: db.DebugStack setstack $In function : StringToIntegerArray of class PrimitiveObject$ stdstack
828: /Arglist set /Argthis set /FunctionValue [ ] def
829: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
830: [Argthis] Arglist join ArgNames mapset
831: s (array) dc { (universalNumber) dc } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
832: db.DebugStack setstack pop stdstack
833: FunctionValue } def
834: %%end of function
835:
836: this [ %% function args
837: [ (StringToIntegerArray) [ (StringToIntegerArray(s) decomposes the string <<s>> into an array of) (ascii codes of <<s>> (string s).) (cf. AsciiToString.) ] ] ] {HelpAdd} sendmsg2
838: /StringToAsciiArray {
839: db.DebugStack setstack $In function : StringToAsciiArray of class PrimitiveObject$ stdstack
840: /Arglist set /Argthis set /FunctionValue [ ] def
841: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
842: [Argthis] Arglist join ArgNames mapset
843: this [ %% function args
844: s ] {StringToIntegerArray} sendmsg2
845: /FunctionValue set {/ExitPoint goto} exec %%return
846: /ExitPoint ]pop popVariables %%pop argValues
847: db.DebugStack setstack pop stdstack
848: FunctionValue } def
849: %%end of function
850:
851: this [ %% function args
852: [ (StringToAsciiArray) [ (StringToAsciiArray(s) is StringToIntegerArray(s).) ] ] ] {HelpAdd} sendmsg2
853: /NewArray {
854: db.DebugStack setstack $In function : NewArray of class PrimitiveObject$ stdstack
855: /Arglist set /Argthis set /FunctionValue [ ] def
856: [/this /n ] /ArgNames set ArgNames pushVariables [ %%function body
857: [Argthis] Arglist join ArgNames mapset
858: this [ %% function args
859: n ] {NewVector} sendmsg2
860: /FunctionValue set {/ExitPoint goto} exec %%return
861: /ExitPoint ]pop popVariables %%pop argValues
862: db.DebugStack setstack pop stdstack
863: FunctionValue } def
864: %%end of function
865:
866: this [ %% function args
867: [ (NewArray) [ (NewArray(n) returns an array of size n (integer n).) ] ] ] {HelpAdd} sendmsg2
1.2 takayama 868: /GetEnv {
869: db.DebugStack setstack $In function : GetEnv of class PrimitiveObject$ stdstack
870: /Arglist set /Argthis set /FunctionValue [ ] def
871: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
872: [Argthis] Arglist join ArgNames mapset
873: [(getenv) s] extension /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
874: db.DebugStack setstack pop stdstack
875: FunctionValue } def
876: %%end of function
877:
878: this [ %% function args
879: [ (GetEnv) [ (GetEnv(s) returns the value of the environmental variable s (string s).) ] ] ] {HelpAdd} sendmsg2
1.3 takayama 880: /Boundp {
881: db.DebugStack setstack $In function : Boundp of class PrimitiveObject$ stdstack
882: /Arglist set /Argthis set /FunctionValue [ ] def
883: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
884: [Argthis] Arglist join ArgNames mapset
885: [ %%start of local variables
886: /b ] pushVariables [ %%local variables
887: [(parse) [(/) a ( load tag 0 eq
888: { /FunctionValue 0 def }
889: { /FunctionValue 1 def } ifelse )] cat ] extension /ExitPoint ]pop popVariables %%pop the local variables
890: /ExitPoint ]pop popVariables %%pop argValues
891: db.DebugStack setstack pop stdstack
892: FunctionValue } def
893: %%end of function
894:
895: this [ %% function args
896: [ (Boundp) [ (Boundp(s) checks if the symbol s is bounded to a value or not (string s).) ] ] ] {HelpAdd} sendmsg2
897: /Rest {
898: db.DebugStack setstack $In function : Rest of class PrimitiveObject$ stdstack
899: /Arglist set /Argthis set /FunctionValue [ ] def
900: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
901: [Argthis] Arglist join ArgNames mapset
902: a rest /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
903: db.DebugStack setstack pop stdstack
904: FunctionValue } def
905: %%end of function
906:
907: this [ %% function args
908: [ (Rest) [ (Rest(a) returns the rest (cdr) of a (list a).) ] ] ] {HelpAdd} sendmsg2
909: /GetPathName {
910: db.DebugStack setstack $In function : GetPathName of class PrimitiveObject$ stdstack
911: /Arglist set /Argthis set /FunctionValue [ ] def
912: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
913: [Argthis] Arglist join ArgNames mapset
914: [ %%start of local variables
915: /t /sss ] pushVariables [ %%local variables
916: s /sss set
917: [(stat) s] extension 0 get /t set this [ %% function args
918: t ] {Tag} sendmsg2
919: (0).. eq
920: %% if-condition
921: { %%ifbody
922: this [ %% function args
923: [ this [ %% function args
924: (LOAD_K_PATH) ] {GetEnv} sendmsg2
925: (/) s ] ] {AddString} sendmsg2
926: /s set
927: [(stat) s] extension 0 get /t set this [ %% function args
928: t ] {Tag} sendmsg2
929: (0).. eq
930: %% if-condition
931: { %%ifbody
932: null /FunctionValue set {/ExitPoint goto} exec %%return
933: }%%end if if body
934: { %%if- else part
935: s /FunctionValue set {/ExitPoint goto} exec %%return
936: } ifelse
937: }%%end if if body
938: { %%if- else part
939: s /FunctionValue set {/ExitPoint goto} exec %%return
940: } ifelse
941: /ExitPoint ]pop popVariables %%pop the local variables
942: /ExitPoint ]pop popVariables %%pop argValues
943: db.DebugStack setstack pop stdstack
944: FunctionValue } def
945: %%end of function
946:
947: this [ %% function args
948: [ (GetPathName) [ (GetPathName(s) checks if the file s exists in the current directory or) (in LOAD_K_PATH. If there exists, it returns the path name (string s).) ] ] ] {HelpAdd} sendmsg2
1.4 takayama 949: /Load_sm1 {
950: db.DebugStack setstack $In function : Load_sm1 of class PrimitiveObject$ stdstack
951: /Arglist set /Argthis set /FunctionValue [ ] def
952: [/this /fnames /flag ] /ArgNames set ArgNames pushVariables [ %%function body
953: [Argthis] Arglist join ArgNames mapset
954: [ %%start of local variables
955: /ppp /n /i /cmd ] pushVariables [ %%local variables
956: this [ %% function args
957: flag ] {Boundp} sendmsg2
958: %% if-condition
959: { %%ifbody
960: }%%end if if body
961: { %%if- else part
962: this [ %% function args
963: fnames ] {Length} sendmsg2
964: /n set
965: (0).. /i set
966: %%for init.
967: %%for
968: { i n lt
969: { } {exit} ifelse
970: [ {%%increment
971: /i i (1).. {add} sendmsg2 def
972: } %%end of increment{A}
973: {%%start of B part{B}
974: this [ %% function args
975: fnames [i ] Get
976: ] {GetPathName} sendmsg2
977: /ppp set
978: this [ %% function args
979: ppp ] {Tag} sendmsg2
980: (0).. eq not
981: %% if-condition
982: { %%ifbody
983: [(parse) ppp pushfile ] extension this [ %% function args
984: [ (/) flag ( 1 def ) ] ] {AddString} sendmsg2
985: /cmd set
986: [(parse) cmd ] extension n /i set
987: }%%end if if body
988: { %%if- else part
989: } ifelse
990: } %% end of B part. {B}
991: 2 1 roll] {exec} map pop
992: } loop %%end of for
993: } ifelse
994: /ExitPoint ]pop popVariables %%pop the local variables
995: /ExitPoint ]pop popVariables %%pop argValues
996: db.DebugStack setstack pop stdstack
997: FunctionValue } def
998: %%end of function
999:
1000: this [ %% function args
1001: [ (Load_sm1) [ (Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....) (If loading is succeeded, the already-loaded flag is set to true.) ((list s, string flag).) ] ] ] {HelpAdd} sendmsg2
1.5 takayama 1002: /GetRing {
1003: db.DebugStack setstack $In function : GetRing of class PrimitiveObject$ stdstack
1004: /Arglist set /Argthis set /FunctionValue [ ] def
1005: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
1006: [Argthis] Arglist join ArgNames mapset
1007: f getRing /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
1008: db.DebugStack setstack pop stdstack
1009: FunctionValue } def
1010: %%end of function
1011:
1012: /SetRing {
1013: db.DebugStack setstack $In function : SetRing of class PrimitiveObject$ stdstack
1014: /Arglist set /Argthis set /FunctionValue [ ] def
1015: [/this /r ] /ArgNames set ArgNames pushVariables [ %%function body
1016: [Argthis] Arglist join ArgNames mapset
1017: r ring_def /ExitPoint ]pop popVariables %%pop argValues
1018: db.DebugStack setstack pop stdstack
1019: FunctionValue } def
1020: %%end of function
1021:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to slib.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097