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