Annotation of OpenXM/src/k097/lib/tostr.sm1, Revision 1.1.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