Annotation of OpenXM/src/k097/lib/setvariables.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: 2/25, 1997 ) messagen
7: %% Note that you cannot use incmac.k as an argument of the local function.
8: %% BUG: [/incmac.k] pushvarable was [/k] pushVariables, but it caused
9: %% error when you try to run a program foo(k) { for (i=0; i<k; i++) ... }.
10: /mapset {
11: /arg2 set /arg1 set
12: [/incmac.k ] pushVariables
13: 0 1 arg1 length 1 sub {
14: /incmac.k set
15: arg1 incmac.k get
16: arg2 incmac.k get
17: set
18: } for
19: popVariables
20: } def
21:
22: /a [[1 2] [3 4]] def
23: /@@@.indexMode {
24: 0 eq { %%% C-style
25: /@@@.indexMode.flag 0 def
26: /Get {
27: /arg1 set
28: [/incmac.k ] pushVariables
29: [
30: arg1 0 get load
31: 1 1 arg1 length 1 sub {
32: /incmac.k set
33: arg1 incmac.k get ..int get
34: } for
35: /arg1 set
36: ] pop
37: popVariables
38: arg1
39: } def
40:
41: /Put {
42: /arg2 set
43: /arg1 set
44: [/incmac.k ] pushVariables
45: arg1 0 get load
46: [ 1 1 arg1 length 1 sub {
47: /incmac.k set
48: arg1 incmac.k get ..int
49: } for
50: ] arg2 put
51: popVariables
52: } def
53: } { %% else
54: /@@@.indexMode.flag 1 def
55: /Get {
56: /arg1 set
57: [/incmac.k ] pushVariables
58: [
59: arg1 0 get load
60: 1 1 arg1 length 1 sub {
61: /incmac.k set
62: arg1 incmac.k get ..int 1 sub get
63: } for
64: /arg1 set
65: ] pop
66: popVariables
67: arg1
68: } def
69:
70: /Put {
71: /arg2 set
72: /arg1 set
73: [/incmac.k ] pushVariables
74: arg1 0 get load
75: [ 1 1 arg1 length 1 sub {
76: /incmac.k set
77: arg1 incmac.k get ..int 1 sub
78: } for
79: ] arg2 put
80: popVariables
81: } def
82: } ifelse
83: } def
84:
85: 0 @@@.indexMode %% Default index mode is C-style
86:
87:
88:
89:
90: %%%%%%%%%%%% 1996, 4/28
91: %% (2).. NewVector
92: /NewVector {
93: 0 get /arg1 set
94: arg1 (integer) dc /arg1 set
95: [ 1 1 arg1 { pop (0).. } for ]
96: } def
97:
98: %% (2).. (3).. NewMatrix
99: /NewMatrix {
100: dup 0 get /arg1 set
101: 1 get /arg2 set
102: arg1 (integer) dc /arg1 set
103: arg2 (integer) dc /arg2 set
104: [1 1 arg1 { pop [arg2] NewVector } for ]
105: } def
106:
107: /Join {
108: aload pop join
109: } def
110:
111:
112: /greaterThanOrEqual {
113: /arg2 set /arg1 set
114: arg1 arg2 gt { 1 }
115: { arg1 arg2 eq {1} {0} ifelse} ifelse
116: } def
117:
118: /lessThanOrEqual {
119: /arg2 set /arg1 set
120: arg1 arg2 lt { 1 }
121: { arg1 arg2 eq {1} {0} ifelse} ifelse
122: } def
123:
124: /k.mapReplace { {[[(h). (1).]] replace} map } def
125: /Dehomogenize {
126: 0 get /arg1 set
127: [
128: arg1 isArray not { arg1 [[(h). (1).]] replace }
129: { arg1 0 get isArray not { arg1 k.mapReplace }
130: { arg1 {k.mapReplace} map } ifelse
131: } ifelse
132: /arg1 set
133: ] pop
134: arg1
135: } def
136:
137:
138:
139:
140: ( slib.ccc: 8/17,1996 ) message /Print {
141: /Arglist set /FunctionValue [ ] def
142: [/a ] /ArgNames set ArgNames pushVariables [ %%function body
143: Arglist ArgNames mapset
144: a messagen /ExitPoint ]pop popVariables %%pop argValues
145: FunctionValue } def
146: %%end of function
147:
148: /Println {
149: /Arglist set /FunctionValue [ ] def
150: [/a ] /ArgNames set ArgNames pushVariables [ %%function body
151: Arglist ArgNames mapset
152: a message /ExitPoint ]pop popVariables %%pop argValues
153: FunctionValue } def
154: %%end of function
155:
156: /Ln {
157: /Arglist set /FunctionValue [ ] def
158: [ ] /ArgNames set ArgNames pushVariables [ %%function body
159: ( ) message /ExitPoint ]pop popVariables %%pop argValues
160: FunctionValue } def
161: %%end of function
162:
163: /Poly {
164: /Arglist set /FunctionValue [ ] def
165: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
166: Arglist ArgNames mapset
167: f expand /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
168: FunctionValue } def
169: %%end of function
170:
171: /PolyR {
172: /Arglist set /FunctionValue [ ] def
173: [/f /r ] /ArgNames set ArgNames pushVariables [ %%function body
174: Arglist ArgNames mapset
175: f r ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
176: FunctionValue } def
177: %%end of function
178:
179: /Degree {
180: /Arglist set /FunctionValue [ ] def
181: [/f /v ] /ArgNames set ArgNames pushVariables [ %%function body
182: Arglist ArgNames mapset
183: f v degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
184: FunctionValue } def
185: %%end of function
186:
187: /Append {
188: /Arglist set /FunctionValue [ ] def
189: [/f /g ] /ArgNames set ArgNames pushVariables [ %%function body
190: Arglist ArgNames mapset
191: [ %% function args
192: f [ g ] ] Join
193: /FunctionValue set {/ExitPoint goto} exec %%return
194: /ExitPoint ]pop popVariables %%pop argValues
195: FunctionValue } def
196: %%end of function
197:
198: /Length {
199: /Arglist set /FunctionValue [ ] def
200: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
201: Arglist ArgNames mapset
202: f length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
203: FunctionValue } def
204: %%end of function
205:
206: /Indexed {
207: /Arglist set /FunctionValue [ ] def
208: [/name /i ] /ArgNames set ArgNames pushVariables [ %%function body
209: Arglist ArgNames mapset
210: name i s.Indexed /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
211: FunctionValue } def
212: %%end of function
213:
214: /Indexed2 {
215: /Arglist set /FunctionValue [ ] def
216: [/name /i /j ] /ArgNames set ArgNames pushVariables [ %%function body
217: Arglist ArgNames mapset
218: name i j s.Indexed2 /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
219: FunctionValue } def
220: %%end of function
221:
222: /Transpose {
223: /Arglist set /FunctionValue [ ] def
224: [/mat ] /ArgNames set ArgNames pushVariables [ %%function body
225: Arglist ArgNames mapset
226: mat transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
227: FunctionValue } def
228: %%end of function
229:
230:
231: /s.Indexed {
232: (integer) dc /arg2 set
233: /arg1 set
234: arg1 ([) arg2 (dollar) dc (]) 4 cat_n
235: } def
236:
237: /s.Indexed2 {
238: (integer) dc /arg3 set
239: (integer) dc /arg2 set
240: /arg1 set
241: arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
242: } def
243: /Groebner {
244: /Arglist set /FunctionValue [ ] def
245: [/F ] /ArgNames set ArgNames pushVariables [ %%function body
246: Arglist ArgNames mapset
247: F {[[(h). (1).]] replace homogenize} map /arg1 set
248: [arg1] groebner 0 get
249: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
250: FunctionValue } def
251: %%end of function
252:
253: /GroebnerTime {
254: /Arglist set /FunctionValue [ ] def
255: [/F ] /ArgNames set ArgNames pushVariables [ %%function body
256: Arglist ArgNames mapset
257: F {[[(h). (1).]] replace homogenize} map /arg1 set
258: { [arg1] groebner 0 get } timer
259: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
260: FunctionValue } def
261: %%end of function
262:
263: /LiftStd {
264: /Arglist set /FunctionValue [ ] def
265: [/F ] /ArgNames set ArgNames pushVariables [ %%function body
266: Arglist ArgNames mapset
267: F {[[(h). (1).]] replace homogenize} map /arg1 set
268: [arg1 [(needBack)]] groebner
269: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
270: FunctionValue } def
271: %%end of function
272:
273: /Reduction {
274: /Arglist set /FunctionValue [ ] def
275: [/f /G ] /ArgNames set ArgNames pushVariables [ %%function body
276: Arglist ArgNames mapset
277: f G reduction /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
278: FunctionValue } def
279: %%end of function
280:
281: /IntegerToMachineInteger {
282: /Arglist set /FunctionValue [ ] def
283: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
284: Arglist ArgNames mapset
285: f (integer) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
286: FunctionValue } def
287: %%end of function
288:
289: /RingD {
290: /Arglist set /FunctionValue [ ] def
291: [/vList /weightMatrix ] /ArgNames set ArgNames pushVariables [ %%function body
292: Arglist ArgNames mapset
293: [ %%start of local variables
294: /new /tmp /size /n /i /j /newtmp /ringpp ] pushVariables [ %%local variables
295: [ %% function args
296: Arglist ] Length
297: (2).. lt
298: %% if-condition
299: { %%ifbody
300: [ vList ring_of_differential_operators ( ) elimination_order 0 ] define_ring
301: /tmp set tmp /FunctionValue set {/ExitPoint goto} exec %%return
302: }%%end if if body
303: { %%if- else part
304: } ifelse
305: /size [ %% function args
306: weightMatrix ] Length
307: def
308: /new [ %% function args
309: size ] NewVector
310: def
311: /@@@.indexMode.flag.save @@@.indexMode.flag def 0 @@@.indexMode /i (0).. def
312: %%for init.
313: %%for
314: { i size lt
315: { } {exit} ifelse
316: [ {%%increment
317: /i i (1).. add def
318: } %%end of increment{A}
319: {%%start of B part{B}
320: /tmp [/weightMatrix i ] Get
321: def
322: /n [ %% function args
323: tmp ] Length
324: def
325: /newtmp [ %% function args
326: n ] NewVector
327: def
328: /j (1).. def
329: %%for init.
330: %%for
331: { j n lt
332: { } {exit} ifelse
333: [ {%%increment
334: /j j (2).. add
335: def
336: } %%end of increment{A}
337: {%%start of B part{B}
338: [/newtmp j (1).. sub
339: ] [/tmp j (1).. sub
340: ] Get
341: Put
342: [/newtmp j ] [ %% function args
343: [/tmp j ] Get
344: ] IntegerToMachineInteger
345: Put
346: } %% end of B part. {B}
347: 2 1 roll] {exec} map
348: } loop %%end of for
349: [/new i ] newtmp Put
350: } %% end of B part. {B}
351: 2 1 roll] {exec} map
352: } loop %%end of for
353: /ringpp [ vList ring_of_differential_operators new weight_vector 0 ] define_ring def
354: @@@.indexMode.flag.save @@@.indexMode ringpp /FunctionValue set {/ExitPoint goto} exec %%return
355: /ExitPoint ]pop popVariables %%pop the local variables
356: /ExitPoint ]pop popVariables %%pop argValues
357: FunctionValue } def
358: %%end of function
359:
360: /getxvar {
361: /Arglist set /FunctionValue [ ] def
362: [/i ] /ArgNames set ArgNames pushVariables [ %%function body
363: Arglist ArgNames mapset
364: [(x) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
365: FunctionValue } def
366: %%end of function
367:
368: /getdvar {
369: /Arglist set /FunctionValue [ ] def
370: [/i ] /ArgNames set ArgNames pushVariables [ %%function body
371: Arglist ArgNames mapset
372: [(D) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
373: FunctionValue } def
374: %%end of function
375:
376: /getvarn {
377: /Arglist set /FunctionValue [ ] def
378: [ ] /ArgNames set ArgNames pushVariables [ %%function body
379: [(N)] system_variable (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
380: FunctionValue } def
381: %%end of function
382:
383: /setRingVariables {
384: /Arglist set /FunctionValue [ ] def
385: [ ] /ArgNames set ArgNames pushVariables [ %%function body
386: [ %%start of local variables
387: /n /i /v /f ] pushVariables [ %%local variables
388: /n [ %% function args
389: ] getvarn
390: def
391: /i (0).. def
392: %%for init.
393: %%for
394: { i n lt
395: { } {exit} ifelse
396: [ {%%increment
397: /i i (1).. add def
398: } %%end of increment{A}
399: {%%start of B part{B}
400: /v [ %% function args
401: i ] getxvar
402: def
403: /f [ %% function args
404: v ] Poly
405: def
406: v (literal) dc f def /v [ %% function args
407: i ] getdvar
408: def
409: /f [ %% function args
410: v ] Poly
411: def
412: v (literal) dc f def } %% end of B part. {B}
413: 2 1 roll] {exec} map
414: } loop %%end of for
415: /ExitPoint ]pop popVariables %%pop the local variables
416: /ExitPoint ]pop popVariables %%pop argValues
417: FunctionValue } def
418: %%end of function
419:
420: /AddString {
421: /Arglist set /FunctionValue [ ] def
422: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
423: Arglist ArgNames mapset
424: f aload length cat_n /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
425: FunctionValue } def
426: %%end of function
427:
428: /IntegerToString {
429: /Arglist set /FunctionValue [ ] def
430: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
431: Arglist ArgNames mapset
432: f (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
433: FunctionValue } def
434: %%end of function
435:
436: /Replace {
437: /Arglist set /FunctionValue [ ] def
438: [/f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
439: Arglist ArgNames mapset
440: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
441: FunctionValue } def
442: %%end of function
443:
444: /AsciiToString {
445: /Arglist set /FunctionValue [ ] def
446: [/c ] /ArgNames set ArgNames pushVariables [ %%function body
447: Arglist ArgNames mapset
448: c (integer) dc (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
449: FunctionValue } def
450: %%end of function
451:
452: /ToString {
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: ] ToString
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:
520: /Denominator {
521: /Arglist set /FunctionValue [ ] def
522: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
523: Arglist ArgNames mapset
524: f (denominator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
525: FunctionValue } def
526: %%end of function
527:
528: /Numerator {
529: /Arglist set /FunctionValue [ ] def
530: [/f ] /ArgNames set ArgNames pushVariables [ %%function body
531: Arglist ArgNames mapset
532: f (numerator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
533: FunctionValue } def
534: %%end of function
535:
536: /Replace {
537: /Arglist set /FunctionValue [ ] def
538: [/f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
539: Arglist ArgNames mapset
540: [ %%start of local variables
541: /ans /n /tmp /i /num /den ] pushVariables [ %%local variables
542: [ %% function args
543: f ] IsArray
544: %% if-condition
545: { %%ifbody
546: /n [ %% function args
547: f ] Length
548: def
549: /ans [ ] def
550: /i (0).. def
551: %%for init.
552: %%for
553: { i n lt
554: { } {exit} ifelse
555: [ {%%increment
556: /i i (1).. add def
557: } %%end of increment{A}
558: {%%start of B part{B}
559: /ans [ %% function args
560: ans [ %% function args
561: [/f i ] Get
562: rule ] Replace
563: ] Append
564: def
565: } %% end of B part. {B}
566: 2 1 roll] {exec} map
567: } loop %%end of for
568: ans /FunctionValue set {/ExitPoint goto} exec %%return
569: }%%end if if body
570: { %%if- else part
571: } ifelse
572: f tag RationalFunctionP eq %% if-condition
573: { %%ifbody
574: /num [ %% function args
575: f ] Numerator
576: def
577: /den [ %% function args
578: f ] Denominator
579: def
580: /num num rule replace def
581: /den den rule replace def
582: num den div
583: /FunctionValue set {/ExitPoint goto} exec %%return
584: }%%end if if body
585: { %%if- else part
586: } ifelse
587: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables
588: /ExitPoint ]pop popVariables %%pop argValues
589: FunctionValue } def
590: %%end of function
591:
592: 0 @@@.indexMode /getxvar {
593: /Arglist set /FunctionValue [ ] def
594: [/i ] /ArgNames set ArgNames pushVariables [ %%function body
595: Arglist ArgNames mapset
596: [(x) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
597: FunctionValue } def
598: %%end of function
599:
600: /getdvar {
601: /Arglist set /FunctionValue [ ] def
602: [/i ] /ArgNames set ArgNames pushVariables [ %%function body
603: Arglist ArgNames mapset
604: [(D) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
605: FunctionValue } def
606: %%end of function
607:
608: /getvarn {
609: /Arglist set /FunctionValue [ ] def
610: [ ] /ArgNames set ArgNames pushVariables [ %%function body
611: [(N)] system_variable (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
612: FunctionValue } def
613: %%end of function
614:
615: /SetRingVariables {
616: /Arglist set /FunctionValue [ ] def
617: [ ] /ArgNames set ArgNames pushVariables [ %%function body
618: [ %% function args
619: (SetRingVariables() Setting the global variables : ) ] Print
620: [ %% function args
621: (0).. [(CC)] system_variable (universalNumber) dc ] setRingVariables002
622: [ %% function args
623: [(C)] system_variable (universalNumber) dc [(LL)] system_variable (universalNumber) dc ] setRingVariables002
624: [ %% function args
625: [(L)] system_variable (universalNumber) dc [(MM)] system_variable (universalNumber) dc ] setRingVariables002
626: [ %% function args
627: [(M)] system_variable (universalNumber) dc [(NN)] system_variable (universalNumber) dc ] setRingVariables002
628: [ %% function args
629: ] Ln
630: /ExitPoint ]pop popVariables %%pop argValues
631: FunctionValue } def
632: %%end of function
633:
634: /setRingVariables002 {
635: /Arglist set /FunctionValue [ ] def
636: [/tmp002_p /tmp002_q ] /ArgNames set ArgNames pushVariables [ %%function body
637: Arglist ArgNames mapset
638: [ %%start of local variables
639: /tmp002_i /tmp002_v /tmp002_str ] pushVariables [ %%local variables
640: /tmp002_i tmp002_p def
641: %%for init.
642: %%for
643: { tmp002_i tmp002_q lt
644: { } {exit} ifelse
645: [ {%%increment
646: /tmp002_i tmp002_i (1).. add def
647: } %%end of increment{A}
648: {%%start of B part{B}
649: /tmp002_v [ %% function args
650: tmp002_i ] getxvar
651: def
652: [ %% function args
653: tmp002_v ] Print
654: [ %% function args
655: ( ) ] Print
656: /str [ %% function args
657: [ (/) tmp002_v ( $) tmp002_v ($ expand def ) ] ] AddString
658: def
659: [(parse) str ] extension /tmp002_v [ %% function args
660: tmp002_i ] getdvar
661: def
662: [ %% function args
663: tmp002_v ] Print
664: [ %% function args
665: ( ) ] Print
666: /str [ %% function args
667: [ (/) tmp002_v ( $) tmp002_v ($ expand def ) ] ] AddString
668: def
669: [(parse) str ] extension } %% end of B part. {B}
670: 2 1 roll] {exec} map
671: } loop %%end of for
672: /ExitPoint ]pop popVariables %%pop the local variables
673: /ExitPoint ]pop popVariables %%pop argValues
674: } def
675: %%end of function
676:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to setvariables.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / lib