Annotation of OpenXM/src/k097/debug/ahg2.k.sm1, Revision 1.1.1.1
1.1 maekawa 1: /K00_verbose 0 def
2:
3:
4: %% start of var.sm1. 1997, 2/27
5: %%(type in initv to initialize the variable stack and type in test.var to start a test) message
6:
7: /sm1.var.Verbose 0 def
8: /@@@.quiet.var 1 def
9: @@@.quiet.var { }
10: { (var.sm1 (module for debugging): Version 3/7, 1997. cf. strictMode, debugMode) message } ifelse
11:
12: /db.initVariableStack {
13: 1000 newstack /db.VariableStack set
14: } def
15:
16:
17: /localVariables {
18: { dup [ 3 1 roll load ] } map /db.arg0 set
19: db.VariableStack setstack db.arg0 stdstack
20: } def
21:
22: /restoreVariables {
23: db.VariableStack setstack
24: % dup print
25: { aload pop def } map pop
26: stdstack
27: } def
28:
29:
30:
31: /db.where {
32: db.VariableStack setstack
33: pstack
34: stdstack
35: } def
36:
37: /db.clear {
38: db.VariableStack setstack
39: /db.arg1 [(StackPointer) ] system_variable 2 sub def
40: %% arg1 print
41: 0 1 db.arg1
42: {
43: pop pop
44: } for
45: stdstack
46: } def
47:
48: /db.restore { %% You cannot use local variable in this function.
49: db.VariableStack setstack
50: /db.arg1 [(StackPointer) ] system_variable 2 sub def
51: 0 1 db.arg1
52: {
53: pop /db.variableArray set
54: sm1.var.Verbose { db.variableArray print } { } ifelse
55: db.variableArray isArray
56: { db.variableArray length 0 gt
57: {
58: db.variableArray { aload pop def } map pop
59: }
60: { } ifelse
61: }
62: %%% Don't call restoreVariables. Otherwise, stack is set to stdstack.
63: { } ifelse
64: } for
65: stdstack
66: } def
67:
68:
69:
70: /db.initDebugStack { 1000 newstack /db.DebugStack set } def
71:
72:
73: /db.where.ds {
74: db.DebugStack setstack
75: pstack
76: stdstack
77: } def
78:
79: /db.clear.ds {
80: db.DebugStack setstack
81: /db.arg1 [(StackPointer) ] system_variable 2 sub def
82: %% arg1 print
83: 0 1 db.arg1
84: {
85: pop pop
86: } for
87: stdstack
88: } def
89:
90:
91: /db.initErrorStack {
92: [(ErrorStack)] system_variable /db.ErrorStack set
93: } def
94:
95: /db.where.es {
96: db.ErrorStack setstack
97: /db.arg1 [(StackPointer) ] system_variable 2 sub def
98: %% db.arg1 print
99: 0 1 db.arg1
100: {
101: pop rc message
102: %% pop rc message %% This caused coredump for %%Warning:The identifier...
103: %% This bug was a mistery. (1997, 3/1)
104: %% Perhaps you do not output dollar sign, you get the core.
105: %% I found the missing "%s" in the function printObject() and fixed the
106: %% bug.
107: } for
108: stdstack
109: } def
110:
111:
112: /db.clear.es {
113: db.ErrorStack setstack
114: /db.arg1 [(StackPointer) ] system_variable 2 sub def
115: %% arg1 print
116: 0 1 db.arg1
117: {
118: pop pop
119: } for
120: stdstack
121: } def
122:
123: %%% Usages.
124: [(resolution)
125: [(Only slow version of resolution is implemented in kan/sm1.)
126: (DMacaulay provides a function to compute resolution in the ring of)
127: (differential operators. See http://www.math.s.kobe-u.ac.jp/KAN)
128: ]
129: ] putUsages
130:
131: [(db.where)
132: [(db.where shows the db.VariableStack)
133: (cf. localVariables, restoreVariables,)
134: ( db.clear, db.restore, db.where.ds, db.where.es, debugMode)
135: ]
136: ] putUsages
137:
138: [(db.clear)
139: [(db.clear cleans db.VariableStack)
140: (cf. db.restore, db.where, db.clear.ds, db.clear.es, debugMode)
141: ]
142: ] putUsages
143:
144: [(db.restore)
145: [(db.restore recovers bindings of variables by reading db.VariableStack)
146: (cf. localVariables, restoreVariables,)
147: ( db.clear, db.where , debugMode)
148: ]
149: ] putUsages
150:
151: [(db.where.ds)
152: [(db.where.ds shows the db.DebugStack)
153: (db.DebugStack is used by kan/k? to get error lines.)
154: (cf. db.clear.ds, db.where, debugMode)
155: ]
156: ] putUsages
157:
158: [(db.clear.ds)
159: [(db.clear.ds cleans db.DebugStack)
160: (cf. db.where.ds, db.clear, debugMode)
161: ]
162: ] putUsages
163:
164: [(db.where.es)
165: [(db.where.es shows the db.ErrorStack)
166: (Error and warning messages are put in db.ErrorStack when the global)
167: (variables ErrorMessageMode or WarningMessageMode are set to 1 or 2.)
168: (cf. db.where, system_variable)
169: ]
170: ] putUsages
171:
172: [(db.clear.es)
173: [(db.clear.es cleans db.ErrorStack)
174: (cf. db.clear, db.where.es)
175: ]
176: ] putUsages
177:
178: [(localVariables)
179: [(This function is as same as pushVariables, but it pushes the variable to)
180: (db.VariableStack)
181: (cf. db.where, pushVariables, restoreVariables, debugMode)
182: ]
183: ] putUsages
184:
185: [(restoreVariables)
186: [(This function is as same as popVariables, but it pops the variable from)
187: (db.VariableStack)
188: (cf. db.where, popVariables, localVariables, debugMode)
189: ]
190: ] putUsages
191:
192: /initv { db.initVariableStack db.initDebugStack db.initErrorStack } def
193: initv
194: %% (initv is executed.) message
195:
196: /db.pop.es {
197: db.ErrorStack setstack
198: /db.arg1 set
199: stdstack
200: db.arg1
201: } def
202:
203: /db.pop.ds {
204: db.DebugStack setstack
205: /db.arg1 set
206: stdstack
207: db.arg1
208: } def
209:
210: /db.push.ds {
211: /db.arg1 set
212: db.DebugStack setstack
213: db.arg1
214: stdstack
215: } def
216:
217:
218: %%% if you like rigorous naming system execute the following command.
219: /strictMode {
220: [(Strict2) 1] system_variable
221: [(chattrs) 1] extension
222: [(chattr) 0 /arg1] extension
223: [(chattr) 0 /arg2] extension
224: [(chattr) 0 /arg3] extension
225: [(chattr) 0 /v1] extension %% used in join.
226: [(chattr) 0 /v2] extension
227: [(chattr) 0 /@.usages] extension
228: @@@.quiet.var { }
229: { (var.sm1 : Strict control of the name space is enabled. (cf. extension)) message }
230: ifelse
231: } def
232: [(strictMode)
233: [(StrictMode enables the protection for an unexpected redefinition)]
234: ] putUsages
235:
236: /debugMode {
237: /pushVariables { localVariables } def
238: /popVariables { restoreVariables } def
239: } def
240: [(debugMode)
241: [(debugMode overrides on the functions pushVariables and popVariables)
242: (and enables to use db.where)
243: ]
244: ] putUsages
245:
246: %%%% Test Codes.
247: /foo1 {
248: /arg1 set
249: [/n /val] localVariables
250: /n arg1 def
251: n 2 le
252: {
253: /val 1 def
254: }
255: {
256: /val n 1 sub foo1 n 2 sub foo1 add def
257: } ifelse
258: /arg1 val def
259: restoreVariables
260: arg1
261: } def
262:
263: /test.var.1 {
264: (Now, we are testing new features ErrorStack of sm1 (1997, 3/1 )...) message
265: (ErrorStack:) message
266: [(ErrorStack)] system_variable /db.ErrorStack set
267: db.ErrorStack message
268: db.ErrorStack lc message
269: db.ErrorStack rc message
270: (ErrorMessageMode:) message
271: [(ErrorMessageMode)] system_variable message
272: [(ErrorMessageMode) 2 ] system_variable
273: [(WarningMessageMode) 2 ] system_variable
274: [(ErrorMessageMode)] system_variable message
275:
276: (Cause an error with the mode 1) message
277: 0 1 get %% The macro breaks here.
278: 0 2 get
279: db.where.es
280: db.clear.es
281: db.where.es
282:
283: [(ErrorMessageMode) 0 ] system_variable
284: [(ErrorMessageMode)] system_variable message
285:
286: (Cause an error with the mode 0) message
287: 0 1 get
288: 0 2 get
289: db.where.es
290: } def
291:
292: /test.var {
293: (Now, we are testing new features <<gb>> of sm1 (1997, 3/1 )...) message
294: [(x,y) ring_of_polynomials ( ) elimination_order 0] define_ring
295: [(isReducible) (x^2 y). (x y).] gb message
296: [(lcm) (x y). (y^2).] gb message
297: [(grade) (x^2 y). ] gb message
298: ( --- 1 , xy^2, 3 OK? ----) message
299: (Computing isReducible for 1000 times.... ) messagen
300: { 1 1 1000 { pop [(isReducible) (x^2 y). (x y).] gb pop } for
301: ( ) message } timer
302: (Done) message
303: } def
304: %%% end of test codes.
305: %% end of var.sm1
306:
307:
308:
309:
310:
311:
312:
313: %% incmac.sm1 , 1996, 4/2.
314: %% macros for the translator.
315: %%% /goto { pop } def %% should be changed later.
316: %( incmac.sm1: 4/16, 1997 ) messagen
317: %% Note that you cannot use incmac.k as an argument of the local function.
318: %% BUG: [/incmac.k] pushvarable was [/k] pushVariables, but it caused
319: %% error when you try to run a program foo(k) { for (i=0; i<k; i++) ... }.
320: /mapset {
321: /arg2 set /arg1 set
322: [/incmac.k ] pushVariables
323: 0 1 arg1 length 1 {sub} primmsg {
324: /incmac.k set
325: arg1 incmac.k get
326: arg2 incmac.k get
327: set
328: } for
329: popVariables
330: } def
331:
332: %%% a [i] b Put <=== a[i] = b;
333: %%% a [i] Get <=== a[i]
334: /a [[1 2] [3 4]] def
335: /@@@.indexMode {
336: 0 eq { %%% C-style
337: /@@@.indexMode.flag 0 def
338: /Get {
339: /arg2 set
340: /arg1 set
341: [/incmac.k ] pushVariables
342: [
343: arg1
344: 0 1 arg2 length 1 {sub} primmsg {
345: /incmac.k set
346: arg2 incmac.k get ..int get
347: } for
348: /arg1 set
349: ] pop
350: popVariables
351: arg1
352: } def
353:
354: /Put {
355: /arg3 set
356: /arg2 set
357: /arg1 set
358: [/incmac.k ] pushVariables
359: arg1
360: [ 0 1 arg2 length 1 {sub} primmsg {
361: /incmac.k set
362: arg2 incmac.k get ..int
363: } for
364: ] arg3 put
365: popVariables
366: } def
367: } { %% else
368: (Warning: Do not use indexmode 1.) message
369: (Warning: Do not use indexmode 1.) message
370: /@@@.indexMode.flag 1 def
371: /Get {
372: /arg1 set
373: [/incmac.k ] pushVariables
374: [
375: arg1 0 get load
376: 1 1 arg1 length 1 {sub} primmsg {
377: /incmac.k set
378: arg1 incmac.k get ..int 1 {sub} primmsg get
379: } for
380: /arg1 set
381: ] pop
382: popVariables
383: arg1
384: } def
385:
386: /Put {
387: /arg2 set
388: /arg1 set
389: [/incmac.k ] pushVariables
390: arg1 0 get load
391: [ 1 1 arg1 length 1 {sub} primmsg {
392: /incmac.k set
393: arg1 incmac.k get ..int 1 {sub} primmsg
394: } for
395: ] arg2 put
396: popVariables
397: } def
398: } ifelse
399: } def
400:
401: 0 @@@.indexMode %% Default index mode is C-style
402:
403:
404:
405:
406: %%%%%%%%%%%% 1996, 4/28
407: %% (2).. NewVector
408: /NewVector {
409: 0 get /arg1 set
410: pop %% remove this
411: arg1 (integer) dc /arg1 set
412: [ 1 1 arg1 { pop (0).. } for ]
413: } def
414:
415: %% (2).. (3).. NewMatrix
416: /NewMatrix {
417: dup 0 get /arg1 set
418: 1 get /arg2 set
419: pop %% remove this
420: arg1 (integer) dc /arg1 set
421: arg2 (integer) dc /arg2 set
422: [1 1 arg1 { pop this [arg2] NewVector } for ]
423: } def
424:
425: /Join {
426: 2 -1 roll pop %% remove this.
427: aload pop join
428: } def
429:
430:
431:
432: /lessThanOrEqual {
433: /arg2 set /arg1 set
434: arg1 arg2 lt { 1 }
435: { arg1 arg2 eq {1} {0} ifelse} ifelse
436: } def
437:
438: %%% For objects
439: /this null def
440: /PrimitiveContextp StandardContextp def
441: /PrimitiveObject [PrimitiveContextp] def
442:
443: /showln { pop message } def
444:
445: /KxxTrash0 { % we do not need.
446: /k.mapReplace { {[[(h). (1).]] replace} map } def
447: /Dehomogenize {
448: 0 get /arg1 set
449: [
450: arg1 isArray not { arg1 [[(h). (1).]] replace }
451: { arg1 0 get isArray not { arg1 k.mapReplace }
452: { arg1 {k.mapReplace} map } ifelse
453: } ifelse
454: /arg1 set
455: ] pop
456: arg1
457: } def
458: } def
459:
460:
461:
462:
463:
464:
465: K00_verbose %% if-condition
466: { %%ifbody
467: ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message }%%end if if body
468: { %%if- else part
469: } ifelse
470: [ ] /Helplist set
471: /HelpAdd {
472: db.DebugStack setstack $In function : HelpAdd of class PrimitiveObject$ stdstack
473: /Arglist set /Argthis set /FunctionValue [ ] def
474: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
475: [Argthis] Arglist join ArgNames mapset
476: this [ %% function args
477: Helplist s ] {Append} sendmsg2
478: /Helplist set
479: /ExitPoint ]pop popVariables %%pop argValues
480: db.DebugStack setstack pop stdstack
481: } def
482: %%end of function
483:
484: /Print {
485: db.DebugStack setstack $In function : Print of class PrimitiveObject$ stdstack
486: /Arglist set /Argthis set /FunctionValue [ ] def
487: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
488: [Argthis] Arglist join ArgNames mapset
489: a messagen /ExitPoint ]pop popVariables %%pop argValues
490: db.DebugStack setstack pop stdstack
491: FunctionValue } def
492: %%end of function
493:
494: /Println {
495: db.DebugStack setstack $In function : Println of class PrimitiveObject$ stdstack
496: /Arglist set /Argthis set /FunctionValue [ ] def
497: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
498: [Argthis] Arglist join ArgNames mapset
499: a message /ExitPoint ]pop popVariables %%pop argValues
500: db.DebugStack setstack pop stdstack
501: FunctionValue } def
502: %%end of function
503:
504: /Ln {
505: db.DebugStack setstack $In function : Ln of class PrimitiveObject$ stdstack
506: /Arglist set /Argthis set /FunctionValue [ ] def
507: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
508: [Argthis] ArgNames mapset
509: ( ) message /ExitPoint ]pop popVariables %%pop argValues
510: db.DebugStack setstack pop stdstack
511: FunctionValue } def
512: %%end of function
513:
514: /Poly {
515: db.DebugStack setstack $In function : Poly of class PrimitiveObject$ stdstack
516: /Arglist set /Argthis set /FunctionValue [ ] def
517: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
518: [Argthis] Arglist join ArgNames mapset
519: f expand /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
520: db.DebugStack setstack pop stdstack
521: FunctionValue } def
522: %%end of function
523:
524: /PolyR {
525: db.DebugStack setstack $In function : PolyR of class PrimitiveObject$ stdstack
526: /Arglist set /Argthis set /FunctionValue [ ] def
527: [/this /f /r ] /ArgNames set ArgNames pushVariables [ %%function body
528: [Argthis] Arglist join ArgNames mapset
529: f r ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
530: db.DebugStack setstack pop stdstack
531: FunctionValue } def
532: %%end of function
533:
534: /Degree {
535: db.DebugStack setstack $In function : Degree of class PrimitiveObject$ stdstack
536: /Arglist set /Argthis set /FunctionValue [ ] def
537: [/this /f /v ] /ArgNames set ArgNames pushVariables [ %%function body
538: [Argthis] Arglist join ArgNames mapset
539: f v degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
540: db.DebugStack setstack pop stdstack
541: FunctionValue } def
542: %%end of function
543:
544: /Append {
545: db.DebugStack setstack $In function : Append of class PrimitiveObject$ stdstack
546: /Arglist set /Argthis set /FunctionValue [ ] def
547: [/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body
548: [Argthis] Arglist join ArgNames mapset
549: this [ %% function args
550: f [ g ] ] {Join} sendmsg2
551: /FunctionValue set {/ExitPoint goto} exec %%return
552: /ExitPoint ]pop popVariables %%pop argValues
553: db.DebugStack setstack pop stdstack
554: FunctionValue } def
555: %%end of function
556:
557: /Length {
558: db.DebugStack setstack $In function : Length of class PrimitiveObject$ stdstack
559: /Arglist set /Argthis set /FunctionValue [ ] def
560: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
561: [Argthis] Arglist join ArgNames mapset
562: f length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
563: db.DebugStack setstack pop stdstack
564: FunctionValue } def
565: %%end of function
566:
567: /Indexed {
568: db.DebugStack setstack $In function : Indexed of class PrimitiveObject$ stdstack
569: /Arglist set /Argthis set /FunctionValue [ ] def
570: [/this /name /i ] /ArgNames set ArgNames pushVariables [ %%function body
571: [Argthis] Arglist join ArgNames mapset
572: name i s.Indexed /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
573: db.DebugStack setstack pop stdstack
574: FunctionValue } def
575: %%end of function
576:
577: /Indexed2 {
578: db.DebugStack setstack $In function : Indexed2 of class PrimitiveObject$ stdstack
579: /Arglist set /Argthis set /FunctionValue [ ] def
580: [/this /name /i /j ] /ArgNames set ArgNames pushVariables [ %%function body
581: [Argthis] Arglist join ArgNames mapset
582: name i j s.Indexed2 /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
583: db.DebugStack setstack pop stdstack
584: FunctionValue } def
585: %%end of function
586:
587: /Transpose {
588: db.DebugStack setstack $In function : Transpose of class PrimitiveObject$ stdstack
589: /Arglist set /Argthis set /FunctionValue [ ] def
590: [/this /mat ] /ArgNames set ArgNames pushVariables [ %%function body
591: [Argthis] Arglist join ArgNames mapset
592: mat transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
593: db.DebugStack setstack pop stdstack
594: FunctionValue } def
595: %%end of function
596:
597:
598: /s.Indexed {
599: (integer) dc /arg2 set
600: /arg1 set
601: arg1 ([) arg2 (dollar) dc (]) 4 cat_n
602: } def
603:
604: /s.Indexed2 {
605: (integer) dc /arg3 set
606: (integer) dc /arg2 set
607: /arg1 set
608: arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
609: } def
610: /Groebner {
611: db.DebugStack setstack $In function : Groebner of class PrimitiveObject$ stdstack
612: /Arglist set /Argthis set /FunctionValue [ ] def
613: [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
614: [Argthis] Arglist join ArgNames mapset
615: F {[[(h). (1).]] replace homogenize} map /arg1 set
616: [arg1] groebner 0 get
617: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
618: db.DebugStack setstack pop stdstack
619: FunctionValue } def
620: %%end of function
621:
622: /GroebnerTime {
623: db.DebugStack setstack $In function : GroebnerTime of class PrimitiveObject$ stdstack
624: /Arglist set /Argthis set /FunctionValue [ ] def
625: [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
626: [Argthis] Arglist join ArgNames mapset
627: F {[[(h). (1).]] replace homogenize} map /arg1 set
628: { [arg1] groebner 0 get } timer
629: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
630: db.DebugStack setstack pop stdstack
631: FunctionValue } def
632: %%end of function
633:
634: /LiftStd {
635: db.DebugStack setstack $In function : LiftStd of class PrimitiveObject$ stdstack
636: /Arglist set /Argthis set /FunctionValue [ ] def
637: [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
638: [Argthis] Arglist join ArgNames mapset
639: F {[[(h). (1).]] replace homogenize} map /arg1 set
640: [arg1 [(needBack)]] groebner
641: /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
642: db.DebugStack setstack pop stdstack
643: FunctionValue } def
644: %%end of function
645:
646: /Reduction {
647: db.DebugStack setstack $In function : Reduction of class PrimitiveObject$ stdstack
648: /Arglist set /Argthis set /FunctionValue [ ] def
649: [/this /f /G ] /ArgNames set ArgNames pushVariables [ %%function body
650: [Argthis] Arglist join ArgNames mapset
651: f G reduction /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
652: db.DebugStack setstack pop stdstack
653: FunctionValue } def
654: %%end of function
655:
656: /IntegerToSm1Integer {
657: db.DebugStack setstack $In function : IntegerToSm1Integer of class PrimitiveObject$ stdstack
658: /Arglist set /Argthis set /FunctionValue [ ] def
659: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
660: [Argthis] Arglist join ArgNames mapset
661: f (integer) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
662: db.DebugStack setstack pop stdstack
663: FunctionValue } def
664: %%end of function
665:
666: /RingD {
667: db.DebugStack setstack $In function : RingD of class PrimitiveObject$ stdstack
668: /Arglist set /Argthis set /FunctionValue [ ] def
669: [/this /vList /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body
670: [Argthis] Arglist join ArgNames mapset
671: [ %%start of local variables
672: /new0 /tmp /size /n /i /j /newtmp /ringpp /argsize ] pushVariables [ %%local variables
673: this [ %% function args
674: Arglist ] {Length} sendmsg2
675: /argsize set
676: argsize (1).. eq
677: %% if-condition
678: { %%ifbody
679: [ vList ring_of_differential_operators ( ) elimination_order 0 ] define_ring
680: /tmp set tmp /FunctionValue set {/ExitPoint goto} exec %%return
681: }%%end if if body
682: { %%if- else part
683: } ifelse
684: argsize (2).. eq
685: %% if-condition
686: { %%ifbody
687: (0).. /pp set
688: }%%end if if body
689: { %%if- else part
690: } ifelse
691: this [ %% function args
692: pp ] {IntegerToSm1Integer} sendmsg2
693: /pp set
694: this [ %% function args
695: weightMatrix ] {Length} sendmsg2
696: /size set
697: this [ %% function args
698: size ] {NewVector} sendmsg2
699: /new0 set
700: /@@@.indexMode.flag.save @@@.indexMode.flag def 0 @@@.indexMode (0).. %%PSfor initvalue.
701: (integer) data_conversion
702: size (1).. sub (integer) data_conversion 1 2 -1 roll
703: { %% for body
704: (universalNumber) data_conversion /i set
705: weightMatrix [i ] Get
706: /tmp set
707: this [ %% function args
708: tmp ] {Length} sendmsg2
709: /n set
710: this [ %% function args
711: n ] {NewVector} sendmsg2
712: /newtmp set
713: (1).. /j set
714: %%for init.
715: %%for
716: { j n lt
717: { } {exit} ifelse
718: [ {%%increment
719: j (2).. {add} sendmsg2
720: /j set
721: } %%end of increment{A}
722: {%%start of B part{B}
723: newtmp [j (1).. {sub} sendmsg2
724: ] tmp [j (1).. {sub} sendmsg2
725: ] Get
726: Put
727: newtmp [j ] this [ %% function args
728: tmp [j ] Get
729: ] {IntegerToSm1Integer} sendmsg2
730: Put
731: } %% end of B part. {B}
732: 2 1 roll] {exec} map pop
733: } loop %%end of for
734: new0 [i ] newtmp Put
735: } for
736: [ vList ring_of_differential_operators new0 weight_vector pp ] define_ring /ringpp set
737: @@@.indexMode.flag.save @@@.indexMode ringpp /FunctionValue set {/ExitPoint goto} exec %%return
738: /ExitPoint ]pop popVariables %%pop the local variables
739: /ExitPoint ]pop popVariables %%pop argValues
740: db.DebugStack setstack pop stdstack
741: FunctionValue } def
742: %%end of function
743:
744: /getxvar {
745: db.DebugStack setstack $In function : getxvar of class PrimitiveObject$ stdstack
746: /Arglist set /Argthis set /FunctionValue [ ] def
747: [/this /i ] /ArgNames set ArgNames pushVariables [ %%function body
748: [Argthis] Arglist join ArgNames mapset
749: [(x) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
750: db.DebugStack setstack pop stdstack
751: FunctionValue } def
752: %%end of function
753:
754: /getdvar {
755: db.DebugStack setstack $In function : getdvar of class PrimitiveObject$ stdstack
756: /Arglist set /Argthis set /FunctionValue [ ] def
757: [/this /i ] /ArgNames set ArgNames pushVariables [ %%function body
758: [Argthis] Arglist join ArgNames mapset
759: [(D) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
760: db.DebugStack setstack pop stdstack
761: FunctionValue } def
762: %%end of function
763:
764: /getvarn {
765: db.DebugStack setstack $In function : getvarn of class PrimitiveObject$ stdstack
766: /Arglist set /Argthis set /FunctionValue [ ] def
767: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
768: [Argthis] ArgNames mapset
769: [(N)] system_variable (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
770: db.DebugStack setstack pop stdstack
771: FunctionValue } def
772: %%end of function
773:
774: true /SetRingVariables_Verbose set
775: /SetRingVariables {
776: db.DebugStack setstack $In function : SetRingVariables of class PrimitiveObject$ stdstack
777: /Arglist set /Argthis set /FunctionValue [ ] def
778: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
779: [Argthis] ArgNames mapset
780: SetRingVariables_Verbose %% if-condition
781: { %%ifbody
782: this [ %% function args
783: (SetRingVariables() Setting the global variables : ) ] {Print} sendmsg2
784: }%%end if if body
785: { %%if- else part
786: } ifelse
787: this [ %% function args
788: (0).. [(CC)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
789: this [ %% function args
790: [(C)] system_variable (universalNumber) dc [(LL)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
791: this [ %% function args
792: [(L)] system_variable (universalNumber) dc [(MM)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
793: this [ %% function args
794: [(M)] system_variable (universalNumber) dc [(NN)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
795: SetRingVariables_Verbose %% if-condition
796: { %%ifbody
797: this [ %% function args
798: ] {Ln} sendmsg2
799: }%%end if if body
800: { %%if- else part
801: } ifelse
802: /ExitPoint ]pop popVariables %%pop argValues
803: db.DebugStack setstack pop stdstack
804: FunctionValue } def
805: %%end of function
806:
807: /k00AreThereLeftBrace {
808: db.DebugStack setstack $In function : k00AreThereLeftBrace of class PrimitiveObject$ stdstack
809: /Arglist set /Argthis set /FunctionValue [ ] def
810: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
811: [Argthis] Arglist join ArgNames mapset
812: [ %%start of local variables
813: /leftBrace /jj /slist ] pushVariables [ %%local variables
814: $[$ (array) dc 0 get (universalNumber) dc /leftBrace set
815: this [ %% function args
816: this [ %% function args
817: s ] {StringToIntegerArray} sendmsg2
818: leftBrace ] {Position} sendmsg2
819: /jj set
820: jj (1).. (0).. 2 1 roll {sub} sendmsg
821: eq not
822: %% if-condition
823: { %%ifbody
824: true /FunctionValue set {/ExitPoint goto} exec %%return
825: }%%end if if body
826: { %%if- else part
827: false /FunctionValue set {/ExitPoint goto} exec %%return
828: } ifelse
829: /ExitPoint ]pop popVariables %%pop the local variables
830: /ExitPoint ]pop popVariables %%pop argValues
831: db.DebugStack setstack pop stdstack
832: FunctionValue } def
833: %%end of function
834:
835: /k00setRingVariables {
836: db.DebugStack setstack $In function : k00setRingVariables of class PrimitiveObject$ stdstack
837: /Arglist set /Argthis set /FunctionValue [ ] def
838: [/this /tmp002_p /tmp002_q ] /ArgNames set ArgNames pushVariables [ %%function body
839: [Argthis] Arglist join ArgNames mapset
840: [ %%start of local variables
841: /tmp002_i /tmp002_v /tmp002_str ] pushVariables [ %%local variables
842: tmp002_p %%PSfor initvalue.
843: (integer) data_conversion
844: tmp002_q (1).. sub (integer) data_conversion 1 2 -1 roll
845: { %% for body
846: (universalNumber) data_conversion /tmp002_i set
847: this [ %% function args
848: tmp002_i ] {getxvar} sendmsg2
849: /tmp002_v set
850: this [ %% function args
851: tmp002_v ] {k00AreThereLeftBrace} sendmsg2
852: %% if-condition
853: { %%ifbody
854: }%%end if if body
855: { %%if- else part
856: SetRingVariables_Verbose %% if-condition
857: { %%ifbody
858: this [ %% function args
859: tmp002_v ] {Print} sendmsg2
860: this [ %% function args
861: ( ) ] {Print} sendmsg2
862: }%%end if if body
863: { %%if- else part
864: } ifelse
865: this [ %% function args
866: [ (/) tmp002_v ( $) tmp002_v ($ expand def ) ] ] {AddString} sendmsg2
867: /str set
868: [(parse) str ] extension } ifelse
869: this [ %% function args
870: tmp002_i ] {getdvar} sendmsg2
871: /tmp002_v set
872: this [ %% function args
873: tmp002_v ] {k00AreThereLeftBrace} sendmsg2
874: %% if-condition
875: { %%ifbody
876: }%%end if if body
877: { %%if- else part
878: SetRingVariables_Verbose %% if-condition
879: { %%ifbody
880: this [ %% function args
881: tmp002_v ] {Print} sendmsg2
882: this [ %% function args
883: ( ) ] {Print} sendmsg2
884: }%%end if if body
885: { %%if- else part
886: } ifelse
887: this [ %% function args
888: [ (/) tmp002_v ( $) tmp002_v ($ expand def ) ] ] {AddString} sendmsg2
889: /str set
890: [(parse) str ] extension } ifelse
891: } for
892: /ExitPoint ]pop popVariables %%pop the local variables
893: /ExitPoint ]pop popVariables %%pop argValues
894: db.DebugStack setstack pop stdstack
895: } def
896: %%end of function
897:
898: /AddString {
899: db.DebugStack setstack $In function : AddString of class PrimitiveObject$ stdstack
900: /Arglist set /Argthis set /FunctionValue [ ] def
901: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
902: [Argthis] Arglist join ArgNames mapset
903: f aload length cat_n /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
904: db.DebugStack setstack pop stdstack
905: FunctionValue } def
906: %%end of function
907:
908: /IntegerToString {
909: db.DebugStack setstack $In function : IntegerToString of class PrimitiveObject$ stdstack
910: /Arglist set /Argthis set /FunctionValue [ ] def
911: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
912: [Argthis] Arglist join ArgNames mapset
913: f (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
914: db.DebugStack setstack pop stdstack
915: FunctionValue } def
916: %%end of function
917:
918: /Replace {
919: db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack
920: /Arglist set /Argthis set /FunctionValue [ ] def
921: [/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
922: [Argthis] Arglist join ArgNames mapset
923: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
924: db.DebugStack setstack pop stdstack
925: FunctionValue } def
926: %%end of function
927:
928: /AsciiToString {
929: db.DebugStack setstack $In function : AsciiToString of class PrimitiveObject$ stdstack
930: /Arglist set /Argthis set /FunctionValue [ ] def
931: [/this /c ] /ArgNames set ArgNames pushVariables [ %%function body
932: [Argthis] Arglist join ArgNames mapset
933: c (integer) dc (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
934: db.DebugStack setstack pop stdstack
935: FunctionValue } def
936: %%end of function
937:
938: /ToString {
939: db.DebugStack setstack $In function : ToString of class PrimitiveObject$ stdstack
940: /Arglist set /Argthis set /FunctionValue [ ] def
941: [/this /p ] /ArgNames set ArgNames pushVariables [ %%function body
942: [Argthis] Arglist join ArgNames mapset
943: [ %%start of local variables
944: /n /ans /i ] pushVariables [ %%local variables
945: [ ] /ans set
946: this [ %% function args
947: p ] {IsArray} sendmsg2
948: %% if-condition
949: { %%ifbody
950: this [ %% function args
951: p ] {Length} sendmsg2
952: /n set
953: this [ %% function args
954: ans ([ ) ] {Append} sendmsg2
955: /ans set
956: (0).. /i set
957: %%for init.
958: %%for
959: { i n lt
960: { } {exit} ifelse
961: [ {%%increment
962: /i i (1).. add def
963: } %%end of increment{A}
964: {%%start of B part{B}
965: this [ %% function args
966: ans this [ %% function args
967: p [i ] Get
968: ] {ToString} sendmsg2
969: ] {Append} sendmsg2
970: /ans set
971: i n (1).. {sub} sendmsg2
972: eq not
973: %% if-condition
974: { %%ifbody
975: this [ %% function args
976: ans ( , ) ] {Append} sendmsg2
977: /ans set
978: }%%end if if body
979: { %%if- else part
980: } ifelse
981: } %% end of B part. {B}
982: 2 1 roll] {exec} map pop
983: } loop %%end of for
984: this [ %% function args
985: ans ( ] ) ] {Append} sendmsg2
986: /ans set
987: }%%end if if body
988: { %%if- else part
989: [ p (dollar) dc ] /ans set
990: } ifelse
991: this [ %% function args
992: ans ] {AddString} sendmsg2
993: /FunctionValue set {/ExitPoint goto} exec %%return
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: /IsArray {
1001: db.DebugStack setstack $In function : IsArray of class PrimitiveObject$ stdstack
1002: /Arglist set /Argthis set /FunctionValue [ ] def
1003: [/this /p ] /ArgNames set ArgNames pushVariables [ %%function body
1004: [Argthis] Arglist join ArgNames mapset
1005: p isArray /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
1006: db.DebugStack setstack pop stdstack
1007: FunctionValue } def
1008: %%end of function
1009:
1010: /Denominator {
1011: db.DebugStack setstack $In function : Denominator of class PrimitiveObject$ stdstack
1012: /Arglist set /Argthis set /FunctionValue [ ] def
1013: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
1014: [Argthis] Arglist join ArgNames mapset
1015: f (denominator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
1016: db.DebugStack setstack pop stdstack
1017: FunctionValue } def
1018: %%end of function
1019:
1020: /Numerator {
1021: db.DebugStack setstack $In function : Numerator of class PrimitiveObject$ stdstack
1022: /Arglist set /Argthis set /FunctionValue [ ] def
1023: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
1024: [Argthis] Arglist join ArgNames mapset
1025: f (numerator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
1026: db.DebugStack setstack pop stdstack
1027: FunctionValue } def
1028: %%end of function
1029:
1030: /Replace {
1031: db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack
1032: /Arglist set /Argthis set /FunctionValue [ ] def
1033: [/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
1034: [Argthis] Arglist join ArgNames mapset
1035: [ %%start of local variables
1036: /ans /n /tmp /i /num /den ] pushVariables [ %%local variables
1037: this [ %% function args
1038: f ] {IsArray} sendmsg2
1039: %% if-condition
1040: { %%ifbody
1041: this [ %% function args
1042: f ] {Length} sendmsg2
1043: /n set
1044: [ ] /ans set
1045: (0).. /i set
1046: %%for init.
1047: %%for
1048: { i n lt
1049: { } {exit} ifelse
1050: [ {%%increment
1051: /i i (1).. add def
1052: } %%end of increment{A}
1053: {%%start of B part{B}
1054: this [ %% function args
1055: ans this [ %% function args
1056: f [i ] Get
1057: rule ] {Replace} sendmsg2
1058: ] {Append} sendmsg2
1059: /ans set
1060: } %% end of B part. {B}
1061: 2 1 roll] {exec} map pop
1062: } loop %%end of for
1063: ans /FunctionValue set {/ExitPoint goto} exec %%return
1064: }%%end if if body
1065: { %%if- else part
1066: } ifelse
1067: f tag RationalFunctionP eq %% if-condition
1068: { %%ifbody
1069: this [ %% function args
1070: f ] {Numerator} sendmsg2
1071: /num set
1072: this [ %% function args
1073: f ] {Denominator} sendmsg2
1074: /den set
1075: num rule replace /num set
1076: den rule replace /den set
1077: num den {div} sendmsg2
1078: /FunctionValue set {/ExitPoint goto} exec %%return
1079: }%%end if if body
1080: { %%if- else part
1081: } ifelse
1082: f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables
1083: /ExitPoint ]pop popVariables %%pop argValues
1084: db.DebugStack setstack pop stdstack
1085: FunctionValue } def
1086: %%end of function
1087:
1088: /Map {
1089: db.DebugStack setstack $In function : Map of class PrimitiveObject$ stdstack
1090: /Arglist set /Argthis set /FunctionValue [ ] def
1091: [/this /karg /func ] /ArgNames set ArgNames pushVariables [ %%function body
1092: [Argthis] Arglist join ArgNames mapset
1093: karg { [ 2 -1 roll ] this 2 -1 roll [(parse) func ] extension pop } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
1094: db.DebugStack setstack pop stdstack
1095: FunctionValue } def
1096: %%end of function
1097:
1098: this [ %% function args
1099: [ (Map) [ (Map(karg,func) applies the function <<func>> to the <<karg>>(string func).) ( Ex. Map([82,83,85],"AsciiToString"):) ] ] ] {HelpAdd} sendmsg2
1100: /Position {
1101: db.DebugStack setstack $In function : Position of class PrimitiveObject$ stdstack
1102: /Arglist set /Argthis set /FunctionValue [ ] def
1103: [/this /list /elem ] /ArgNames set ArgNames pushVariables [ %%function body
1104: [Argthis] Arglist join ArgNames mapset
1105: [ %%start of local variables
1106: /n /pos /i ] pushVariables [ %%local variables
1107: this [ %% function args
1108: list ] {Length} sendmsg2
1109: /n set
1110: (1).. (0).. 2 1 roll {sub} sendmsg
1111: /pos set
1112: (0).. /i set
1113: %%for init.
1114: %%for
1115: { i n lt
1116: { } {exit} ifelse
1117: [ {%%increment
1118: /i i (1).. add def
1119: } %%end of increment{A}
1120: {%%start of B part{B}
1121: elem list [i ] Get
1122: eq
1123: %% if-condition
1124: { %%ifbody
1125: i /pos set
1126: /k00.label0 goto }%%end if if body
1127: { %%if- else part
1128: } ifelse
1129: } %% end of B part. {B}
1130: 2 1 roll] {exec} map pop
1131: } loop %%end of for
1132: /k00.label0 pos /FunctionValue set {/ExitPoint goto} exec %%return
1133: /ExitPoint ]pop popVariables %%pop the local variables
1134: /ExitPoint ]pop popVariables %%pop argValues
1135: db.DebugStack setstack pop stdstack
1136: FunctionValue } def
1137: %%end of function
1138:
1139: this [ %% function args
1140: [ (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
1141: /StringToIntegerArray {
1142: db.DebugStack setstack $In function : StringToIntegerArray of class PrimitiveObject$ stdstack
1143: /Arglist set /Argthis set /FunctionValue [ ] def
1144: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
1145: [Argthis] Arglist join ArgNames mapset
1146: s (array) dc { (universalNumber) dc } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
1147: db.DebugStack setstack pop stdstack
1148: FunctionValue } def
1149: %%end of function
1150:
1151: this [ %% function args
1152: [ (StringToIntegerArray) [ (StringToIntegerArray(s) decomposes the string <<s>> into an array of) (ascii codes of <<s>> (string s).) (cf. AsciiToString.) ] ] ] {HelpAdd} sendmsg2
1153: /StringToAsciiArray {
1154: db.DebugStack setstack $In function : StringToAsciiArray of class PrimitiveObject$ stdstack
1155: /Arglist set /Argthis set /FunctionValue [ ] def
1156: [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
1157: [Argthis] Arglist join ArgNames mapset
1158: this [ %% function args
1159: s ] {StringToIntegerArray} sendmsg2
1160: /FunctionValue set {/ExitPoint goto} exec %%return
1161: /ExitPoint ]pop popVariables %%pop argValues
1162: db.DebugStack setstack pop stdstack
1163: FunctionValue } def
1164: %%end of function
1165:
1166: this [ %% function args
1167: [ (StringToAsciiArray) [ (StringToAsciiArray(s) is StringToIntegerArray(s).) ] ] ] {HelpAdd} sendmsg2
1168: /NewArray {
1169: db.DebugStack setstack $In function : NewArray of class PrimitiveObject$ stdstack
1170: /Arglist set /Argthis set /FunctionValue [ ] def
1171: [/this /n ] /ArgNames set ArgNames pushVariables [ %%function body
1172: [Argthis] Arglist join ArgNames mapset
1173: this [ %% function args
1174: n ] {NewVector} sendmsg2
1175: /FunctionValue set {/ExitPoint goto} exec %%return
1176: /ExitPoint ]pop popVariables %%pop argValues
1177: db.DebugStack setstack pop stdstack
1178: FunctionValue } def
1179: %%end of function
1180:
1181: this [ %% function args
1182: [ (NewArray) [ (NewArray(n) returns an array of size n (integer n).) ] ] ] {HelpAdd} sendmsg2
1183: %% This package requires kan/sm1 version 951228 or later.
1184: %% The binary file of kan/sm1 of this version is temporary obtainable from
1185: %% ftp.math.s.kobe-u.ac.jp. The file /pub/kan/sm1.binary.sunos4.3.japanese
1186: %% is for sun with JLE.
1187: %% How to Install
1188: %% 1.Copy this file and rename it to sm1 (mv sm1.binary.sunos4.3.japanese sm1).
1189: %% 2.Add executable property (chmod +x sm1).
1190:
1191:
1192: %% NEW feature of factor-b.sm1. [ ---> kanLeftBrace, ] ---> kanRightBrace
1193: {
1194: (factor-b.sm1 : kan/sm1 package to factor polynomials by calling risa/asir.)
1195: message
1196: ( : kan/sm1 package to simplify rationals by calling risa/asir.)
1197: message
1198: ( CANCEL HAS NOT BEEN TESTED.) message
1199: ( : kan/sm1 package to compute hilbert polynomials by calling sm0.)
1200: message
1201: ( Version March 5, 1997. It runs on kan/sm1 version 951228 or later.) message
1202: }
1203:
1204: [(factor)
1205: [(polynomial factor list_of_strings)
1206: (Example: (x^2-1). factor :: ---> [[$1$ $1$] [$x-1$ $1$] [$x+1$ $1$]])
1207: (cf.: data_conversion, map, get, pushfile)
1208: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
1209: ( asir-tmp-out.t, asir-tmp-log.t and asir-tmp-out.tt )
1210: ( in the current directory.)
1211: ]
1212: ] putUsages
1213:
1214: %% /f (Dx^10*d*a-d*a) def
1215:
1216: /factor-asir-1 {
1217: /arg1 set
1218: [/f /fd /fnewline] pushVariables
1219: [
1220: arg1 /f set
1221: %%(factor-asir-1 is tested with Asir version 950831 on Linux.) message
1222: (asir-tmp.t) (w) file /fd set
1223: /fnewline { fd 10 (string) data_conversion writestring } def
1224: fd $output("asir-tmp-out.t");$ writestring fnewline
1225: fd $fctr($ writestring
1226: fd f writestring
1227: fd $); output(); quit(); $ writestring fnewline
1228: fd closefile
1229: (/bin/rm -f asir-tmp.tt) system
1230: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" | sed "s/\[/kanLeftBrace/g" | sed "s/\]/kanRightBrace/g" | sed "s/\,/kanComma/g" >asir-tmp.tt) system
1231: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
1232: (asir <asir-tmp.tt >asir-tmp-log.t) system
1233: (sed "s/\[1\]/ /g" asir-tmp-out.t | sed "s/\[2\]/ /g" | sed "1s/1/ /g"| sed "s/\[/{/g" | sed "s/\]/}/g" | sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" | sed "s/kanLeftBrace/\[/g" | sed "s/kanRightBrace/\]/g" | sed "s/kanComma/\,/g" >asir-tmp-out.tt) system
1234: ] pop
1235: popVariables
1236: } def
1237:
1238: /clean-workfiles {
1239: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp.t asir-tmp.tt sm0-tmp.t sm0-tmp-out.t asir-tmp-log.t sm0-tmp-out.tt) system
1240: } def
1241:
1242:
1243: %% comment: there is not data conversion function from string --> array
1244: %% e.g. (abc) ---> [0x61, 0x62, 0x63]
1245: %% We can do (abc) 1 10 put, but "get" does not work for strings.
1246:
1247: %% f factor-asir-1
1248:
1249: %%/aaa
1250: %% ({{1,1},{x-1,1},{x+1,1},{x^4+x^3+x^2+x+1,1},{x^4-x^3+x^2-x+1,1}})
1251: %%def
1252:
1253: /asir-list-to-kan {
1254: /arg1 set
1255: [/aaa /ftmp /ftmp2] pushVariables
1256: [
1257: /aaa arg1 def
1258: [ aaa to_records pop ] /ftmp set
1259: ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
1260: /arg1 ftmp2 def
1261: ] pop
1262: popVariables
1263: arg1
1264: } def
1265:
1266: /foo {
1267: (input string is in f) message
1268: f ::
1269: f factor-asir-1
1270: %% (asir-tmp-out.tt) run
1271: %% (answer in @asir.out) message
1272: %% bug of run.
1273: (asir-tmp-out.tt) pushfile /@asir.out set
1274: @asir.out asir-list-to-kan /ff2 set
1275: (answer in ff2) message
1276: } def
1277:
1278: /factor {
1279: (string) data_conversion
1280: factor-asir-1
1281: (asir-tmp-out.tt) pushfile asir-list-to-kan
1282: } def
1283:
1284: %%%%%%%%%%%%%%%%% macros for simplification (reduction, cancel)
1285: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1286: [(cancel)
1287: [(polynomial cancel list_of_strings)
1288: (This function simplifies rationals.)
1289: (Example: $x^2-1$. $x+1$. div cancel :: ---> [[$x-1$ , $1$]])
1290: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
1291: ( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
1292: ( in the current directory.)
1293: ]
1294: ] putUsages
1295:
1296: /reduce-asir-1 {
1297: /arg1 set
1298: [/f /fd /fnewline] pushVariables
1299: [
1300: arg1 /f set
1301: %% (reduce-asir-1 is tested with Asir version 950831 on Linux.) message
1302: (asir-tmp.t) (w) file /fd set
1303: /fnewline { fd 10 (string) data_conversion writestring } def
1304: fd $output("asir-tmp-out.t");$ writestring fnewline
1305: fd $AsirTmp012=red($ writestring
1306: fd f writestring
1307: fd $)$ writestring
1308: fd ($ ) writestring fnewline
1309: fd $[[nm(AsirTmp012), dn(AsirTmp012)]];output();quit(); $ writestring fnewline
1310: fd closefile
1311: (/bin/rm -f asir-tmp.tt) system
1312: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
1313: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
1314: (asir <asir-tmp.tt >asir-tmp-log.t) system
1315: (sed "s/\[1\]/ /g" asir-tmp-out.t | sed "s/\[2\]/ /g" |sed "s/\[3\]/ /g" | sed "1s/1/ /g"| sed "s/\[/{/g" | sed "s/\]/}/g" | sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" | sed "s/kanLeftBrace/\[/g" | sed "s/kanRightBrace/\]/g" | sed "s/kanComma/\,/g" >asir-tmp-out.tt) system
1316: ] pop
1317: popVariables
1318: } def
1319:
1320: /cancel {
1321: (string) data_conversion
1322: reduce-asir-1
1323: (asir-tmp-out.tt) pushfile asir-list-to-kan
1324: } def
1325: %%%%%%%%%%%%%%%%% macros for Hilbert functions
1326: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1327: /hilbert {
1328: /arg2 set
1329: /arg1 set
1330: [/bases /vars] pushVariables
1331: [
1332: /bases arg1 def
1333: /vars arg2 def
1334: bases {init (string) data_conversion} map /bases set
1335: bases vars execSm0
1336:
1337: (sed '1s/^\$/{/g' sm0-tmp-out.t | sed '1s/\$$/ , /g' | sed '2s/^\$//g' | sed '2s/\$$/}/g' | sed 's/V//g' >sm0-tmp-out.tt) system
1338: ] pop
1339: popVariables
1340: [ (sm0-tmp-out.tt) pushfile to_records pop]
1341: } def
1342: [(hilbert)
1343: [(------------------------------------------------------------------------)
1344: (list_of_polynomials variables hilbert hilbert_function)
1345: (Example: [(x^2-1). (x y -2).] (x,y) hilbert :: ---> [$...$ $,,,$] )
1346: (cf.: data_conversion, map, get, pushfile)
1347: (Note: The function call creates work files sm0-tmp.t, sm0-tmp-out.tt,)
1348: ( sm0-tmp-log.t and sm0-tmp-out.t in the current directory.)
1349: ]
1350: ] putUsages
1351:
1352:
1353: %% Ex. [(x^2) (y^3) (x y)] (x,y) execSm0
1354: /execSm0 {
1355: /arg2 set
1356: /arg1 set
1357: [/monoms /fd /tmp /vars] pushVariables
1358: [
1359: /monoms arg1 def
1360: /vars arg2 def
1361: (/bin/rm -f sm0-tmp-out.t sm0-tmp-out.tt sm0-tmp-log.t) system
1362: (sm0-tmp.t) (w) file /fd set
1363: fd ( ${-p,0}$ options ) writestring
1364: fd ( $) writestring
1365: ${$ vars $}$ 3 cat_n /tmp set
1366: fd tmp writestring
1367: fd ($ ) writestring
1368: fd ( polynomial_ring set_up_ring ${-proof}$ options ) writestring
1369: fd monoms writeArray
1370: fd ( /ff = ff yaGroebner /gg = gg hilbert2 /ans = ) writestring
1371: fd (ans :: ans decompose $sm0-tmp-out.t$ printn_to_file quit) writestring
1372: fd closefile
1373: (sm0 -f sm0-tmp.t >sm0-tmp-log.t) system
1374: (When the output is [$ a V^k + ... $ $p!$], the multiplicity is ) message
1375: $ (k! a)/p! $ message
1376: ( ) message
1377: ] pop
1378: popVariables
1379: } def
1380:
1381:
1382: /writeArray {
1383: /arg2 set /arg1 set
1384: [/fd /arr /k] pushVariables
1385: [ /fd arg1 def
1386: /arr arg2 def
1387: fd ([ ) writestring
1388: 0 1 arr length 1 sub
1389: {
1390: /k set
1391: fd ($ ) writestring
1392: fd arr k get writestring
1393: fd ($ ) writestring
1394: } for
1395: fd ( ] ) writestring
1396: ] pop
1397: popVariables
1398: } def
1399:
1400:
1401:
1402: %%(Loaded macros "factor", "hilbert".) message
1403:
1404: [(primadec)
1405: [([polynomials] [variables] primadec list_of_strings)
1406: (cf.: data_conversion, map, get, pushfile)
1407: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
1408: ( asir-tmp-out.t, asir-tmp-log.t and asir-tmp-out.tt )
1409: ( in the current directory.)
1410: ]
1411: ] putUsages
1412:
1413:
1414: /sendcommand-to-asir2 { %% arg1 arg2 command sendcommand-to-asir2
1415: /arg3 set /arg2 set /arg1 set
1416: [/f /fd /fnewline /com /g] pushVariables
1417: [
1418: arg1 /f set arg2 /g set arg3 /com set
1419: (asir-tmp.t) (w) file /fd set
1420: /fnewline { fd 10 (string) data_conversion writestring } def
1421: fd $load("gr"); load("primdec"); output("asir-tmp-out.t");$ writestring fnewline
1422: fd com $($ 2 cat_n writestring
1423: fd f writestring
1424: fd $,$ writestring
1425: fd g writestring
1426: fd $); output(); quit(); $ writestring fnewline
1427: fd closefile
1428: (/bin/rm -f asir-tmp.tt) system
1429: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
1430: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
1431: (asir <asir-tmp.tt >asir-tmp-log.t) system
1432: (sed "s/\[147\]/ /g" asir-tmp-out.t | sed "s/\[148\]/ /g" | sed "1s/1/ /g"| sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" >asir-tmp-out.tt) system
1433: ] pop
1434: popVariables
1435: } def
1436:
1437: /clean-workfiles {
1438: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp.t asir-tmp.tt sm0-tmp.t sm0-tmp-out.t asir-tmp-log.t sm0-tmp-out.tt) system
1439: } def
1440:
1441:
1442: /asir-list-to-kan {
1443: /arg1 set
1444: [/aaa /ftmp /ftmp2] pushVariables
1445: [
1446: /aaa arg1 def
1447: [ aaa to_records pop ] /ftmp set
1448: ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
1449: /arg1 ftmp2 def
1450: ] pop
1451: popVariables
1452: arg1
1453: } def
1454:
1455:
1456: /primadec {
1457: /arg2 set /arg1 set
1458: [/f /g] pushVariables
1459: [
1460: /f arg1 def /g arg2 def
1461: f { (string) dc removeBrace } map toString
1462: g { (string) dc removeBrace } map toString (primadec)
1463: sendcommand-to-asir2
1464: (asir-tmp-out.tt) pushfile asir-list-to-kan /arg1
1465: ] pop popVariables
1466: arg1
1467: } def
1468:
1469: /removeBrace { %% string removeBrace string
1470: %% (z[1]^2-1) removeBrace (z_1 ^2-1)
1471: /arg1 set
1472: [/f /i /ans /fa] pushVariables
1473: [
1474: /f arg1 def f 1 copy /f set
1475: f (array) dc /fa set
1476: 0 1 fa length 1 sub {
1477: /i set
1478: fa i get 91 eq
1479: { f i 95 put }
1480: { } ifelse
1481: fa i get 93 eq
1482: { f i 32 put }
1483: { } ifelse
1484: } for
1485: % fa aload length cat_n /arg1 set %% This may cause operand stack overflow.
1486: f /arg1 set
1487: ] pop
1488: popVariables
1489: arg1
1490: } def
1491:
1492:
1493:
1494:
1495:
1496:
1497:
1498:
1499: K00_verbose %% if-condition
1500: { %%ifbody
1501: this [ %% function args
1502: (help.k (help.ccc). 8/6, 1996 --- 8/7, 1996. 3/6, 1997 --- 4/29, 1997.) ] {Println} sendmsg2
1503: }%%end if if body
1504: { %%if- else part
1505: } ifelse
1506: /help {
1507: db.DebugStack setstack $In function : help of class PrimitiveObject$ stdstack
1508: /Arglist set /Argthis set /FunctionValue [ ] def
1509: [/this /x ] /ArgNames set ArgNames pushVariables [ %%function body
1510: [Argthis] Arglist join ArgNames mapset
1511: this [ %% function args
1512: Arglist ] {Length} sendmsg2
1513: (1).. lt
1514: %% if-condition
1515: { %%ifbody
1516: this [ %% function args
1517: ( ) ] {ShowKeyWords} sendmsg2
1518: }%%end if if body
1519: { %%if- else part
1520: this [ %% function args
1521: x ] {Help} sendmsg2
1522: } ifelse
1523: /ExitPoint ]pop popVariables %%pop argValues
1524: db.DebugStack setstack pop stdstack
1525: FunctionValue } def
1526: %%end of function
1527:
1528: /Help {
1529: db.DebugStack setstack $In function : Help of class PrimitiveObject$ stdstack
1530: /Arglist set /Argthis set /FunctionValue [ ] def
1531: [/this /key ] /ArgNames set ArgNames pushVariables [ %%function body
1532: [Argthis] Arglist join ArgNames mapset
1533: [ %%start of local variables
1534: /n /i /item /m /item1 /j ] pushVariables [ %%local variables
1535: this [ %% function args
1536: Arglist ] {Length} sendmsg2
1537: (1).. lt
1538: %% if-condition
1539: { %%ifbody
1540: this [ %% function args
1541: ( ) ] {ShowKeyWords} sendmsg2
1542: [ ] /FunctionValue set {/ExitPoint goto} exec %%return
1543: }%%end if if body
1544: { %%if- else part
1545: } ifelse
1546: key (ALL) eq
1547: %% if-condition
1548: { %%ifbody
1549: this [ %% function args
1550: (ALL) ] {ShowKeyWords} sendmsg2
1551: (0).. /FunctionValue set {/ExitPoint goto} exec %%return
1552: }%%end if if body
1553: { %%if- else part
1554: } ifelse
1555: this [ %% function args
1556: Helplist ] {Length} sendmsg2
1557: /n set
1558: (0).. %%PSfor initvalue.
1559: (integer) data_conversion
1560: n (1).. sub (integer) data_conversion 1 2 -1 roll
1561: { %% for body
1562: (universalNumber) data_conversion /i set
1563: Helplist [i ] Get
1564: /item set
1565: item [(0).. ] Get
1566: key eq
1567: %% if-condition
1568: { %%ifbody
1569: this [ %% function args
1570: item [(1).. ] Get
1571: ] {IsArray} sendmsg2
1572: %% if-condition
1573: { %%ifbody
1574: item [(1).. ] Get
1575: /item1 set
1576: this [ %% function args
1577: item1 ] {Length} sendmsg2
1578: /m set
1579: (0).. /j set
1580: %%for init.
1581: %%for
1582: { j m lt
1583: { } {exit} ifelse
1584: [ {%%increment
1585: /j j (1).. add def
1586: } %%end of increment{A}
1587: {%%start of B part{B}
1588: this [ %% function args
1589: item1 [j ] Get
1590: ] {Println} sendmsg2
1591: } %% end of B part. {B}
1592: 2 1 roll] {exec} map pop
1593: } loop %%end of for
1594: }%%end if if body
1595: { %%if- else part
1596: this [ %% function args
1597: item [(1).. ] Get
1598: ] {Println} sendmsg2
1599: } ifelse
1600: item /FunctionValue set {/ExitPoint goto} exec %%return
1601: }%%end if if body
1602: { %%if- else part
1603: } ifelse
1604: } for
1605: this [ %% function args
1606: (The key word <<) ] {Print} sendmsg2
1607: this [ %% function args
1608: key ] {Print} sendmsg2
1609: this [ %% function args
1610: (>> could not be found.) ] {Println} sendmsg2
1611: [ ] /FunctionValue set {/ExitPoint goto} exec %%return
1612: /ExitPoint ]pop popVariables %%pop the local variables
1613: /ExitPoint ]pop popVariables %%pop argValues
1614: db.DebugStack setstack pop stdstack
1615: FunctionValue } def
1616: %%end of function
1617:
1618: /ShowKeyWords {
1619: db.DebugStack setstack $In function : ShowKeyWords of class PrimitiveObject$ stdstack
1620: /Arglist set /Argthis set /FunctionValue [ ] def
1621: [/this /ss ] /ArgNames set ArgNames pushVariables [ %%function body
1622: [Argthis] Arglist join ArgNames mapset
1623: [ %%start of local variables
1624: /i /j /n /keys /max /width /m /k /kk /tmp0 ] pushVariables [ %%local variables
1625: this [ %% function args
1626: ] {Ln} sendmsg2
1627: this [ %% function args
1628: Helplist ] {Length} sendmsg2
1629: /n set
1630: [ ( ) ] /keys set
1631: (0).. %%PSfor initvalue.
1632: (integer) data_conversion
1633: n (1).. sub (integer) data_conversion 1 2 -1 roll
1634: { %% for body
1635: (universalNumber) data_conversion /i set
1636: this [ %% function args
1637: keys Helplist [i (0).. ] Get
1638: ] {Append} sendmsg2
1639: /keys set
1640: } for
1641: keys shell /keys set
1642: this [ %% function args
1643: keys ] {Length} sendmsg2
1644: /n set
1645: ss (ALL) eq
1646: %% if-condition
1647: { %%ifbody
1648: (1).. %%PSfor initvalue.
1649: (integer) data_conversion
1650: n (1).. sub (integer) data_conversion 1 2 -1 roll
1651: { %% for body
1652: (universalNumber) data_conversion /i set
1653: this [ %% function args
1654: (# ) ] {Print} sendmsg2
1655: this [ %% function args
1656: keys [i ] Get
1657: ] {Print} sendmsg2
1658: this [ %% function args
1659: ] {Ln} sendmsg2
1660: this [ %% function args
1661: keys [i ] Get
1662: ] {Help} sendmsg2
1663: this [ %% function args
1664: ] {Ln} sendmsg2
1665: } for
1666: (0).. /FunctionValue set {/ExitPoint goto} exec %%return
1667: }%%end if if body
1668: { %%if- else part
1669: } ifelse
1670: (0).. /max set
1671: (1).. %%PSfor initvalue.
1672: (integer) data_conversion
1673: n (1).. sub (integer) data_conversion 1 2 -1 roll
1674: { %% for body
1675: (universalNumber) data_conversion /i set
1676: this [ %% function args
1677: keys [i ] Get
1678: ] {Length} sendmsg2
1679: max gt
1680: %% if-condition
1681: { %%ifbody
1682: this [ %% function args
1683: keys [i ] Get
1684: ] {Length} sendmsg2
1685: /max set
1686: }%%end if if body
1687: { %%if- else part
1688: } ifelse
1689: } for
1690: max (3).. {add} sendmsg2
1691: /max set
1692: (80).. /width set
1693: (0).. /m set
1694:
1695: %%while
1696: { m max {mul} sendmsg2
1697: (80).. lt
1698: { } {exit} ifelse
1699: m (1).. {add} sendmsg2
1700: /m set
1701: } loop
1702: m (1).. gt
1703: %% if-condition
1704: { %%ifbody
1705: m (1).. {sub} sendmsg2
1706: /m set
1707: }%%end if if body
1708: { %%if- else part
1709: } ifelse
1710: (0).. /k set
1711: (0).. /kk set
1712: (1).. %%PSfor initvalue.
1713: (integer) data_conversion
1714: n (1).. sub (integer) data_conversion 1 2 -1 roll
1715: { %% for body
1716: (universalNumber) data_conversion /i set
1717: this [ %% function args
1718: keys [i ] Get
1719: ] {Print} sendmsg2
1720: kk (1).. {add} sendmsg2
1721: /kk set
1722: k this [ %% function args
1723: keys [i ] Get
1724: ] {Length} sendmsg2
1725: {add} sendmsg2
1726: /k set
1727: max this [ %% function args
1728: keys [i ] Get
1729: ] {Length} sendmsg2
1730: {sub} sendmsg2
1731: /tmp0 set
1732: k tmp0 {add} sendmsg2
1733: /k set
1734: kk m lt
1735: %% if-condition
1736: { %%ifbody
1737: [ 0 1 tmp0 (integer) dc 1 sub { pop $ $ } for ] aload length cat_n messagen }%%end if if body
1738: { %%if- else part
1739: } ifelse
1740: kk m greaterThanOrEqual
1741: %% if-condition
1742: { %%ifbody
1743: (0).. /kk set
1744: (0).. /k set
1745: this [ %% function args
1746: ] {Ln} sendmsg2
1747: }%%end if if body
1748: { %%if- else part
1749: } ifelse
1750: } for
1751: this [ %% function args
1752: ] {Ln} sendmsg2
1753: this [ %% function args
1754: (Type in Help(keyword); to see a help message (string keyword).) ] {Println} sendmsg2
1755: /ExitPoint ]pop popVariables %%pop the local variables
1756: /ExitPoint ]pop popVariables %%pop argValues
1757: db.DebugStack setstack pop stdstack
1758: FunctionValue } def
1759: %%end of function
1760:
1761: /ShowKeyWordsOfSm1 {
1762: db.DebugStack setstack $In function : ShowKeyWordsOfSm1 of class PrimitiveObject$ stdstack
1763: /Arglist set /Argthis set /FunctionValue [ ] def
1764: [/this /ss ] /ArgNames set ArgNames pushVariables [ %%function body
1765: [Argthis] Arglist join ArgNames mapset
1766: [ %%start of local variables
1767: /i /j /n /keys /max /width /m /k /kk /tmp0 ] pushVariables [ %%local variables
1768: this [ %% function args
1769: ] {Ln} sendmsg2
1770: /help_Sm1Macro @.usages def this [ %% function args
1771: help_Sm1Macro ] {Length} sendmsg2
1772: /n set
1773: [ ( ) ] /keys set
1774: (0).. /i set
1775: %%for init.
1776: %%for
1777: { i n lt
1778: { } {exit} ifelse
1779: [ {%%increment
1780: /i i (1).. add def
1781: } %%end of increment{A}
1782: {%%start of B part{B}
1783: this [ %% function args
1784: keys help_Sm1Macro [i (0).. ] Get
1785: ] {Append} sendmsg2
1786: /keys set
1787: } %% end of B part. {B}
1788: 2 1 roll] {exec} map pop
1789: } loop %%end of for
1790: keys shell /keys set
1791: this [ %% function args
1792: keys ] {Length} sendmsg2
1793: /n set
1794: ss (ALL) eq
1795: %% if-condition
1796: { %%ifbody
1797: (1).. /i set
1798: %%for init.
1799: %%for
1800: { i n lt
1801: { } {exit} ifelse
1802: [ {%%increment
1803: /i i (1).. add def
1804: } %%end of increment{A}
1805: {%%start of B part{B}
1806: keys [i ] Get
1807: /tmp0 set
1808: this [ %% function args
1809: (# ) ] {Print} sendmsg2
1810: this [ %% function args
1811: tmp0 ] {Print} sendmsg2
1812: this [ %% function args
1813: ] {Ln} sendmsg2
1814: tmp0 usage this [ %% function args
1815: ] {Ln} sendmsg2
1816: } %% end of B part. {B}
1817: 2 1 roll] {exec} map pop
1818: } loop %%end of for
1819: (0).. /FunctionValue set {/ExitPoint goto} exec %%return
1820: }%%end if if body
1821: { %%if- else part
1822: } ifelse
1823: (0).. /max set
1824: (1).. /i set
1825: %%for init.
1826: %%for
1827: { i n lt
1828: { } {exit} ifelse
1829: [ {%%increment
1830: /i i (1).. add def
1831: } %%end of increment{A}
1832: {%%start of B part{B}
1833: this [ %% function args
1834: keys [i ] Get
1835: ] {Length} sendmsg2
1836: max gt
1837: %% if-condition
1838: { %%ifbody
1839: this [ %% function args
1840: keys [i ] Get
1841: ] {Length} sendmsg2
1842: /max set
1843: }%%end if if body
1844: { %%if- else part
1845: } ifelse
1846: } %% end of B part. {B}
1847: 2 1 roll] {exec} map pop
1848: } loop %%end of for
1849: max (3).. {add} sendmsg2
1850: /max set
1851: (80).. /width set
1852: (0).. /m set
1853:
1854: %%while
1855: { m max {mul} sendmsg2
1856: (80).. lt
1857: { } {exit} ifelse
1858: m (1).. {add} sendmsg2
1859: /m set
1860: } loop
1861: (0).. /k set
1862: (0).. /kk set
1863: (1).. /i set
1864: %%for init.
1865: %%for
1866: { i n lt
1867: { } {exit} ifelse
1868: [ {%%increment
1869: /i i (1).. add def
1870: } %%end of increment{A}
1871: {%%start of B part{B}
1872: this [ %% function args
1873: keys [i ] Get
1874: ] {Print} sendmsg2
1875: kk (1).. {add} sendmsg2
1876: /kk set
1877: k this [ %% function args
1878: keys [i ] Get
1879: ] {Length} sendmsg2
1880: {add} sendmsg2
1881: /k set
1882: max this [ %% function args
1883: keys [i ] Get
1884: ] {Length} sendmsg2
1885: {sub} sendmsg2
1886: /tmp0 set
1887: kk m greaterThanOrEqual
1888: %% if-condition
1889: { %%ifbody
1890: }%%end if if body
1891: { %%if- else part
1892: (0).. /j set
1893: %%for init.
1894: %%for
1895: { j tmp0 lt
1896: { } {exit} ifelse
1897: [ {%%increment
1898: /j j (1).. add def
1899: } %%end of increment{A}
1900: {%%start of B part{B}
1901: k (1).. {add} sendmsg2
1902: /k set
1903: this [ %% function args
1904: ( ) ] {Print} sendmsg2
1905: } %% end of B part. {B}
1906: 2 1 roll] {exec} map pop
1907: } loop %%end of for
1908: } ifelse
1909: kk m greaterThanOrEqual
1910: %% if-condition
1911: { %%ifbody
1912: (0).. /kk set
1913: (0).. /k set
1914: this [ %% function args
1915: ] {Ln} sendmsg2
1916: }%%end if if body
1917: { %%if- else part
1918: } ifelse
1919: } %% end of B part. {B}
1920: 2 1 roll] {exec} map pop
1921: } loop %%end of for
1922: this [ %% function args
1923: ] {Ln} sendmsg2
1924: this [ %% function args
1925: ] {Ln} sendmsg2
1926: this [ %% function args
1927: (Type in (keyword) usage ; to see a help message.) ] {Println} sendmsg2
1928: /ExitPoint ]pop popVariables %%pop the local variables
1929: /ExitPoint ]pop popVariables %%pop argValues
1930: db.DebugStack setstack pop stdstack
1931: FunctionValue } def
1932: %%end of function
1933:
1934: this [ %% function args
1935: [ (Help) (Help(key) shows an explanation on the key (string key).) ] ] {HelpAdd} sendmsg2
1936: this [ %% function args
1937: [ (HelpAdd) [ (HelpAdd([key,explanation]) (string key, string explanation)) ( or (string key, array explanation).) ] ] ] {HelpAdd} sendmsg2
1938: this [ %% function args
1939: [ (load) [ (load(fname) loads the file << fname >>(string fname).) (load fname loads the file << fname >>.) (load[fname] loads the file << fname >> with the preprocessing by /lib/cpp.) ] ] ] {HelpAdd} sendmsg2
1940: this [ %% function args
1941: [ (Ln) (Ln() newline.) ] ] {HelpAdd} sendmsg2
1942: this [ %% function args
1943: [ (Println) (Println(f) prints f and goes to the new line.) ] ] {HelpAdd} sendmsg2
1944: this [ %% function args
1945: [ (Print) (Print(f) prints f.) ] ] {HelpAdd} sendmsg2
1946: this [ %% function args
1947: [ (Poly) (Poly(name) returns the polynomial name in the current ring
1948: (string name).) ] ] {HelpAdd} sendmsg2
1949: this [ %% function args
1950: [ (PolyR) (PolyR(name,r) returns the polynomial name in the ring r
1951: (string name, ring r).
1952: Ex. r = RingD("x,y"); y = PolyR("y",r); ) ] ] {HelpAdd} sendmsg2
1953: this [ %% function args
1954: [ (RingD) [ (RingD(names) defines a new ring (string names).) (RingD(names,weight_vector) defines a new ring with the weight vector) ((string names, array weight_vector).) (RingD(names,weight_vector,characteristic)) ( Ex. RingD("x,y",[["x",2,"y",1]]) ) ] ] ] {HelpAdd} sendmsg2
1955: this [ %% function args
1956: [ (Reduction) (Reduction(f,G) returns the remainder and sygygies when
1957: f is devided by G (polynomial f, array G).) ] ] {HelpAdd} sendmsg2
1958: this [ %% function args
1959: [ (AddString) (AddString(list) returns the concatnated string (array list).) ] ] {HelpAdd} sendmsg2
1960: this [ %% function args
1961: [ (AsciiToString) (AsciiToString(ascii_code) returns the string of which
1962: ascii code is ascii_code (integer ascii_code).) ] ] {HelpAdd} sendmsg2
1963: this [ %% function args
1964: [ (ToString) (ToString(obj) transforms the <<obj>> to a string.) ] ] {HelpAdd} sendmsg2
1965: this [ %% function args
1966: [ (Numerator) (Numerator(f) returns the numerator of <<f>> (rational f).) ] ] {HelpAdd} sendmsg2
1967: this [ %% function args
1968: [ (Denominator) (Denominator(f) returns the denominator of <<f>> (rational f).) ] ] {HelpAdd} sendmsg2
1969: this [ %% function args
1970: [ (Replace) (Replace(f,rule) (polynomial f, array rule).
1971: Ex. Replace( (x+y)^3, [[x,Poly("1")]])) ] ] {HelpAdd} sendmsg2
1972: this [ %% function args
1973: [ (SetRingVariables) (SetRingVariables()
1974: Set the generators of the current ring as global variables.
1975: cf. RingD(), Poly(), PolyR()) ] ] {HelpAdd} sendmsg2
1976: this [ %% function args
1977: [ (Append) (Append([f1,...,fn],g) returns the list [f1,...,fn,g]) ] ] {HelpAdd} sendmsg2
1978: this [ %% function args
1979: [ (Join) (Join([f1,...,fn],[g1,...,gm]) returns the list
1980: [f1,...,fn,g1,...,gm]) ] ] {HelpAdd} sendmsg2
1981: this [ %% function args
1982: [ (Indexed) (Indexed(name,i) returns the string name[i]
1983: (string name, integer i)) ] ] {HelpAdd} sendmsg2
1984: this [ %% function args
1985: [ (-ReservedName1) [ (The names k00*, K00*, sm1* , arg1,arg2,arg3,arg4,....,) (Helplist, Arglist, FunctionValue,) (@@@*, db.*, k.*, tmp002*, tmp00* are used for system functions.) ] ] ] {HelpAdd} sendmsg2
1986: this [ %% function args
1987: [ (IntegerToSm1Integer) (IntegerToSm1Integer(i) translates integer i
1988: to sm1.integer (integer i).) ] ] {HelpAdd} sendmsg2
1989: this [ %% function args
1990: [ (true) (true returns sm1.integer 1.) ] ] {HelpAdd} sendmsg2
1991: this [ %% function args
1992: [ (false) (false returns sm1.integer 0.) ] ] {HelpAdd} sendmsg2
1993: this [ %% function args
1994: [ (IsArray) [ (If f is the array object, then IsArray(f) returns true,) (else IsArray(f) returns false.) ] ] ] {HelpAdd} sendmsg2
1995: this [ %% function args
1996: [ (Init_w) [ (Init_w(f,vars,w) returns the initial terms with respect to the) (weight vector <<w>> (array of integer) of the polynomial <<f>>) ((polynomial). Here, <<f>> is regarded as a polynomial with respect) (to the variables <<vars>> (array of polynomials).) (Example: Init_w(x^2+y^2+x,[x,y],[1,1]):) ] ] ] {HelpAdd} sendmsg2
1997: this [ %% function args
1998: [ (RingDonIndexedVariables) [ (RingDonIndexedVariables(name,n) defines and returns the ring of) (homogenized differential operators) (Q<h, name[0], ..., name[n-1], Dname[0], ..., Dname[n-1]>) (where <<name>> is a string and <<n>> is an integer.) (Note that this function defines global variables) (h, name[0], ..., name[n-1], Dname[0], ..., Dname[n-1].) (Example: RingDonIndexedVariables("x",3).) (RingDonIndexedVariables(name,n,w) defines and returns the ring of) (homogenized differential operators with the ordering defined by ) (the weight vector <<w>> (array)) (Example: RingDonIndexedVariables("x",3,[["x[0]",1,"x[2]",3]]).) ] ] ] {HelpAdd} sendmsg2
1999: this [ %% function args
2000: [ (Groebner) [ (Groebner(input) returns Groebner basis of the left module (or ideal)) (defined by <<input>> (array of polynomials)) (The order is that of the ring to which each element of <<input>>) (belongs.) (The input is automatically homogenized.) (Example: RingD("x,y",[["x" 10 "y" 1]]);) ( Groebner([Poly(" x^2+y^2-4"),Poly(" x*y-1 ")]):) (cf. RingD, Homogenize) ] ] ] {HelpAdd} sendmsg2
2001: this [ %% function args
2002: [ (RingPoly) [ (RingPoly(names) defines a Ring of Polyomials (string names).) (The names of variables of that ring are <<names>> and ) (the homogenization variable h.) (cf. SetRingVariables, RingD) (Example: R=RingPoly("x,y");) ( ) (RingPoly(names,weight_vector) defines a Ring of Polynomials) (with the order defined by the << weight_vector >>) ((string names, array of array weight_vector).) (RingPoly(names,weight_vector,characteristic)) (Example: R=RingPoly("x,y",[["x",10,"y",1]]);) ( (x+y)^10: ) ] ] ] {HelpAdd} sendmsg2
2003: this [ %% function args
2004: [ (CancelNumber) [ (CancelNumber(rn) reduces the rational number <<rn>>) ((rational rn).) (Example: CancelNumber( 2/6 ) : ) ] ] ] {HelpAdd} sendmsg2
2005: this [ %% function args
2006: [ (IsString) [ (IsString(obj) returns true if << obj >> is a string (object obj).) (Example: if (IsString("abc")) Println("Hello"); ;) ] ] ] {HelpAdd} sendmsg2
2007: this [ %% function args
2008: [ (IsSm1Integer) [ (IsSm1Integer(obj) returns true if << obj >> is an integer of sm1(object obj).) ] ] ] {HelpAdd} sendmsg2
2009: this [ %% function args
2010: [ (sm1) [ (sm1(arg1,arg2,...) is used to embed sm1 native code in the kxx program.) (Example: sm1( 2, 2, " add print "); ) (Example: def myadd(a,b) { sm1(a,b," add /FunctionValue set "); }) ] ] ] {HelpAdd} sendmsg2
2011: this [ %% function args
2012: [ (DC) [ (DC(obj,key) converts << obj >> to a new object in the primitive) (class << key >> (object obj, string key)) (Example: DC(" (x+1)^10 ", "polynomial"): ) ] ] ] {HelpAdd} sendmsg2
2013: this [ %% function args
2014: [ (Length) [ (Length(vec) returns the length of the array << vec >>) ((array vec)) ] ] ] {HelpAdd} sendmsg2
2015: this [ %% function args
2016: [ (Transpose) [ (Transpose(m) return the transpose of the matrix << m >>) ((array of array m).) ] ] ] {HelpAdd} sendmsg2
2017: this [ %% function args
2018: [ (Save) [ (Save(obj) appends << obj >> to the file sm1out.txt (object obj).) ] ] ] {HelpAdd} sendmsg2
2019: this [ %% function args
2020: [ (Coefficients) [ (Coefficients(f,v) returns [exponents, coefficients] of << f >>) (with respect to the variable << v >>) ((polynomial f,v).) (Example: Coefficients(Poly("(x+1)^2"),Poly("x")): ) ] ] ] {HelpAdd} sendmsg2
2021: this [ %% function args
2022: [ (System) [ (System(comm) executes the unix system command << comm >>) ((string comm)) (Example: System("ls");) ] ] ] {HelpAdd} sendmsg2
2023: this [ %% function args
2024: [ (Exponent) [ (Expoent(f,vars) returns the vector of exponents of the polynomial f) (Ex. Exponent( x^2*y-1,[x,y])) ] ] ] {HelpAdd} sendmsg2
2025: this [ %% function args
2026: [ (Protect) [ (Protect(name) protects the symbol <<name>> (string)) (Protect(name,level) protects the symbol <<name>> (string) with ) (<<level>> ) ] ] ] {HelpAdd} sendmsg2
2027: this [ %% function args
2028: [ (IsPolynomial) [ (IsPolynomial(f) returns true if <<f>> (object) is a polynomial.) ] ] ] {HelpAdd} sendmsg2
2029: /RingPoly {
2030: db.DebugStack setstack $In function : RingPoly of class PrimitiveObject$ stdstack
2031: /Arglist set /Argthis set /FunctionValue [ ] def
2032: [/this /vList /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body
2033: [Argthis] Arglist join ArgNames mapset
2034: [ %%start of local variables
2035: /new0 /tmp /size /n /i /j /newtmp /ringpp /argsize ] pushVariables [ %%local variables
2036: this [ %% function args
2037: Arglist ] {Length} sendmsg2
2038: /argsize set
2039: argsize (1).. eq
2040: %% if-condition
2041: { %%ifbody
2042: [ vList ring_of_polynomials ( ) elimination_order 0 ] define_ring
2043: /tmp set tmp /FunctionValue set {/ExitPoint goto} exec %%return
2044: }%%end if if body
2045: { %%if- else part
2046: } ifelse
2047: argsize (2).. eq
2048: %% if-condition
2049: { %%ifbody
2050: (0).. /pp set
2051: }%%end if if body
2052: { %%if- else part
2053: } ifelse
2054: this [ %% function args
2055: pp ] {IntegerToSm1Integer} sendmsg2
2056: /pp set
2057: this [ %% function args
2058: weightMatrix ] {Length} sendmsg2
2059: /size set
2060: this [ %% function args
2061: size ] {NewVector} sendmsg2
2062: /new0 set
2063: /@@@.indexMode.flag.save @@@.indexMode.flag def 0 @@@.indexMode (0).. /i set
2064: %%for init.
2065: %%for
2066: { i size lt
2067: { } {exit} ifelse
2068: [ {%%increment
2069: /i i (1).. add def
2070: } %%end of increment{A}
2071: {%%start of B part{B}
2072: weightMatrix [i ] Get
2073: /tmp set
2074: this [ %% function args
2075: tmp ] {Length} sendmsg2
2076: /n set
2077: this [ %% function args
2078: n ] {NewVector} sendmsg2
2079: /newtmp set
2080: (1).. /j set
2081: %%for init.
2082: %%for
2083: { j n lt
2084: { } {exit} ifelse
2085: [ {%%increment
2086: j (2).. {add} sendmsg2
2087: /j set
2088: } %%end of increment{A}
2089: {%%start of B part{B}
2090: newtmp [j (1).. {sub} sendmsg2
2091: ] tmp [j (1).. {sub} sendmsg2
2092: ] Get
2093: Put
2094: newtmp [j ] this [ %% function args
2095: tmp [j ] Get
2096: ] {IntegerToSm1Integer} sendmsg2
2097: Put
2098: } %% end of B part. {B}
2099: 2 1 roll] {exec} map pop
2100: } loop %%end of for
2101: new0 [i ] newtmp Put
2102: } %% end of B part. {B}
2103: 2 1 roll] {exec} map pop
2104: } loop %%end of for
2105: [ vList ring_of_polynomials new0 weight_vector pp ] define_ring /ringpp set
2106: @@@.indexMode.flag.save @@@.indexMode ringpp /FunctionValue set {/ExitPoint goto} exec %%return
2107: /ExitPoint ]pop popVariables %%pop the local variables
2108: /ExitPoint ]pop popVariables %%pop argValues
2109: db.DebugStack setstack pop stdstack
2110: FunctionValue } def
2111: %%end of function
2112:
2113: /IsString {
2114: db.DebugStack setstack $In function : IsString of class PrimitiveObject$ stdstack
2115: /Arglist set /Argthis set /FunctionValue [ ] def
2116: [/this /ob ] /ArgNames set ArgNames pushVariables [ %%function body
2117: [Argthis] Arglist join ArgNames mapset
2118: ob isString /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2119: db.DebugStack setstack pop stdstack
2120: FunctionValue } def
2121: %%end of function
2122:
2123: /IsSm1Integer {
2124: db.DebugStack setstack $In function : IsSm1Integer of class PrimitiveObject$ stdstack
2125: /Arglist set /Argthis set /FunctionValue [ ] def
2126: [/this /ob ] /ArgNames set ArgNames pushVariables [ %%function body
2127: [Argthis] Arglist join ArgNames mapset
2128: ob isInteger /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2129: db.DebugStack setstack pop stdstack
2130: FunctionValue } def
2131: %%end of function
2132:
2133: /CancelNumber {
2134: db.DebugStack setstack $In function : CancelNumber of class PrimitiveObject$ stdstack
2135: /Arglist set /Argthis set /FunctionValue [ ] def
2136: [/this /rn ] /ArgNames set ArgNames pushVariables [ %%function body
2137: [Argthis] Arglist join ArgNames mapset
2138: [ %%start of local variables
2139: /tmp ] pushVariables [ %%local variables
2140: [(cancel) rn ] mpzext /tmp set this [ %% function args
2141: tmp ] {IsInteger} sendmsg2
2142: %% if-condition
2143: { %%ifbody
2144: tmp /FunctionValue set {/ExitPoint goto} exec %%return
2145: }%%end if if body
2146: { %%if- else part
2147: } ifelse
2148: tmp (denominator) dc (1).. eq { /FunctionValue tmp (numerator) dc def} { /FunctionValue tmp def } ifelse /ExitPoint ]pop popVariables %%pop the local variables
2149: /ExitPoint ]pop popVariables %%pop argValues
2150: db.DebugStack setstack pop stdstack
2151: FunctionValue } def
2152: %%end of function
2153:
2154: /DC {
2155: db.DebugStack setstack $In function : DC of class PrimitiveObject$ stdstack
2156: /Arglist set /Argthis set /FunctionValue [ ] def
2157: [/this /obj /key ] /ArgNames set ArgNames pushVariables [ %%function body
2158: [Argthis] Arglist join ArgNames mapset
2159: key (string) eq
2160: %% if-condition
2161: { %%ifbody
2162: this [ %% function args
2163: obj ] {ToString} sendmsg2
2164: /FunctionValue set {/ExitPoint goto} exec %%return
2165: }%%end if if body
2166: { %%if- else part
2167: key (integer) eq
2168: %% if-condition
2169: { %%ifbody
2170: (universalNumber) /key set
2171: }%%end if if body
2172: { %%if- else part
2173: key (sm1integer) eq
2174: %% if-condition
2175: { %%ifbody
2176: (integer) /key set
2177: }%%end if if body
2178: { %%if- else part
2179: key (polynomial) eq
2180: %% if-condition
2181: { %%ifbody
2182: (poly) /key set
2183: }%%end if if body
2184: { %%if- else part
2185: } ifelse
2186: } ifelse
2187: } ifelse
2188: } ifelse
2189: obj key data_conversion /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2190: db.DebugStack setstack pop stdstack
2191: FunctionValue } def
2192: %%end of function
2193:
2194: /Transpose {
2195: db.DebugStack setstack $In function : Transpose of class PrimitiveObject$ stdstack
2196: /Arglist set /Argthis set /FunctionValue [ ] def
2197: [/this /m ] /ArgNames set ArgNames pushVariables [ %%function body
2198: [Argthis] Arglist join ArgNames mapset
2199: m transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2200: db.DebugStack setstack pop stdstack
2201: FunctionValue } def
2202: %%end of function
2203:
2204: /Save {
2205: db.DebugStack setstack $In function : Save of class PrimitiveObject$ stdstack
2206: /Arglist set /Argthis set /FunctionValue [ ] def
2207: [/this /obj ] /ArgNames set ArgNames pushVariables [ %%function body
2208: [Argthis] Arglist join ArgNames mapset
2209: obj output /ExitPoint ]pop popVariables %%pop argValues
2210: db.DebugStack setstack pop stdstack
2211: FunctionValue } def
2212: %%end of function
2213:
2214: /System {
2215: db.DebugStack setstack $In function : System of class PrimitiveObject$ stdstack
2216: /Arglist set /Argthis set /FunctionValue [ ] def
2217: [/this /comm ] /ArgNames set ArgNames pushVariables [ %%function body
2218: [Argthis] Arglist join ArgNames mapset
2219: comm system /ExitPoint ]pop popVariables %%pop argValues
2220: db.DebugStack setstack pop stdstack
2221: } def
2222: %%end of function
2223:
2224: /IsReducible {
2225: db.DebugStack setstack $In function : IsReducible of class PrimitiveObject$ stdstack
2226: /Arglist set /Argthis set /FunctionValue [ ] def
2227: [/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body
2228: [Argthis] Arglist join ArgNames mapset
2229: [ (isReducible) f g ] gbext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2230: db.DebugStack setstack pop stdstack
2231: FunctionValue } def
2232: %%end of function
2233:
2234: /IsPolynomial {
2235: db.DebugStack setstack $In function : IsPolynomial of class PrimitiveObject$ stdstack
2236: /Arglist set /Argthis set /FunctionValue [ ] def
2237: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
2238: [Argthis] Arglist join ArgNames mapset
2239: f isPolynomial /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2240: db.DebugStack setstack pop stdstack
2241: FunctionValue } def
2242: %%end of function
2243:
2244: /k00.toric0.mydegree {2 1 roll degree} def /Exponent {
2245: db.DebugStack setstack $In function : Exponent of class PrimitiveObject$ stdstack
2246: /Arglist set /Argthis set /FunctionValue [ ] def
2247: [/this /f /vars ] /ArgNames set ArgNames pushVariables [ %%function body
2248: [Argthis] Arglist join ArgNames mapset
2249: [ %%start of local variables
2250: /n /i /ans ] pushVariables [ %%local variables
2251: f this [ %% function args
2252: (0) ] {Poly} sendmsg2
2253: eq
2254: %% if-condition
2255: { %%ifbody
2256: [ ] /FunctionValue set {/ExitPoint goto} exec %%return
2257: }%%end if if body
2258: { %%if- else part
2259: } ifelse
2260: f /ff.tmp set vars {ff.tmp k00.toric0.mydegree (universalNumber) dc }map /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables
2261: /ExitPoint ]pop popVariables %%pop argValues
2262: db.DebugStack setstack pop stdstack
2263: FunctionValue } def
2264: %%end of function
2265:
2266: /Protect {
2267: db.DebugStack setstack $In function : Protect of class PrimitiveObject$ stdstack
2268: /Arglist set /Argthis set /FunctionValue [ ] def
2269: [/this /name /level ] /ArgNames set ArgNames pushVariables [ %%function body
2270: [Argthis] Arglist join ArgNames mapset
2271: [ %%start of local variables
2272: /n /str ] pushVariables [ %%local variables
2273: this [ %% function args
2274: Arglist ] {Length} sendmsg2
2275: /n set
2276: n (1).. eq
2277: %% if-condition
2278: { %%ifbody
2279: (1).. /level set
2280: this [ %% function args
2281: [ ([(chattr) ) this [ %% function args
2282: level ] {ToString} sendmsg2
2283: ( /) name ( ) ( ] extension pop ) ] ] {AddString} sendmsg2
2284: /str set
2285: [(parse) str ] extension pop }%%end if if body
2286: { %%if- else part
2287: n (2).. eq
2288: %% if-condition
2289: { %%ifbody
2290: this [ %% function args
2291: [ ([(chattr) ) this [ %% function args
2292: level ] {ToString} sendmsg2
2293: ( /) name ( ) ( ] extension pop ) ] ] {AddString} sendmsg2
2294: /str set
2295: [(parse) str ] extension pop }%%end if if body
2296: { %%if- else part
2297: this [ %% function args
2298: (Protect) (Arguments must be one or two. ) ] {k00_error} sendmsg2
2299: error } ifelse
2300: } ifelse
2301: /ExitPoint ]pop popVariables %%pop the local variables
2302: /ExitPoint ]pop popVariables %%pop argValues
2303: db.DebugStack setstack pop stdstack
2304: } def
2305: %%end of function
2306:
2307: /k00_error {
2308: db.DebugStack setstack $In function : k00_error of class PrimitiveObject$ stdstack
2309: /Arglist set /Argthis set /FunctionValue [ ] def
2310: [/this /name /msg ] /ArgNames set ArgNames pushVariables [ %%function body
2311: [Argthis] Arglist join ArgNames mapset
2312: this [ %% function args
2313: (Error in ) ] {Print} sendmsg2
2314: this [ %% function args
2315: name ] {Print} sendmsg2
2316: this [ %% function args
2317: (. ) ] {Print} sendmsg2
2318: this [ %% function args
2319: msg ] {Println} sendmsg2
2320: /ExitPoint ]pop popVariables %%pop argValues
2321: db.DebugStack setstack pop stdstack
2322: } def
2323: %%end of function
2324:
2325: /Init {
2326: db.DebugStack setstack $In function : Init of class PrimitiveObject$ stdstack
2327: /Arglist set /Argthis set /FunctionValue [ ] def
2328: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
2329: [Argthis] Arglist join ArgNames mapset
2330: this [ %% function args
2331: f ] {IsArray} sendmsg2
2332: %% if-condition
2333: { %%ifbody
2334: this [ %% function args
2335: f (Init) ] {Map} sendmsg2
2336: /FunctionValue set {/ExitPoint goto} exec %%return
2337: }%%end if if body
2338: { %%if- else part
2339: this [ %% function args
2340: f ] {IsPolynomial} sendmsg2
2341: %% if-condition
2342: { %%ifbody
2343: f init /FunctionValue set }%%end if if body
2344: { %%if- else part
2345: this [ %% function args
2346: (Init) (Argment must be polynomial or an array of polynomials) ] {k00_error} sendmsg2
2347: error } ifelse
2348: } ifelse
2349: /ExitPoint ]pop popVariables %%pop argValues
2350: db.DebugStack setstack pop stdstack
2351: FunctionValue } def
2352: %%end of function
2353:
2354: this [ %% function args
2355: [ (Init) [ (Init(f) returns the initial term of the polynomial <<f>> (polynomial)) (Init(list) returns the array of initial terms of the array of polynomials) (<< list >> (array)) ] ] ] {HelpAdd} sendmsg2
2356: this [ %% function args
2357: [ (NewMatrix) [ (NewMatrix(m,n) returns the (m,n)-matrix (array) with the entries 0.) ] ] ] {HelpAdd} sendmsg2
2358: /Eliminatev {
2359: db.DebugStack setstack $In function : Eliminatev of class PrimitiveObject$ stdstack
2360: /Arglist set /Argthis set /FunctionValue [ ] def
2361: [/this /list /var ] /ArgNames set ArgNames pushVariables [ %%function body
2362: [Argthis] Arglist join ArgNames mapset
2363: list var eliminatev /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2364: db.DebugStack setstack pop stdstack
2365: FunctionValue } def
2366: %%end of function
2367:
2368: this [ %% function args
2369: [ (Eliminatev) [ (Eliminatev(list,var) prunes polynomials in << list >>(array of polynomials)) (which contains the variables in << var >> ( array of strings )) (Example: Eliminatev([Poly(" x+h "),Poly(" x ")],[ "h" ]): ) ] ] ] {HelpAdd} sendmsg2
2370: /ReducedBase {
2371: db.DebugStack setstack $In function : ReducedBase of class PrimitiveObject$ stdstack
2372: /Arglist set /Argthis set /FunctionValue [ ] def
2373: [/this /base ] /ArgNames set ArgNames pushVariables [ %%function body
2374: [Argthis] Arglist join ArgNames mapset
2375: base reducedBase /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2376: db.DebugStack setstack pop stdstack
2377: FunctionValue } def
2378: %%end of function
2379:
2380: this [ %% function args
2381: [ (ReducedBase) [ (ReducedBase[base] prunes redundant elements in the Grobner basis <<base>> (array).) ] ] ] {HelpAdd} sendmsg2
2382: /IndexedVariables {
2383: db.DebugStack setstack $In function : IndexedVariables of class PrimitiveObject$ stdstack
2384: /Arglist set /Argthis set /FunctionValue [ ] def
2385: [/this /name /size ] /ArgNames set ArgNames pushVariables [ %%function body
2386: [Argthis] Arglist join ArgNames mapset
2387: [ %%start of local variables
2388: /result /i /result2 ] pushVariables [ %%local variables
2389: [ ] /result set
2390: (0).. /i set
2391: %%for init.
2392: %%for
2393: { i size (1).. {sub} sendmsg2
2394: lt
2395: { } {exit} ifelse
2396: [ {%%increment
2397: /i i (1).. add def
2398: } %%end of increment{A}
2399: {%%start of B part{B}
2400: this [ %% function args
2401: result this [ %% function args
2402: name i ] {Indexed} sendmsg2
2403: ] {Append} sendmsg2
2404: /result set
2405: this [ %% function args
2406: result (,) ] {Append} sendmsg2
2407: /result set
2408: } %% end of B part. {B}
2409: 2 1 roll] {exec} map pop
2410: } loop %%end of for
2411: size (1).. {sub} sendmsg2
2412: (0).. greaterThanOrEqual
2413: %% if-condition
2414: { %%ifbody
2415: this [ %% function args
2416: result this [ %% function args
2417: name size (1).. {sub} sendmsg2
2418: ] {Indexed} sendmsg2
2419: ] {Append} sendmsg2
2420: /result set
2421: }%%end if if body
2422: { %%if- else part
2423: } ifelse
2424: this [ %% function args
2425: [ ({) ] result ] {Join} sendmsg2
2426: /result2 set
2427: this [ %% function args
2428: result2 [ (}) ] ] {Join} sendmsg2
2429: /result2 set
2430: this [ %% function args
2431: result2 ] {AddString} sendmsg2
2432: /FunctionValue set {/ExitPoint goto} exec %%return
2433: /ExitPoint ]pop popVariables %%pop the local variables
2434: /ExitPoint ]pop popVariables %%pop argValues
2435: db.DebugStack setstack pop stdstack
2436: FunctionValue } def
2437: %%end of function
2438:
2439: this [ %% function args
2440: [ (IndexedVariables) [ (IndexedVariables(name,size) returns the string ) ( {name[0],name[1],...,name[size-1]} which can be used as inputs to ) ( the function RingD (string name, integer size).) ( cf. RingDonIndexedVariables.) ( Ex. R = RingD(IndexedVariables("a",3)); ) ( h = Poly("h");) ( a = NewArray(3);) ( for (i=0; i<3; i++) {a[i] = Poly(Indexed("a",i));} ;) ] ] ] {HelpAdd} sendmsg2
2441: /RingDonIndexedVariables {
2442: db.DebugStack setstack $In function : RingDonIndexedVariables of class PrimitiveObject$ stdstack
2443: /Arglist set /Argthis set /FunctionValue [ ] def
2444: [/this /vList /size /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body
2445: [Argthis] Arglist join ArgNames mapset
2446: [ %%start of local variables
2447: /myring /tmp /k00_i /argsize /vListD ] pushVariables [ %%local variables
2448: this [ %% function args
2449: Arglist ] {Length} sendmsg2
2450: /argsize set
2451: argsize (1).. eq
2452: %% if-condition
2453: { %%ifbody
2454: this [ %% function args
2455: (Error (IndexedRingD): ) ] {Println} sendmsg2
2456: null /FunctionValue set {/ExitPoint goto} exec %%return
2457: }%%end if if body
2458: { %%if- else part
2459: } ifelse
2460: argsize (2).. eq
2461: %% if-condition
2462: { %%ifbody
2463: this [ %% function args
2464: [ (D) vList ] ] {AddString} sendmsg2
2465: /vListD set
2466: this [ %% function args
2467: this [ %% function args
2468: vList size ] {IndexedVariables} sendmsg2
2469: ] {RingD} sendmsg2
2470: /myring set
2471: this [ %% function args
2472: ] {SetRingVariables} sendmsg2
2473: this [ %% function args
2474: size ] {NewArray} sendmsg2
2475: /tmp set
2476: (0).. /k00_i set
2477: %%for init.
2478: %%for
2479: { k00_i size lt
2480: { } {exit} ifelse
2481: [ {%%increment
2482: /k00_i k00_i (1).. add def
2483: } %%end of increment{A}
2484: {%%start of B part{B}
2485: tmp [k00_i ] this [ %% function args
2486: this [ %% function args
2487: vList k00_i ] {Indexed} sendmsg2
2488: ] {Poly} sendmsg2
2489: Put
2490: } %% end of B part. {B}
2491: 2 1 roll] {exec} map pop
2492: } loop %%end of for
2493: vList (literal) dc tmp def this [ %% function args
2494: size ] {NewArray} sendmsg2
2495: /tmp set
2496: (0).. /k00_i set
2497: %%for init.
2498: %%for
2499: { k00_i size lt
2500: { } {exit} ifelse
2501: [ {%%increment
2502: /k00_i k00_i (1).. add def
2503: } %%end of increment{A}
2504: {%%start of B part{B}
2505: tmp [k00_i ] this [ %% function args
2506: this [ %% function args
2507: vListD k00_i ] {Indexed} sendmsg2
2508: ] {Poly} sendmsg2
2509: Put
2510: } %% end of B part. {B}
2511: 2 1 roll] {exec} map pop
2512: } loop %%end of for
2513: vListD (literal) dc tmp def SetRingVariables_Verbose %% if-condition
2514: { %%ifbody
2515: this [ %% function args
2516: (Set the global variables ) ] {Print} sendmsg2
2517: [(parse) vList ] extension pop print [(parse) vListD ] extension pop print this [ %% function args
2518: ] {Ln} sendmsg2
2519: }%%end if if body
2520: { %%if- else part
2521: [(parse) vList ] extension pop [(parse) vListD ] extension pop } ifelse
2522: myring /FunctionValue set {/ExitPoint goto} exec %%return
2523: }%%end if if body
2524: { %%if- else part
2525: } ifelse
2526: argsize (3).. eq
2527: argsize (4).. eq
2528: or
2529: %% if-condition
2530: { %%ifbody
2531: argsize (3).. eq
2532: %% if-condition
2533: { %%ifbody
2534: (0).. /pp set
2535: }%%end if if body
2536: { %%if- else part
2537: } ifelse
2538: this [ %% function args
2539: [ (D) vList ] ] {AddString} sendmsg2
2540: /vListD set
2541: this [ %% function args
2542: this [ %% function args
2543: vList size ] {IndexedVariables} sendmsg2
2544: weightMatrix pp ] {RingD} sendmsg2
2545: /myring set
2546: this [ %% function args
2547: ] {SetRingVariables} sendmsg2
2548: this [ %% function args
2549: size ] {NewArray} sendmsg2
2550: /tmp set
2551: (0).. /k00_i set
2552: %%for init.
2553: %%for
2554: { k00_i size lt
2555: { } {exit} ifelse
2556: [ {%%increment
2557: /k00_i k00_i (1).. add def
2558: } %%end of increment{A}
2559: {%%start of B part{B}
2560: tmp [k00_i ] this [ %% function args
2561: this [ %% function args
2562: vList k00_i ] {Indexed} sendmsg2
2563: ] {Poly} sendmsg2
2564: Put
2565: } %% end of B part. {B}
2566: 2 1 roll] {exec} map pop
2567: } loop %%end of for
2568: vList (literal) dc tmp def this [ %% function args
2569: size ] {NewArray} sendmsg2
2570: /tmp set
2571: (0).. /k00_i set
2572: %%for init.
2573: %%for
2574: { k00_i size lt
2575: { } {exit} ifelse
2576: [ {%%increment
2577: /k00_i k00_i (1).. add def
2578: } %%end of increment{A}
2579: {%%start of B part{B}
2580: tmp [k00_i ] this [ %% function args
2581: this [ %% function args
2582: vListD k00_i ] {Indexed} sendmsg2
2583: ] {Poly} sendmsg2
2584: Put
2585: } %% end of B part. {B}
2586: 2 1 roll] {exec} map pop
2587: } loop %%end of for
2588: vListD (literal) dc tmp def SetRingVariables_Verbose %% if-condition
2589: { %%ifbody
2590: this [ %% function args
2591: (Set the global variables ) ] {Print} sendmsg2
2592: [(parse) vList ] extension pop print [(parse) vListD ] extension pop print this [ %% function args
2593: ] {Ln} sendmsg2
2594: }%%end if if body
2595: { %%if- else part
2596: [(parse) vList ] extension pop [(parse) vListD ] extension pop } ifelse
2597: myring /FunctionValue set {/ExitPoint goto} exec %%return
2598: }%%end if if body
2599: { %%if- else part
2600: } ifelse
2601: (1).. (0).. 2 1 roll {sub} sendmsg
2602: /FunctionValue set {/ExitPoint goto} exec %%return
2603: /ExitPoint ]pop popVariables %%pop the local variables
2604: /ExitPoint ]pop popVariables %%pop argValues
2605: db.DebugStack setstack pop stdstack
2606: FunctionValue } def
2607: %%end of function
2608:
2609: /Ringp {
2610: db.DebugStack setstack $In function : Ringp of class PrimitiveObject$ stdstack
2611: /Arglist set /Argthis set /FunctionValue [ ] def
2612: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
2613: [Argthis] Arglist join ArgNames mapset
2614: f (ring) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2615: db.DebugStack setstack pop stdstack
2616: FunctionValue } def
2617: %%end of function
2618:
2619: this [ %% function args
2620: [ (Ringp) [ (Ringp(f) ( polynomial f ) returns the ring to which the polynomial << f >>) (belongs.) ] ] ] {HelpAdd} sendmsg2
2621: /Coefficients {
2622: db.DebugStack setstack $In function : Coefficients of class PrimitiveObject$ stdstack
2623: /Arglist set /Argthis set /FunctionValue [ ] def
2624: [/this /f /v ] /ArgNames set ArgNames pushVariables [ %%function body
2625: [Argthis] Arglist join ArgNames mapset
2626: [ %%start of local variables
2627: /ans /exp ] pushVariables [ %%local variables
2628: f v coefficients /ans set
2629: ans [(0).. ] Get
2630: /exp set
2631: exp { (universalNumber) dc } map /exp set
2632: [ exp ans [(1).. ] Get
2633: ] /FunctionValue set {/ExitPoint goto} exec %%return
2634: /ExitPoint ]pop popVariables %%pop the local variables
2635: /ExitPoint ]pop popVariables %%pop argValues
2636: db.DebugStack setstack pop stdstack
2637: FunctionValue } def
2638: %%end of function
2639:
2640: /IsInteger {
2641: db.DebugStack setstack $In function : IsInteger of class PrimitiveObject$ stdstack
2642: /Arglist set /Argthis set /FunctionValue [ ] def
2643: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
2644: [Argthis] Arglist join ArgNames mapset
2645: a isUniversalNumber /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2646: db.DebugStack setstack pop stdstack
2647: FunctionValue } def
2648: %%end of function
2649:
2650: this [ %% function args
2651: [ (IsInteger) [ (IsInteger(a) returns true if << a >> is an integer (object a).) (It returns false if << a >> is not.) (cf. IsSm1Integer) ] ] ] {HelpAdd} sendmsg2
2652: /IsRational {
2653: db.DebugStack setstack $In function : IsRational of class PrimitiveObject$ stdstack
2654: /Arglist set /Argthis set /FunctionValue [ ] def
2655: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
2656: [Argthis] Arglist join ArgNames mapset
2657: a isRational /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2658: db.DebugStack setstack pop stdstack
2659: FunctionValue } def
2660: %%end of function
2661:
2662: this [ %% function args
2663: [ (IsRational) [ (IsRational(a) returns true if << a >> is a rational (object a).) (It returns false if << a >> is not.) ] ] ] {HelpAdd} sendmsg2
2664: /IsDouble {
2665: db.DebugStack setstack $In function : IsDouble of class PrimitiveObject$ stdstack
2666: /Arglist set /Argthis set /FunctionValue [ ] def
2667: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
2668: [Argthis] Arglist join ArgNames mapset
2669: a isDouble /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
2670: db.DebugStack setstack pop stdstack
2671: FunctionValue } def
2672: %%end of function
2673:
2674: this [ %% function args
2675: [ (IsDouble) [ (IsDouble(a) returns true if << a >> is a double (object a).) (It returns false if << a >> is not.) ] ] ] {HelpAdd} sendmsg2
2676: /cs { this [ ] Cleards } def /Init_w {
2677: db.DebugStack setstack $In function : Init_w of class PrimitiveObject$ stdstack
2678: /Arglist set /Argthis set /FunctionValue [ ] def
2679: [/this /f /vars /weight ] /ArgNames set ArgNames pushVariables [ %%function body
2680: [Argthis] Arglist join ArgNames mapset
2681: [ %%start of local variables
2682: /w /top /ans /wtop ] pushVariables [ %%local variables
2683: f this [ %% function args
2684: (0) ] {Poly} sendmsg2
2685: eq
2686: %% if-condition
2687: { %%ifbody
2688: this [ %% function args
2689: (0) ] {Poly} sendmsg2
2690: /FunctionValue set {/ExitPoint goto} exec %%return
2691: }%%end if if body
2692: { %%if- else part
2693: } ifelse
2694: f init /top set
2695: this [ %% function args
2696: top vars ] {Exponent} sendmsg2
2697: weight {mul} sendmsg2
2698: /w set
2699: w /wtop set
2700: top /ans set
2701: f top {sub} sendmsg2
2702: /f set
2703:
2704: %%while
2705: { true { } {exit} ifelse
2706: f this [ %% function args
2707: (0) ] {Poly} sendmsg2
2708: eq
2709: %% if-condition
2710: { %%ifbody
2711: exit }%%end if if body
2712: { %%if- else part
2713: } ifelse
2714: f init /top set
2715: this [ %% function args
2716: top vars ] {Exponent} sendmsg2
2717: weight {mul} sendmsg2
2718: /w set
2719: w wtop lt
2720: %% if-condition
2721: { %%ifbody
2722: exit }%%end if if body
2723: { %%if- else part
2724: } ifelse
2725: ans top {add} sendmsg2
2726: /ans set
2727: f top {sub} sendmsg2
2728: /f set
2729: } loop
2730: ans /FunctionValue set {/ExitPoint goto} exec %%return
2731: /ExitPoint ]pop popVariables %%pop the local variables
2732: /ExitPoint ]pop popVariables %%pop argValues
2733: db.DebugStack setstack pop stdstack
2734: FunctionValue } def
2735: %%end of function
2736:
2737: this [ %% function args
2738: [ (Mapto) [ (Mapto(obj,ring) parses << obj >> as elements of the << ring >>.) ((ring << ring >>, polynomial << obj >> or array of polynomial << obj >>).) (Ex. R = RingD("x,y"); SetRingVariables();) ( f = (x+y)^2; R2 = RingD("x,y,z",[["y",1]]); ) ( f2 = Mapto(f,R2); f2: ) ] ] ] {HelpAdd} sendmsg2
2739: /Mapto {
2740: db.DebugStack setstack $In function : Mapto of class PrimitiveObject$ stdstack
2741: /Arglist set /Argthis set /FunctionValue [ ] def
2742: [/this /obj /ring ] /ArgNames set ArgNames pushVariables [ %%function body
2743: [Argthis] Arglist join ArgNames mapset
2744: [ %%start of local variables
2745: /ans /i /n ] pushVariables [ %%local variables
2746: this [ %% function args
2747: obj ] {IsArray} sendmsg2
2748: %% if-condition
2749: { %%ifbody
2750: this [ %% function args
2751: obj ] {Length} sendmsg2
2752: /n set
2753: this [ %% function args
2754: obj (ToString) ] {Map} sendmsg2
2755: /ans set
2756: (0).. /i set
2757: %%for init.
2758: %%for
2759: { i n lt
2760: { } {exit} ifelse
2761: [ {%%increment
2762: /i i (1).. add def
2763: } %%end of increment{A}
2764: {%%start of B part{B}
2765: ans [i ] this [ %% function args
2766: ans [i ] Get
2767: ring ] {PolyR} sendmsg2
2768: Put
2769: } %% end of B part. {B}
2770: 2 1 roll] {exec} map pop
2771: } loop %%end of for
2772: }%%end if if body
2773: { %%if- else part
2774: this [ %% function args
2775: obj ] {ToString} sendmsg2
2776: /ans set
2777: this [ %% function args
2778: ans ring ] {PolyR} sendmsg2
2779: /ans set
2780: } ifelse
2781: ans /FunctionValue set {/ExitPoint goto} exec %%return
2782: /ExitPoint ]pop popVariables %%pop the local variables
2783: /ExitPoint ]pop popVariables %%pop argValues
2784: db.DebugStack setstack pop stdstack
2785: FunctionValue } def
2786: %%end of function
2787:
2788: this [ %% function args
2789: [ (ToDouble) [ (ToDouble(f) translates << f >> into double when it is possible) (object << f >>.) (Example: ToDouble([1,1/2,[5]]): ) ] ] ] {HelpAdd} sendmsg2
2790: /k00_toDouble {
2791: db.DebugStack setstack $In function : k00_toDouble of class PrimitiveObject$ stdstack
2792: /Arglist set /Argthis set /FunctionValue [ ] def
2793: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
2794: [Argthis] Arglist join ArgNames mapset
2795: this [ %% function args
2796: f (double) ] {DC} sendmsg2
2797: /FunctionValue set {/ExitPoint goto} exec %%return
2798: /ExitPoint ]pop popVariables %%pop argValues
2799: db.DebugStack setstack pop stdstack
2800: FunctionValue } def
2801: %%end of function
2802:
2803: /ToDouble {
2804: db.DebugStack setstack $In function : ToDouble of class PrimitiveObject$ stdstack
2805: /Arglist set /Argthis set /FunctionValue [ ] def
2806: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
2807: [Argthis] Arglist join ArgNames mapset
2808: this [ %% function args
2809: f ] {IsArray} sendmsg2
2810: %% if-condition
2811: { %%ifbody
2812: this [ %% function args
2813: f (ToDouble) ] {Map} sendmsg2
2814: /FunctionValue set {/ExitPoint goto} exec %%return
2815: }%%end if if body
2816: { %%if- else part
2817: } ifelse
2818: this [ %% function args
2819: f ] {IsDouble} sendmsg2
2820: %% if-condition
2821: { %%ifbody
2822: f /FunctionValue set {/ExitPoint goto} exec %%return
2823: }%%end if if body
2824: { %%if- else part
2825: } ifelse
2826: this [ %% function args
2827: f ] {k00_toDouble} sendmsg2
2828: /FunctionValue set {/ExitPoint goto} exec %%return
2829: /ExitPoint ]pop popVariables %%pop argValues
2830: db.DebugStack setstack pop stdstack
2831: FunctionValue } def
2832: %%end of function
2833:
2834: /RingPonIndexedVariables {
2835: db.DebugStack setstack $In function : RingPonIndexedVariables of class PrimitiveObject$ stdstack
2836: /Arglist set /Argthis set /FunctionValue [ ] def
2837: [/this /vList /size /weightMatrix ] /ArgNames set ArgNames pushVariables [ %%function body
2838: [Argthis] Arglist join ArgNames mapset
2839: [ %%start of local variables
2840: /myring /tmp /k00_i /argsize /vListD ] pushVariables [ %%local variables
2841: this [ %% function args
2842: Arglist ] {Length} sendmsg2
2843: /argsize set
2844: argsize (1).. eq
2845: %% if-condition
2846: { %%ifbody
2847: this [ %% function args
2848: (Error (RingPonIndexedVariables): ) ] {Println} sendmsg2
2849: null /FunctionValue set {/ExitPoint goto} exec %%return
2850: }%%end if if body
2851: { %%if- else part
2852: } ifelse
2853: argsize (2).. eq
2854: %% if-condition
2855: { %%ifbody
2856: this [ %% function args
2857: this [ %% function args
2858: vList size ] {IndexedVariables} sendmsg2
2859: ] {RingPoly} sendmsg2
2860: /myring set
2861: this [ %% function args
2862: ] {SetRingVariables} sendmsg2
2863: this [ %% function args
2864: size ] {NewArray} sendmsg2
2865: /tmp set
2866: (0).. /k00_i set
2867: %%for init.
2868: %%for
2869: { k00_i size lt
2870: { } {exit} ifelse
2871: [ {%%increment
2872: /k00_i k00_i (1).. add def
2873: } %%end of increment{A}
2874: {%%start of B part{B}
2875: tmp [k00_i ] this [ %% function args
2876: this [ %% function args
2877: vList k00_i ] {Indexed} sendmsg2
2878: ] {Poly} sendmsg2
2879: Put
2880: } %% end of B part. {B}
2881: 2 1 roll] {exec} map pop
2882: } loop %%end of for
2883: vList (literal) dc tmp def SetRingVariables_Verbose %% if-condition
2884: { %%ifbody
2885: this [ %% function args
2886: (Set the global variables ) ] {Print} sendmsg2
2887: [(parse) vList ] extension pop print this [ %% function args
2888: ] {Ln} sendmsg2
2889: }%%end if if body
2890: { %%if- else part
2891: [(parse) vList ] extension pop } ifelse
2892: myring /FunctionValue set {/ExitPoint goto} exec %%return
2893: }%%end if if body
2894: { %%if- else part
2895: } ifelse
2896: argsize (3).. eq
2897: %% if-condition
2898: { %%ifbody
2899: this [ %% function args
2900: this [ %% function args
2901: vList size ] {IndexedVariables} sendmsg2
2902: weightMatrix ] {RingPoly} sendmsg2
2903: /myring set
2904: this [ %% function args
2905: ] {SetRingVariables} sendmsg2
2906: this [ %% function args
2907: size ] {NewArray} sendmsg2
2908: /tmp set
2909: (0).. /k00_i set
2910: %%for init.
2911: %%for
2912: { k00_i size lt
2913: { } {exit} ifelse
2914: [ {%%increment
2915: /k00_i k00_i (1).. add def
2916: } %%end of increment{A}
2917: {%%start of B part{B}
2918: tmp [k00_i ] this [ %% function args
2919: this [ %% function args
2920: vList k00_i ] {Indexed} sendmsg2
2921: ] {Poly} sendmsg2
2922: Put
2923: } %% end of B part. {B}
2924: 2 1 roll] {exec} map pop
2925: } loop %%end of for
2926: vList (literal) dc tmp def SetRingVariables_Verbose %% if-condition
2927: { %%ifbody
2928: this [ %% function args
2929: (Set the global variables ) ] {Print} sendmsg2
2930: [(parse) vList ] extension pop print this [ %% function args
2931: ] {Ln} sendmsg2
2932: }%%end if if body
2933: { %%if- else part
2934: [(parse) vList ] extension pop } ifelse
2935: myring /FunctionValue set {/ExitPoint goto} exec %%return
2936: }%%end if if body
2937: { %%if- else part
2938: } ifelse
2939: (1).. (0).. 2 1 roll {sub} sendmsg
2940: /FunctionValue set {/ExitPoint goto} exec %%return
2941: /ExitPoint ]pop popVariables %%pop the local variables
2942: /ExitPoint ]pop popVariables %%pop argValues
2943: db.DebugStack setstack pop stdstack
2944: FunctionValue } def
2945: %%end of function
2946:
2947: this [ %% function args
2948: [ (RingPonIndexedVariables) [ (RingPonIndexedVariables(name,n) defines and returns the ring of) (polynomials) (Q<h, name[0], ..., name[n-1] >) (where <<name>> is a string and <<n>> is an integer.) (Note that this function defines global variables) (h, name[0], ..., name[n-1].) (Example: RingPonIndexedVariables("x",3).) (RingPonIndexedVariables(name,n,w) defines and returns the ring of) (polynomials with the ordering defined by ) (the weight vector <<w>> (array)) (Example: RingPonIndexedVariables("x",3,[["x[0]",1,"x[2]",3]]).) ] ] ] {HelpAdd} sendmsg2
2949: /Mod {
2950: db.DebugStack setstack $In function : Mod of class PrimitiveObject$ stdstack
2951: /Arglist set /Argthis set /FunctionValue [ ] def
2952: [/this /f /n ] /ArgNames set ArgNames pushVariables [ %%function body
2953: [Argthis] Arglist join ArgNames mapset
2954: this [ %% function args
2955: f ] {IsPolynomial} sendmsg2
2956: %% if-condition
2957: { %%ifbody
2958: [(mod) f n ] gbext /FunctionValue set }%%end if if body
2959: { %%if- else part
2960: this [ %% function args
2961: f ] {IsInteger} sendmsg2
2962: %% if-condition
2963: { %%ifbody
2964: Gmp [ %% function args
2965: f n ] {Mod} sendmsg2
2966: /FunctionValue set {/ExitPoint goto} exec %%return
2967: }%%end if if body
2968: { %%if- else part
2969: } ifelse
2970: } ifelse
2971: /ExitPoint ]pop popVariables %%pop argValues
2972: db.DebugStack setstack pop stdstack
2973: FunctionValue } def
2974: %%end of function
2975:
2976: this [ %% function args
2977: [ (Mod) [ (Mod(f,p) returns f modulo n where << f >> (polynomial) and) ( << p >> (integer). ) ] ] ] {HelpAdd} sendmsg2
2978: /Characteristic {
2979: db.DebugStack setstack $In function : Characteristic of class PrimitiveObject$ stdstack
2980: /Arglist set /Argthis set /FunctionValue [ ] def
2981: [/this /ringp ] /ArgNames set ArgNames pushVariables [ %%function body
2982: [Argthis] Arglist join ArgNames mapset
2983: [ %%start of local variables
2984: /r /p ] pushVariables [ %%local variables
2985: [(CurrentRingp)] system_variable /r set
2986: [(CurrentRingp) ringp ] system_variable [(P)] system_variable (universalNumber) dc /p set
2987: [(CurrentRingp) r ] system_variable p /FunctionValue set {/ExitPoint goto} exec %%return
2988: /ExitPoint ]pop popVariables %%pop the local variables
2989: /ExitPoint ]pop popVariables %%pop argValues
2990: db.DebugStack setstack pop stdstack
2991: FunctionValue } def
2992: %%end of function
2993:
2994: this [ %% function args
2995: [ (Characteristic) [ (Characteristic(ring) returns the characteristic of the << ring >>.) ] ] ] {HelpAdd} sendmsg2
2996: /IsConstant {
2997: db.DebugStack setstack $In function : IsConstant of class PrimitiveObject$ stdstack
2998: /Arglist set /Argthis set /FunctionValue [ ] def
2999: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
3000: [Argthis] Arglist join ArgNames mapset
3001: this [ %% function args
3002: f ] {Length} sendmsg2
3003: (1).. gt
3004: %% if-condition
3005: { %%ifbody
3006: false /FunctionValue set {/ExitPoint goto} exec %%return
3007: }%%end if if body
3008: { %%if- else part
3009: } ifelse
3010: [(isConstant) f ] gbext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3011: db.DebugStack setstack pop stdstack
3012: FunctionValue } def
3013: %%end of function
3014:
3015: this [ %% function args
3016: [ (IsConstant) [ (IsConstant(f) returns true if the polynomial << f >> is a constant.) ] ] ] {HelpAdd} sendmsg2
3017: this [ %% function args
3018: (Default ring is Z[x,h].) ] {Println} sendmsg2
3019: this [ %% function args
3020: (x) ] {Poly} sendmsg2
3021: /x set
3022: this [ %% function args
3023: (h) ] {Poly} sendmsg2
3024: /h set
3025: /Substitute {
3026: db.DebugStack setstack $In function : Substitute of class PrimitiveObject$ stdstack
3027: /Arglist set /Argthis set /FunctionValue [ ] def
3028: [/this /f /xx /g ] /ArgNames set ArgNames pushVariables [ %%function body
3029: [Argthis] Arglist join ArgNames mapset
3030: [ %%start of local variables
3031: /tmp /coeff /ex /i /n /newex ] pushVariables [ %%local variables
3032: this [ %% function args
3033: f ] {IsInteger} sendmsg2
3034: %% if-condition
3035: { %%ifbody
3036: f /FunctionValue set {/ExitPoint goto} exec %%return
3037: }%%end if if body
3038: { %%if- else part
3039: } ifelse
3040: this [ %% function args
3041: f ] {IsPolynomial} sendmsg2
3042: not
3043: %% if-condition
3044: { %%ifbody
3045: this [ %% function args
3046: (Substitute) (The first argument must be polynomial.) ] {k00_error} sendmsg2
3047: }%%end if if body
3048: { %%if- else part
3049: } ifelse
3050: this [ %% function args
3051: f xx ] {Coefficients} sendmsg2
3052: /tmp set
3053: tmp [(1).. ] Get
3054: /coeff set
3055: tmp [(0).. ] Get
3056: /ex set
3057: this [ %% function args
3058: ex ] {Length} sendmsg2
3059: /n set
3060: this [ %% function args
3061: n ] {NewVector} sendmsg2
3062: /newex set
3063: n (0).. gt
3064: %% if-condition
3065: { %%ifbody
3066: newex [n (1).. {sub} sendmsg2
3067: ] g ex [n (1).. {sub} sendmsg2
3068: ] Get
3069: power
3070: Put
3071: }%%end if if body
3072: { %%if- else part
3073: } ifelse
3074: n (2).. {sub} sendmsg2
3075: /i set
3076: %%for init.
3077: %%for
3078: { i (0).. greaterThanOrEqual
3079: { } {exit} ifelse
3080: [ {%%increment
3081: /i i (1).. sub def
3082: } %%end of increment{A}
3083: {%%start of B part{B}
3084: newex [i ] newex [i (1).. {add} sendmsg2
3085: ] Get
3086: g ex [i ] Get
3087: ex [i (1).. {add} sendmsg2
3088: ] Get
3089: {sub} sendmsg2
3090: power
3091: {mul} sendmsg2
3092: Put
3093: } %% end of B part. {B}
3094: 2 1 roll] {exec} map pop
3095: } loop %%end of for
3096: this [ %% function args
3097: coeff newex {mul} sendmsg2
3098: ] {Cancel} sendmsg2
3099: /FunctionValue set {/ExitPoint goto} exec %%return
3100: /ExitPoint ]pop popVariables %%pop the local variables
3101: /ExitPoint ]pop popVariables %%pop argValues
3102: db.DebugStack setstack pop stdstack
3103: FunctionValue } def
3104: %%end of function
3105:
3106: this [ %% function args
3107: [ (Substitute) [ (Substitute(f,xx,g) replaces << xx >> in << f >> by << g >>.) (This function takes coeffients of << f >> with respect to << xx >>) (and returns the inner product of the vector of coefficients and the vector) (of which elements are g^(corresponding exponent).) (Note that it may cause an unexpected result in non-commutative rings.) ] ] ] {HelpAdd} sendmsg2
3108: K00_verbose %% if-condition
3109: { %%ifbody
3110: this [ %% function args
3111: ( debug/db.k (db.ccc), 1997, 3/2 (Sun) : checking debug functions of kxx) ] {Println} sendmsg2
3112: this [ %% function args
3113: ( Type in test0(). ) ] {Println} sendmsg2
3114: }%%end if if body
3115: { %%if- else part
3116: } ifelse
3117: /pushVariables {localVariables} def /popVariables {restoreVariables} def K00_verbose %% if-condition
3118: { %%ifbody
3119: this [ %% function args
3120: ( Overloaded on pushVariables and popVariables.) ] {Println} sendmsg2
3121: }%%end if if body
3122: { %%if- else part
3123: } ifelse
3124: [(CatchCtrlC) 1] system_variable [(Strict) 1] system_variable K00_verbose %% if-condition
3125: { %%ifbody
3126: this [ %% function args
3127: ( ctrl-C signal is caught in KSexecuteString() and <<Warning>> is regarded as an error.) ] {Println} sendmsg2
3128: }%%end if if body
3129: { %%if- else part
3130: } ifelse
3131: /test0 {
3132: db.DebugStack setstack $In function : test0 of class PrimitiveObject$ stdstack
3133: /Arglist set /Argthis set /FunctionValue [ ] def
3134: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3135: [Argthis] ArgNames mapset
3136: [(ErrorMessageMode) 2] system_variable [(WarningMessageMode) 2] system_variable this [ %% function args
3137: (15).. ] {fib} sendmsg2
3138: db.where.es /ExitPoint ]pop popVariables %%pop argValues
3139: db.DebugStack setstack pop stdstack
3140: FunctionValue } def
3141: %%end of function
3142:
3143: /Where {
3144: db.DebugStack setstack $In function : Where of class PrimitiveObject$ stdstack
3145: /Arglist set /Argthis set /FunctionValue [ ] def
3146: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3147: [Argthis] ArgNames mapset
3148: this [ %% function args
3149: (CurrentContext is ...) ] {Println} sendmsg2
3150: [(CurrentContextp)] system_variable {message} primmsg this [ %% function args
3151: (VariableStack trace is....) ] {Println} sendmsg2
3152: db.where this [ %% function args
3153: (DebugStack trace is ....) ] {Println} sendmsg2
3154: db.where.ds this [ %% function args
3155: (To clear VariableStack, DebugStack and ErrorStack, type in Cleards().) ] {Println} sendmsg2
3156: /ExitPoint ]pop popVariables %%pop argValues
3157: db.DebugStack setstack pop stdstack
3158: } def
3159: %%end of function
3160:
3161: /Cleards {
3162: db.DebugStack setstack $In function : Cleards of class PrimitiveObject$ stdstack
3163: /Arglist set /Argthis set /FunctionValue [ ] def
3164: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3165: [Argthis] ArgNames mapset
3166: this [ %% function args
3167: (Clearing DebugStack and ErrorStack...) ] {Print} sendmsg2
3168: db.clear.ds db.clear.es this [ %% function args
3169: ( ) ] {Println} sendmsg2
3170: this [ %% function args
3171: (Restoring variables....) ] {Print} sendmsg2
3172: db.restore [ ] localVariables this [ %% function args
3173: (Done) ] {Println} sendmsg2
3174: /ExitPoint ]pop popVariables %%pop argValues
3175: db.DebugStack setstack pop stdstack
3176: } def
3177: %%end of function
3178:
3179: /fib {
3180: db.DebugStack setstack $In function : fib of class PrimitiveObject$ stdstack
3181: /Arglist set /Argthis set /FunctionValue [ ] def
3182: [/this /n ] /ArgNames set ArgNames pushVariables [ %%function body
3183: [Argthis] Arglist join ArgNames mapset
3184: [ %%start of local variables
3185: /ans /a /b ] pushVariables [ %%local variables
3186: this [ %% function args
3187: (fib of ) ] {Print} sendmsg2
3188: this [ %% function args
3189: n ] {Println} sendmsg2
3190: n (2).. lt
3191: %% if-condition
3192: { %%ifbody
3193: (1).. /FunctionValue set {/ExitPoint goto} exec %%return
3194: }%%end if if body
3195: { %%if- else part
3196: } ifelse
3197: n (1).. {sub} sendmsg2
3198: /a set
3199: n (2).. {sub} sendmsg2
3200: /b set
3201: a (11).. eq
3202: %% if-condition
3203: { %%ifbody
3204: a [i ] (2).. Put
3205: }%%end if if body
3206: { %%if- else part
3207: } ifelse
3208: this [ %% function args
3209: a ] {fib} sendmsg2
3210: this [ %% function args
3211: b ] {fib} sendmsg2
3212: {add} sendmsg2
3213: /ans set
3214: ans /FunctionValue set {/ExitPoint goto} exec %%return
3215: /ExitPoint ]pop popVariables %%pop the local variables
3216: /ExitPoint ]pop popVariables %%pop argValues
3217: db.DebugStack setstack pop stdstack
3218: FunctionValue } def
3219: %%end of function
3220:
3221: K00_verbose %% if-condition
3222: { %%ifbody
3223: this [ %% function args
3224: (debug/asir0.k you need to start k0 with -f option. ) ] {Println} sendmsg2
3225: }%%end if if body
3226: { %%if- else part
3227: } ifelse
3228: /Factor {
3229: db.DebugStack setstack $In function : Factor of class PrimitiveObject$ stdstack
3230: /Arglist set /Argthis set /FunctionValue [ ] def
3231: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
3232: [Argthis] Arglist join ArgNames mapset
3233: f factor /FunctionValue set clean-workfiles /ExitPoint ]pop popVariables %%pop argValues
3234: db.DebugStack setstack pop stdstack
3235: FunctionValue } def
3236: %%end of function
3237:
3238: this [ %% function args
3239: [ (Factor) [ ( Not Yet. <<need asir, start k0 with -f option.>>) ] ] ] {HelpAdd} sendmsg2
3240: /Cancel {
3241: db.DebugStack setstack $In function : Cancel of class PrimitiveObject$ stdstack
3242: /Arglist set /Argthis set /FunctionValue [ ] def
3243: [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
3244: [Argthis] Arglist join ArgNames mapset
3245: [ %%start of local variables
3246: /tmp /den /num ] pushVariables [ %%local variables
3247: this [ %% function args
3248: f ] {IsRational} sendmsg2
3249: %% if-condition
3250: { %%ifbody
3251: this [ %% function args
3252: this [ %% function args
3253: f ] {Denominator} sendmsg2
3254: ] {Cancel} sendmsg2
3255: /den set
3256: this [ %% function args
3257: this [ %% function args
3258: f ] {Numerator} sendmsg2
3259: ] {Cancel} sendmsg2
3260: /num set
3261: this [ %% function args
3262: den ] {IsInteger} sendmsg2
3263: this [ %% function args
3264: num ] {IsInteger} sendmsg2
3265: and
3266: %% if-condition
3267: { %%ifbody
3268: this [ %% function args
3269: num den {div} sendmsg2
3270: ] {CancelNumber} sendmsg2
3271: /FunctionValue set {/ExitPoint goto} exec %%return
3272: }%%end if if body
3273: { %%if- else part
3274: } ifelse
3275: this [ %% function args
3276: den ] {IsInteger} sendmsg2
3277: %% if-condition
3278: { %%ifbody
3279: [(divByN) num den ] gbext /tmp set
3280: tmp [(1).. ] Get
3281: this [ %% function args
3282: (0) ] {Poly} sendmsg2
3283: eq
3284: %% if-condition
3285: { %%ifbody
3286: this [ %% function args
3287: tmp [(0).. ] Get
3288: ] {Cancel} sendmsg2
3289: /FunctionValue set {/ExitPoint goto} exec %%return
3290: }%%end if if body
3291: { %%if- else part
3292: f /FunctionValue set {/ExitPoint goto} exec %%return
3293: } ifelse
3294: }%%end if if body
3295: { %%if- else part
3296: } ifelse
3297: }%%end if if body
3298: { %%if- else part
3299: } ifelse
3300: this [ %% function args
3301: f ] {IsInteger} sendmsg2
3302: %% if-condition
3303: { %%ifbody
3304: f /FunctionValue set {/ExitPoint goto} exec %%return
3305: }%%end if if body
3306: { %%if- else part
3307: } ifelse
3308: this [ %% function args
3309: f ] {IsPolynomial} sendmsg2
3310: %% if-condition
3311: { %%ifbody
3312: f this [ %% function args
3313: (0) ] {Poly} sendmsg2
3314: eq
3315: %% if-condition
3316: { %%ifbody
3317: (0).. /FunctionValue set {/ExitPoint goto} exec %%return
3318: }%%end if if body
3319: { %%if- else part
3320: } ifelse
3321: this [ %% function args
3322: this [ %% function args
3323: f ] {Ringp} sendmsg2
3324: ] {Characteristic} sendmsg2
3325: (0).. eq not
3326: %% if-condition
3327: { %%ifbody
3328: f /FunctionValue set {/ExitPoint goto} exec %%return
3329: }%%end if if body
3330: { %%if- else part
3331: } ifelse
3332: this [ %% function args
3333: f ] {IsConstant} sendmsg2
3334: %% if-condition
3335: { %%ifbody
3336: this [ %% function args
3337: f (integer) ] {DC} sendmsg2
3338: /FunctionValue set {/ExitPoint goto} exec %%return
3339: }%%end if if body
3340: { %%if- else part
3341: } ifelse
3342: f /FunctionValue set {/ExitPoint goto} exec %%return
3343: }%%end if if body
3344: { %%if- else part
3345: } ifelse
3346: f cancel /FunctionValue set clean-workfiles /ExitPoint ]pop popVariables %%pop the local variables
3347: /ExitPoint ]pop popVariables %%pop argValues
3348: db.DebugStack setstack pop stdstack
3349: FunctionValue } def
3350: %%end of function
3351:
3352: this [ %% function args
3353: [ (Cancel) [ ( Not Yet. <<need asir, start k0 with -f option>>) ] ] ] {HelpAdd} sendmsg2
3354: /Primadec {
3355: db.DebugStack setstack $In function : Primadec of class PrimitiveObject$ stdstack
3356: /Arglist set /Argthis set /FunctionValue [ ] def
3357: [/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body
3358: [Argthis] Arglist join ArgNames mapset
3359: f g primadec /FunctionValue set clean-workfiles /ExitPoint ]pop popVariables %%pop argValues
3360: db.DebugStack setstack pop stdstack
3361: FunctionValue } def
3362: %%end of function
3363:
3364: this [ %% function args
3365: [ (Primadec) [ ( Not Yet. <<need asir, start k0 with -f option.>>) ] ] ] {HelpAdd} sendmsg2
3366: this [ %% function args
3367: (showln) (0).. ] {Protect} sendmsg2
3368: [ $Object$ PrimitiveObject 0 get newcontext ] /Object set
3369: Object 0 get setcontext
3370: /new0 {
3371: db.DebugStack setstack $In function : new0 of class Object$ stdstack
3372: /Arglist set /Argthis set /FunctionValue [ ] def
3373: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3374: [Argthis] ArgNames mapset
3375: Object /FunctionValue set {/ExitPoint goto} exec %%return
3376: /ExitPoint ]pop popVariables %%pop argValues
3377: db.DebugStack setstack pop stdstack
3378: FunctionValue } def
3379: %%end of function
3380:
3381: /showln {
3382: db.DebugStack setstack $In function : showln of class Object$ stdstack
3383: /Arglist set /Argthis set /FunctionValue [ ] def
3384: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3385: [Argthis] ArgNames mapset
3386: this [ %% function args
3387: this ] {Println} sendmsg2
3388: /ExitPoint ]pop popVariables %%pop argValues
3389: db.DebugStack setstack pop stdstack
3390: FunctionValue } def
3391: %%end of function
3392:
3393: /getClass {
3394: db.DebugStack setstack $In function : getClass of class Object$ stdstack
3395: /Arglist set /Argthis set /FunctionValue [ ] def
3396: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3397: [Argthis] ArgNames mapset
3398: this 0 get /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3399: db.DebugStack setstack pop stdstack
3400: FunctionValue } def
3401: %%end of function
3402:
3403: PrimitiveContextp setcontext /ectag { dup isClass not { pop -1 } { lc } ifelse } def /k00ecTag {
3404: db.DebugStack setstack $In function : k00ecTag of class PrimitiveObject$ stdstack
3405: /Arglist set /Argthis set /FunctionValue [ ] def
3406: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
3407: [Argthis] Arglist join ArgNames mapset
3408: a ectag /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3409: db.DebugStack setstack pop stdstack
3410: FunctionValue } def
3411: %%end of function
3412:
3413: /IsObject {
3414: db.DebugStack setstack $In function : IsObject of class PrimitiveObject$ stdstack
3415: /Arglist set /Argthis set /FunctionValue [ ] def
3416: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
3417: [Argthis] Arglist join ArgNames mapset
3418: this [ %% function args
3419: a ] {IsArray} sendmsg2
3420: not
3421: %% if-condition
3422: { %%ifbody
3423: false /FunctionValue set {/ExitPoint goto} exec %%return
3424: }%%end if if body
3425: { %%if- else part
3426: } ifelse
3427: this [ %% function args
3428: a ] {Length} sendmsg2
3429: (1).. lt
3430: %% if-condition
3431: { %%ifbody
3432: false /FunctionValue set {/ExitPoint goto} exec %%return
3433: }%%end if if body
3434: { %%if- else part
3435: } ifelse
3436: this [ %% function args
3437: a [(0).. ] Get
3438: ] {k00ecTag} sendmsg2
3439: this [ %% function args
3440: Object [(0).. ] Get
3441: ] {k00ecTag} sendmsg2
3442: eq
3443: %% if-condition
3444: { %%ifbody
3445: true /FunctionValue set {/ExitPoint goto} exec %%return
3446: }%%end if if body
3447: { %%if- else part
3448: false /FunctionValue set {/ExitPoint goto} exec %%return
3449: } ifelse
3450: /ExitPoint ]pop popVariables %%pop argValues
3451: db.DebugStack setstack pop stdstack
3452: FunctionValue } def
3453: %%end of function
3454:
3455: this [ %% function args
3456: [ (IsObject) [ (IsObject(a) return true if a is an Object.) ] ] ] {HelpAdd} sendmsg2
3457: [ $Gmp$ Object 0 get newcontext ] /Gmp set
3458: Gmp 0 get setcontext
3459: /BitAnd {
3460: db.DebugStack setstack $In function : BitAnd of class Gmp$ stdstack
3461: /Arglist set /Argthis set /FunctionValue [ ] def
3462: [/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
3463: [Argthis] Arglist join ArgNames mapset
3464: [(and) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3465: db.DebugStack setstack pop stdstack
3466: FunctionValue } def
3467: %%end of function
3468:
3469: /BitOr {
3470: db.DebugStack setstack $In function : BitOr of class Gmp$ stdstack
3471: /Arglist set /Argthis set /FunctionValue [ ] def
3472: [/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
3473: [Argthis] Arglist join ArgNames mapset
3474: [(ior) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3475: db.DebugStack setstack pop stdstack
3476: FunctionValue } def
3477: %%end of function
3478:
3479: /ModuloPower {
3480: db.DebugStack setstack $In function : ModuloPower of class Gmp$ stdstack
3481: /Arglist set /Argthis set /FunctionValue [ ] def
3482: [/this /base /ex /mmod ] /ArgNames set ArgNames pushVariables [ %%function body
3483: [Argthis] Arglist join ArgNames mapset
3484: [(powm) base ex mmod ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3485: db.DebugStack setstack pop stdstack
3486: FunctionValue } def
3487: %%end of function
3488:
3489: /ProbabilisticPrimeP {
3490: db.DebugStack setstack $In function : ProbabilisticPrimeP of class Gmp$ stdstack
3491: /Arglist set /Argthis set /FunctionValue [ ] def
3492: [/this /p /reps ] /ArgNames set ArgNames pushVariables [ %%function body
3493: [Argthis] Arglist join ArgNames mapset
3494: [(probab_prime_p) p reps ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3495: db.DebugStack setstack pop stdstack
3496: FunctionValue } def
3497: %%end of function
3498:
3499: /Sqrt {
3500: db.DebugStack setstack $In function : Sqrt of class Gmp$ stdstack
3501: /Arglist set /Argthis set /FunctionValue [ ] def
3502: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
3503: [Argthis] Arglist join ArgNames mapset
3504: [(sqrt) a ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3505: db.DebugStack setstack pop stdstack
3506: FunctionValue } def
3507: %%end of function
3508:
3509: /Gcd {
3510: db.DebugStack setstack $In function : Gcd of class Gmp$ stdstack
3511: /Arglist set /Argthis set /FunctionValue [ ] def
3512: [/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
3513: [Argthis] Arglist join ArgNames mapset
3514: [(gcd) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3515: db.DebugStack setstack pop stdstack
3516: FunctionValue } def
3517: %%end of function
3518:
3519: /Div {
3520: db.DebugStack setstack $In function : Div of class Gmp$ stdstack
3521: /Arglist set /Argthis set /FunctionValue [ ] def
3522: [/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
3523: [Argthis] Arglist join ArgNames mapset
3524: [(tdiv_qr) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3525: db.DebugStack setstack pop stdstack
3526: FunctionValue } def
3527: %%end of function
3528:
3529: /Mod {
3530: db.DebugStack setstack $In function : Mod of class Gmp$ stdstack
3531: /Arglist set /Argthis set /FunctionValue [ ] def
3532: [/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
3533: [Argthis] Arglist join ArgNames mapset
3534: [(tdiv_qr) a b ] mpzext 1 get /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
3535: db.DebugStack setstack pop stdstack
3536: FunctionValue } def
3537: %%end of function
3538:
3539: PrimitiveContextp setcontext this [ %% function args
3540: [ (Gmp.) [ (Gmp is a class which supports the following methods:) (BitAnd, BitOr, ModuloPower, ProbabilisticPrimeP, Sqrt,) (Gcd, Div, Mod.) (Ex. r = Gmp.Gcd(5,8); ) (These methods call functions of Gnu-MP package.) (The Copyright notice is in kan96xx/gmp.) (Note that there is no method to create an instance.) ] ] ] {HelpAdd} sendmsg2
3541: true /ShimomuraSpecial set
3542: true /OnePath set
3543: false /Vvv set
3544: false /SetRingVariables_Verbose set
3545: /QuietKan {
3546: db.DebugStack setstack $In function : QuietKan of class PrimitiveObject$ stdstack
3547: /Arglist set /Argthis set /FunctionValue [ ] def
3548: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3549: [Argthis] ArgNames mapset
3550: [(KanGBmessage) 0] system_variable /ExitPoint ]pop popVariables %%pop argValues
3551: db.DebugStack setstack pop stdstack
3552: } def
3553: %%end of function
3554:
3555: /testhg1 {
3556: db.DebugStack setstack $In function : testhg1 of class PrimitiveObject$ stdstack
3557: /Arglist set /Argthis set /FunctionValue [ ] def
3558: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3559: [Argthis] ArgNames mapset
3560: [ [ (1).. (1).. (1).. (1).. (1).. (1).. ] [ (0).. (0).. (0).. (1).. (1).. (1).. ] [ (0).. (1).. (0).. (0).. (1).. (0).. ] [ (0).. (0).. (1).. (0).. (0).. (1).. ] ] /a set
3561: this [ %% function args
3562: a ] {idhg} sendmsg2
3563: /FunctionValue set {/ExitPoint goto} exec %%return
3564: /ExitPoint ]pop popVariables %%pop argValues
3565: db.DebugStack setstack pop stdstack
3566: FunctionValue } def
3567: %%end of function
3568:
3569: /testhg2 {
3570: db.DebugStack setstack $In function : testhg2 of class PrimitiveObject$ stdstack
3571: /Arglist set /Argthis set /FunctionValue [ ] def
3572: [/this ] /ArgNames set ArgNames pushVariables [ %%function body
3573: [Argthis] ArgNames mapset
3574: [ [ (1).. (1).. (1).. (1).. (1).. ] [ (0).. (2).. (3).. (4).. (3).. ] [ (0).. (1).. (1).. (0).. (2).. ] ] /a set
3575: this [ %% function args
3576: a ] {idhg} sendmsg2
3577: /FunctionValue set {/ExitPoint goto} exec %%return
3578: /ExitPoint ]pop popVariables %%pop argValues
3579: db.DebugStack setstack pop stdstack
3580: FunctionValue } def
3581: %%end of function
3582:
3583: /idhg {
3584: db.DebugStack setstack $In function : idhg of class PrimitiveObject$ stdstack
3585: /Arglist set /Argthis set /FunctionValue [ ] def
3586: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
3587: [Argthis] Arglist join ArgNames mapset
3588: [ %%start of local variables
3589: /a /ans /rd /i /ans2 /ans3 /n /ff /d /zlist ] pushVariables [ %%local variables
3590: this [ %% function args
3591: a ] {toric} sendmsg2
3592: /ans set
3593: ShimomuraSpecial %% if-condition
3594: { %%ifbody
3595: Vvv %% if-condition
3596: { %%ifbody
3597: this [ %% function args
3598: (-------- S-special ---------) ] {Println} sendmsg2
3599: }%%end if if body
3600: { %%if- else part
3601: } ifelse
3602: this [ %% function args
3603: ans (Init) ] {Map} sendmsg2
3604: /ans set
3605: }%%end if if body
3606: { %%if- else part
3607: } ifelse
3608: this [ %% function args
3609: ans (ToString) ] {Map} sendmsg2
3610: /ans set
3611: Vvv %% if-condition
3612: { %%ifbody
3613: this [ %% function args
3614: ans ] {Println} sendmsg2
3615: }%%end if if body
3616: { %%if- else part
3617: } ifelse
3618: this [ %% function args
3619: (z) this [ %% function args
3620: a [(0).. ] Get
3621: ] {Length} sendmsg2
3622: (1).. {add} sendmsg2
3623: this [ %% function args
3624: a ] {Length} sendmsg2
3625: {add} sendmsg2
3626: ] {RingDonIndexedVariables} sendmsg2
3627: /rd set
3628: this [ %% function args
3629: ans (Poly) ] {Map} sendmsg2
3630: /ans set
3631: this [ %% function args
3632: a [(0).. ] Get
3633: ] {Length} sendmsg2
3634: /n set
3635: this [ %% function args
3636: a ] {Length} sendmsg2
3637: /d set
3638: this [ %% function args
3639: this [ %% function args
3640: ans ] {Length} sendmsg2
3641: ] {NewArray} sendmsg2
3642: /ans2 set
3643: (0).. %%PSfor initvalue.
3644: (integer) data_conversion
3645: this [ %% function args
3646: ans ] {Length} sendmsg2
3647: (1).. sub (integer) data_conversion 1 2 -1 roll
3648: { %% for body
3649: (universalNumber) data_conversion /i set
3650: ans2 [i ] this [ %% function args
3651: ans [i ] Get
3652: n ] {ztoDz} sendmsg2
3653: Put
3654: } for
3655: Vvv %% if-condition
3656: { %%ifbody
3657: this [ %% function args
3658: ans2 ] {Println} sendmsg2
3659: }%%end if if body
3660: { %%if- else part
3661: } ifelse
3662: this [ %% function args
3663: a ] {atolin} sendmsg2
3664: /ans3 set
3665: Vvv %% if-condition
3666: { %%ifbody
3667: this [ %% function args
3668: ans3 ] {Println} sendmsg2
3669: }%%end if if body
3670: { %%if- else part
3671: } ifelse
3672: this [ %% function args
3673: this [ %% function args
3674: ans2 ans3 ] {Join} sendmsg2
3675: (ToString) ] {Map} sendmsg2
3676: /ff set
3677: this [ %% function args
3678: ff n d ] {zindicial} sendmsg2
3679: /ans set
3680: [ ] /zlist set
3681: n %%PSfor initvalue.
3682: (integer) data_conversion
3683: n d {add} sendmsg2
3684: (1).. {add} sendmsg2
3685: (1).. sub (integer) data_conversion 1 2 -1 roll
3686: { %% for body
3687: (universalNumber) data_conversion /i set
3688: this [ %% function args
3689: zlist this [ %% function args
3690: (z) i ] {Indexed} sendmsg2
3691: ] {Append} sendmsg2
3692: /zlist set
3693: } for
3694: [ ans zlist ] /FunctionValue set {/ExitPoint goto} exec %%return
3695: /ExitPoint ]pop popVariables %%pop the local variables
3696: /ExitPoint ]pop popVariables %%pop argValues
3697: db.DebugStack setstack pop stdstack
3698: FunctionValue } def
3699: %%end of function
3700:
3701: /toric0_toMonom {
3702: db.DebugStack setstack $In function : toric0_toMonom of class PrimitiveObject$ stdstack
3703: /Arglist set /Argthis set /FunctionValue [ ] def
3704: [/this /aa /i /offset /ring ] /ArgNames set ArgNames pushVariables [ %%function body
3705: [Argthis] Arglist join ArgNames mapset
3706: [ %%start of local variables
3707: /j /ans /m ] pushVariables [ %%local variables
3708: this [ %% function args
3709: aa ] {Length} sendmsg2
3710: /m set
3711: this [ %% function args
3712: (1) ring ] {PolyR} sendmsg2
3713: /ans set
3714: (0).. /j set
3715: %%for init.
3716: %%for
3717: { j m lt
3718: { } {exit} ifelse
3719: [ {%%increment
3720: /j j (1).. add def
3721: } %%end of increment{A}
3722: {%%start of B part{B}
3723: ans z [offset j {add} sendmsg2
3724: ] Get
3725: aa [j i ] Get
3726: power
3727: {mul} sendmsg2
3728: /ans set
3729: } %% end of B part. {B}
3730: 2 1 roll] {exec} map pop
3731: } loop %%end of for
3732: ans /FunctionValue set {/ExitPoint goto} exec %%return
3733: /ExitPoint ]pop popVariables %%pop the local variables
3734: /ExitPoint ]pop popVariables %%pop argValues
3735: db.DebugStack setstack pop stdstack
3736: FunctionValue } def
3737: %%end of function
3738:
3739: /toric {
3740: db.DebugStack setstack $In function : toric of class PrimitiveObject$ stdstack
3741: /Arglist set /Argthis set /FunctionValue [ ] def
3742: [/this /aa ] /ArgNames set ArgNames pushVariables [ %%function body
3743: [Argthis] Arglist join ArgNames mapset
3744: [ %%start of local variables
3745: /i /j /rz /n /d /ideal /ans /univ /rule /nn /weight /elim ] pushVariables [ %%local variables
3746: this [ %% function args
3747: aa ] {Length} sendmsg2
3748: /d set
3749: this [ %% function args
3750: aa [(0).. ] Get
3751: ] {Length} sendmsg2
3752: /n set
3753: Vvv %% if-condition
3754: { %%ifbody
3755: this [ %% function args
3756: aa ] {Println} sendmsg2
3757: }%%end if if body
3758: { %%if- else part
3759: } ifelse
3760: [ ] /weight set
3761: [ ] /elim set
3762: n %%PSfor initvalue.
3763: (integer) data_conversion
3764: n d {add} sendmsg2
3765: (1).. sub (integer) data_conversion 1 2 -1 roll
3766: { %% for body
3767: (universalNumber) data_conversion /i set
3768: this [ %% function args
3769: weight [ this [ %% function args
3770: (z) i ] {Indexed} sendmsg2
3771: (1).. ] ] {Join} sendmsg2
3772: /weight set
3773: this [ %% function args
3774: elim this [ %% function args
3775: (z) i ] {Indexed} sendmsg2
3776: ] {Append} sendmsg2
3777: /elim set
3778: } for
3779: this [ %% function args
3780: [ weight ] [ this [ %% function args
3781: (z) n (1).. {sub} sendmsg2
3782: ] {Indexed} sendmsg2
3783: (1).. ] ] {Append} sendmsg2
3784: /weight set
3785: Vvv %% if-condition
3786: { %%ifbody
3787: this [ %% function args
3788: weight ] {Println} sendmsg2
3789: this [ %% function args
3790: elim ] {Println} sendmsg2
3791: }%%end if if body
3792: { %%if- else part
3793: } ifelse
3794: this [ %% function args
3795: (z) n d {add} sendmsg2
3796: weight ] {RingPonIndexedVariables} sendmsg2
3797: /rz set
3798: [ ] /ideal set
3799: (0).. %%PSfor initvalue.
3800: (integer) data_conversion
3801: n (1).. sub (integer) data_conversion 1 2 -1 roll
3802: { %% for body
3803: (universalNumber) data_conversion /i set
3804: this [ %% function args
3805: ideal z [i ] Get
3806: this [ %% function args
3807: aa i n rz ] {toric0_toMonom} sendmsg2
3808: {sub} sendmsg2
3809: ] {Append} sendmsg2
3810: /ideal set
3811: } for
3812: Vvv %% if-condition
3813: { %%ifbody
3814: this [ %% function args
3815: ( --------- input ideal -------------) ] {Println} sendmsg2
3816: this [ %% function args
3817: ( z[) ] {Print} sendmsg2
3818: this [ %% function args
3819: n ] {Print} sendmsg2
3820: this [ %% function args
3821: (] --- z[) ] {Print} sendmsg2
3822: this [ %% function args
3823: n d {add} sendmsg2
3824: (1).. {sub} sendmsg2
3825: ] {Print} sendmsg2
3826: this [ %% function args
3827: (] should be eliminated.) ] {Println} sendmsg2
3828: this [ %% function args
3829: ideal ] {Println} sendmsg2
3830: }%%end if if body
3831: { %%if- else part
3832: } ifelse
3833: this [ %% function args
3834: ideal ] {Groebner} sendmsg2
3835: /ans set
3836: Vvv %% if-condition
3837: { %%ifbody
3838: this [ %% function args
3839: ( -------------- gb is ----------------- ) ] {Println} sendmsg2
3840: this [ %% function args
3841: ans ] {Println} sendmsg2
3842: }%%end if if body
3843: { %%if- else part
3844: } ifelse
3845: this [ %% function args
3846: ans elim ] {Eliminatev} sendmsg2
3847: /ans set
3848: Vvv %% if-condition
3849: { %%ifbody
3850: this [ %% function args
3851: ( ------------ eliminated -------------- ) ] {Println} sendmsg2
3852: this [ %% function args
3853: ans ] {Println} sendmsg2
3854: }%%end if if body
3855: { %%if- else part
3856: } ifelse
3857: [ [ h this [ %% function args
3858: (1) rz ] {PolyR} sendmsg2
3859: ] ] /rule set
3860: this [ %% function args
3861: ans ] {Length} sendmsg2
3862: /nn set
3863: [ ] /univ set
3864: (0).. %%PSfor initvalue.
3865: (integer) data_conversion
3866: nn (1).. sub (integer) data_conversion 1 2 -1 roll
3867: { %% for body
3868: (universalNumber) data_conversion /i set
3869: this [ %% function args
3870: univ this [ %% function args
3871: ans [i ] Get
3872: rule ] {Replace} sendmsg2
3873: ] {Append} sendmsg2
3874: /univ set
3875: } for
3876: this [ %% function args
3877: univ ] {ReducedBase} sendmsg2
3878: /ans set
3879: Vvv %% if-condition
3880: { %%ifbody
3881: this [ %% function args
3882: ( ----------- removed redundant elements ----------- ) ] {Println} sendmsg2
3883: this [ %% function args
3884: ( ---------- generators of the toric ideal are ----- ) ] {Println} sendmsg2
3885: this [ %% function args
3886: ans ] {Println} sendmsg2
3887: this [ %% function args
3888: ( ) ] {Println} sendmsg2
3889: }%%end if if body
3890: { %%if- else part
3891: } ifelse
3892: ans /FunctionValue set {/ExitPoint goto} exec %%return
3893: /ExitPoint ]pop popVariables %%pop the local variables
3894: /ExitPoint ]pop popVariables %%pop argValues
3895: db.DebugStack setstack pop stdstack
3896: FunctionValue } def
3897: %%end of function
3898:
3899: /zindicial0 {
3900: db.DebugStack setstack $In function : zindicial0 of class PrimitiveObject$ stdstack
3901: /Arglist set /Argthis set /FunctionValue [ ] def
3902: [/this /input /n /m ] /ArgNames set ArgNames pushVariables [ %%function body
3903: [Argthis] Arglist join ArgNames mapset
3904: [ %%start of local variables
3905: /rz /weight /ww /i /rule /zinverse /m /d /ans /elim /tmp ] pushVariables [ %%local variables
3906: OnePath not
3907: %% if-condition
3908: { %%ifbody
3909: [ ] /ww set
3910: [ ] /elim set
3911: [ [ this [ %% function args
3912: (z) n ] {Indexed} sendmsg2
3913: (1).. ] ] /weight set
3914: Vvv %% if-condition
3915: { %%ifbody
3916: this [ %% function args
3917: (-------- weight ---------: ) ] {Print} sendmsg2
3918: this [ %% function args
3919: weight ] {Println} sendmsg2
3920: }%%end if if body
3921: { %%if- else part
3922: } ifelse
3923: this [ %% function args
3924: (z) n (1).. {add} sendmsg2
3925: m {add} sendmsg2
3926: weight ] {RingDonIndexedVariables} sendmsg2
3927: /rz set
3928: this [ %% function args
3929: n (1).. {add} sendmsg2
3930: m {add} sendmsg2
3931: ] {NewArray} sendmsg2
3932: /z set
3933: this [ %% function args
3934: n (1).. {add} sendmsg2
3935: m {add} sendmsg2
3936: ] {NewArray} sendmsg2
3937: /Dz set
3938: (0).. %%PSfor initvalue.
3939: (integer) data_conversion
3940: n (1).. {add} sendmsg2
3941: m {add} sendmsg2
3942: (1).. sub (integer) data_conversion 1 2 -1 roll
3943: { %% for body
3944: (universalNumber) data_conversion /i set
3945: z [i ] this [ %% function args
3946: this [ %% function args
3947: (z) i ] {Indexed} sendmsg2
3948: rz ] {PolyR} sendmsg2
3949: Put
3950: Dz [i ] this [ %% function args
3951: this [ %% function args
3952: (Dz) i ] {Indexed} sendmsg2
3953: rz ] {PolyR} sendmsg2
3954: Put
3955: } for
3956: this [ %% function args
3957: input rz ] {Mapto} sendmsg2
3958: /input set
3959: Vvv %% if-condition
3960: { %%ifbody
3961: this [ %% function args
3962: (------------ input ------------) ] {Println} sendmsg2
3963: this [ %% function args
3964: input ] {Println} sendmsg2
3965: }%%end if if body
3966: { %%if- else part
3967: } ifelse
3968: this [ %% function args
3969: this [ %% function args
3970: [ this [ %% function args
3971: (z) n ] {Indexed} sendmsg2
3972: (^(-1)) ] ] {AddString} sendmsg2
3973: rz ] {PolyR} sendmsg2
3974: /zinverse set
3975: [ [ Dz [n (1).. {sub} sendmsg2
3976: ] Get
3977: Dz [n (1).. {sub} sendmsg2
3978: ] Get
3979: z [n ] Get
3980: {mul} sendmsg2
3981: ] [ z [n (1).. {sub} sendmsg2
3982: ] Get
3983: z [n (1).. {sub} sendmsg2
3984: ] Get
3985: zinverse {mul} sendmsg2
3986: ] ] /rule set
3987: this [ %% function args
3988: input rule ] {Replace} sendmsg2
3989: /input set
3990: this [ %% function args
3991: input ] {Length} sendmsg2
3992: /m set
3993: (0).. %%PSfor initvalue.
3994: (integer) data_conversion
3995: m (1).. sub (integer) data_conversion 1 2 -1 roll
3996: { %% for body
3997: (universalNumber) data_conversion /i set
3998: this [ %% function args
3999: this [ %% function args
4000: input [i ] Get
4001: [ [ z [n ] Get
4002: zinverse ] ] ] {Replace} sendmsg2
4003: z [n ] Get
4004: ] {Degree} sendmsg2
4005: (0).. 2 1 roll {sub} sendmsg
4006: /d set
4007: d (0).. lt
4008: %% if-condition
4009: { %%ifbody
4010: input [i ] z [n ] Get
4011: d (0).. 2 1 roll {sub} sendmsg
4012: power
4013: input [i ] Get
4014: {mul} sendmsg2
4015: Put
4016: }%%end if if body
4017: { %%if- else part
4018: } ifelse
4019: } for
4020: Vvv %% if-condition
4021: { %%ifbody
4022: this [ %% function args
4023: (------ input : ) ] {Print} sendmsg2
4024: this [ %% function args
4025: input ] {Println} sendmsg2
4026: }%%end if if body
4027: { %%if- else part
4028: } ifelse
4029: this [ %% function args
4030: input ] {GroebnerTime} sendmsg2
4031: /ans set
4032: this [ %% function args
4033: ans ] {Length} sendmsg2
4034: /m set
4035: (0).. %%PSfor initvalue.
4036: (integer) data_conversion
4037: m (1).. sub (integer) data_conversion 1 2 -1 roll
4038: { %% for body
4039: (universalNumber) data_conversion /i set
4040: this [ %% function args
4041: ans [i ] Get
4042: z [n ] Get
4043: ] {Coefficients} sendmsg2
4044: /tmp set
4045: ans [i ] tmp [(1).. (0).. ] Get
4046: Put
4047: } for
4048: Vvv %% if-condition
4049: { %%ifbody
4050: this [ %% function args
4051: (--------FW principal parts : ) ] {Print} sendmsg2
4052: this [ %% function args
4053: ans ] {Println} sendmsg2
4054: }%%end if if body
4055: { %%if- else part
4056: } ifelse
4057: this [ %% function args
4058: ans (ToString) ] {Map} sendmsg2
4059: /input set
4060: }%%end if if body
4061: { %%if- else part
4062: } ifelse
4063: [ ] /ww set
4064: [ ] /elim set
4065: (0).. %%PSfor initvalue.
4066: (integer) data_conversion
4067: n (1).. {sub} sendmsg2
4068: (1).. sub (integer) data_conversion 1 2 -1 roll
4069: { %% for body
4070: (universalNumber) data_conversion /i set
4071: this [ %% function args
4072: ww [ this [ %% function args
4073: (Dz) i ] {Indexed} sendmsg2
4074: (1).. ] ] {Join} sendmsg2
4075: /ww set
4076: i n (1).. {sub} sendmsg2
4077: eq not
4078: %% if-condition
4079: { %%ifbody
4080: this [ %% function args
4081: elim this [ %% function args
4082: (Dz) i ] {Indexed} sendmsg2
4083: ] {Append} sendmsg2
4084: /elim set
4085: }%%end if if body
4086: { %%if- else part
4087: } ifelse
4088: } for
4089: [ [ this [ %% function args
4090: (z) n ] {Indexed} sendmsg2
4091: (1).. ] ww ] /weight set
4092: Vvv %% if-condition
4093: { %%ifbody
4094: this [ %% function args
4095: (-------- weight ---------: ) ] {Print} sendmsg2
4096: this [ %% function args
4097: weight ] {Println} sendmsg2
4098: }%%end if if body
4099: { %%if- else part
4100: } ifelse
4101: this [ %% function args
4102: (z) n (1).. {add} sendmsg2
4103: m {add} sendmsg2
4104: weight ] {RingDonIndexedVariables} sendmsg2
4105: /rz set
4106: this [ %% function args
4107: n (1).. {add} sendmsg2
4108: m {add} sendmsg2
4109: ] {NewArray} sendmsg2
4110: /z set
4111: this [ %% function args
4112: n (1).. {add} sendmsg2
4113: m {add} sendmsg2
4114: ] {NewArray} sendmsg2
4115: /Dz set
4116: (0).. %%PSfor initvalue.
4117: (integer) data_conversion
4118: n (1).. {add} sendmsg2
4119: m {add} sendmsg2
4120: (1).. sub (integer) data_conversion 1 2 -1 roll
4121: { %% for body
4122: (universalNumber) data_conversion /i set
4123: z [i ] this [ %% function args
4124: this [ %% function args
4125: (z) i ] {Indexed} sendmsg2
4126: rz ] {PolyR} sendmsg2
4127: Put
4128: Dz [i ] this [ %% function args
4129: this [ %% function args
4130: (Dz) i ] {Indexed} sendmsg2
4131: rz ] {PolyR} sendmsg2
4132: Put
4133: } for
4134: this [ %% function args
4135: input rz ] {Mapto} sendmsg2
4136: /input set
4137: OnePath %% if-condition
4138: { %%ifbody
4139: this [ %% function args
4140: this [ %% function args
4141: [ this [ %% function args
4142: (z) n ] {Indexed} sendmsg2
4143: (^(-1)) ] ] {AddString} sendmsg2
4144: rz ] {PolyR} sendmsg2
4145: /zinverse set
4146: [ [ Dz [n (1).. {sub} sendmsg2
4147: ] Get
4148: Dz [n (1).. {sub} sendmsg2
4149: ] Get
4150: z [n ] Get
4151: {mul} sendmsg2
4152: ] [ z [n (1).. {sub} sendmsg2
4153: ] Get
4154: z [n (1).. {sub} sendmsg2
4155: ] Get
4156: zinverse {mul} sendmsg2
4157: ] ] /rule set
4158: this [ %% function args
4159: input rule ] {Replace} sendmsg2
4160: /input set
4161: this [ %% function args
4162: input ] {Length} sendmsg2
4163: /m set
4164: (0).. %%PSfor initvalue.
4165: (integer) data_conversion
4166: m (1).. sub (integer) data_conversion 1 2 -1 roll
4167: { %% for body
4168: (universalNumber) data_conversion /i set
4169: this [ %% function args
4170: this [ %% function args
4171: input [i ] Get
4172: [ [ z [n ] Get
4173: zinverse ] ] ] {Replace} sendmsg2
4174: z [n ] Get
4175: ] {Degree} sendmsg2
4176: (0).. 2 1 roll {sub} sendmsg
4177: /d set
4178: d (0).. lt
4179: %% if-condition
4180: { %%ifbody
4181: input [i ] z [n ] Get
4182: d (0).. 2 1 roll {sub} sendmsg
4183: power
4184: input [i ] Get
4185: {mul} sendmsg2
4186: Put
4187: }%%end if if body
4188: { %%if- else part
4189: } ifelse
4190: } for
4191: }%%end if if body
4192: { %%if- else part
4193: } ifelse
4194: Vvv %% if-condition
4195: { %%ifbody
4196: this [ %% function args
4197: (------ input : ) ] {Print} sendmsg2
4198: this [ %% function args
4199: input ] {Println} sendmsg2
4200: }%%end if if body
4201: { %%if- else part
4202: } ifelse
4203: this [ %% function args
4204: input ] {GroebnerTime} sendmsg2
4205: /ans set
4206: this [ %% function args
4207: ans ] {Length} sendmsg2
4208: /m set
4209: (0).. %%PSfor initvalue.
4210: (integer) data_conversion
4211: m (1).. sub (integer) data_conversion 1 2 -1 roll
4212: { %% for body
4213: (universalNumber) data_conversion /i set
4214: this [ %% function args
4215: ans [i ] Get
4216: z [n ] Get
4217: ] {Coefficients} sendmsg2
4218: /tmp set
4219: ans [i ] tmp [(1).. (0).. ] Get
4220: Put
4221: } for
4222: Vvv %% if-condition
4223: { %%ifbody
4224: this [ %% function args
4225: (--------FW principal parts : ) ] {Print} sendmsg2
4226: this [ %% function args
4227: ans ] {Println} sendmsg2
4228: }%%end if if body
4229: { %%if- else part
4230: } ifelse
4231: this [ %% function args
4232: ans elim ] {Eliminatev} sendmsg2
4233: /ans set
4234: this [ %% function args
4235: ans ] {Length} sendmsg2
4236: /m set
4237: (0).. /i set
4238: %%for init.
4239: %%for
4240: { i m lt
4241: { } {exit} ifelse
4242: [ {%%increment
4243: /i i (1).. add def
4244: } %%end of increment{A}
4245: {%%start of B part{B}
4246: ans [i ] this [ %% function args
4247: ans [i ] Get
4248: [ [ h this [ %% function args
4249: (1) rz ] {PolyR} sendmsg2
4250: ] [ this [ %% function args
4251: this [ %% function args
4252: (z) n ] {Indexed} sendmsg2
4253: rz ] {PolyR} sendmsg2
4254: this [ %% function args
4255: (1) rz ] {PolyR} sendmsg2
4256: ] ] ] {Replace} sendmsg2
4257: Put
4258: } %% end of B part. {B}
4259: 2 1 roll] {exec} map pop
4260: } loop %%end of for
4261: Vvv %% if-condition
4262: { %%ifbody
4263: this [ %% function args
4264: ( ) ] {Println} sendmsg2
4265: this [ %% function args
4266: ( ) ] {Println} sendmsg2
4267: }%%end if if body
4268: { %%if- else part
4269: } ifelse
4270: ans /FunctionValue set {/ExitPoint goto} exec %%return
4271: /ExitPoint ]pop popVariables %%pop the local variables
4272: /ExitPoint ]pop popVariables %%pop argValues
4273: db.DebugStack setstack pop stdstack
4274: FunctionValue } def
4275: %%end of function
4276:
4277: /zrho {
4278: db.DebugStack setstack $In function : zrho of class PrimitiveObject$ stdstack
4279: /Arglist set /Argthis set /FunctionValue [ ] def
4280: [/this /f /n ] /ArgNames set ArgNames pushVariables [ %%function body
4281: [Argthis] Arglist join ArgNames mapset
4282: [ %%start of local variables
4283: /ans /i /top /w /rz ] pushVariables [ %%local variables
4284: (0).. /ans set
4285: this [ %% function args
4286: f ] {Ringp} sendmsg2
4287: /rz set
4288:
4289: %%while
4290: { true { } {exit} ifelse
4291: f this [ %% function args
4292: (0) ] {Poly} sendmsg2
4293: eq
4294: %% if-condition
4295: { %%ifbody
4296: exit }%%end if if body
4297: { %%if- else part
4298: } ifelse
4299: this [ %% function args
4300: f ] {Init} sendmsg2
4301: /top set
4302: f top {sub} sendmsg2
4303: /f set
4304: this [ %% function args
4305: top [ this [ %% function args
4306: this [ %% function args
4307: (Dz) n (1).. {sub} sendmsg2
4308: ] {Indexed} sendmsg2
4309: rz ] {PolyR} sendmsg2
4310: ] ] {Exponent} sendmsg2
4311: /w set
4312: this [ %% function args
4313: top [ [ this [ %% function args
4314: this [ %% function args
4315: (Dz) n (1).. {sub} sendmsg2
4316: ] {Indexed} sendmsg2
4317: rz ] {PolyR} sendmsg2
4318: this [ %% function args
4319: (1) rz ] {PolyR} sendmsg2
4320: ] ] ] {Replace} sendmsg2
4321: this [ %% function args
4322: z [n ] Get
4323: w [(0).. ] Get
4324: ] {zipoch} sendmsg2
4325: {mul} sendmsg2
4326: /top set
4327: ans top {add} sendmsg2
4328: /ans set
4329: } loop
4330: ans /FunctionValue set {/ExitPoint goto} exec %%return
4331: /ExitPoint ]pop popVariables %%pop the local variables
4332: /ExitPoint ]pop popVariables %%pop argValues
4333: db.DebugStack setstack pop stdstack
4334: FunctionValue } def
4335: %%end of function
4336:
4337: /zipoch {
4338: db.DebugStack setstack $In function : zipoch of class PrimitiveObject$ stdstack
4339: /Arglist set /Argthis set /FunctionValue [ ] def
4340: [/this /f /w ] /ArgNames set ArgNames pushVariables [ %%function body
4341: [Argthis] Arglist join ArgNames mapset
4342: [ %%start of local variables
4343: /ans /i ] pushVariables [ %%local variables
4344: (1).. /ans set
4345: (0).. %%PSfor initvalue.
4346: (integer) data_conversion
4347: w (1).. sub (integer) data_conversion 1 2 -1 roll
4348: { %% for body
4349: (universalNumber) data_conversion /i set
4350: ans f i {sub} sendmsg2
4351: {mul} sendmsg2
4352: /ans set
4353: } for
4354: ans /FunctionValue set {/ExitPoint goto} exec %%return
4355: /ExitPoint ]pop popVariables %%pop the local variables
4356: /ExitPoint ]pop popVariables %%pop argValues
4357: db.DebugStack setstack pop stdstack
4358: FunctionValue } def
4359: %%end of function
4360:
4361: /zindicial {
4362: db.DebugStack setstack $In function : zindicial of class PrimitiveObject$ stdstack
4363: /Arglist set /Argthis set /FunctionValue [ ] def
4364: [/this /fff /n /mm ] /ArgNames set ArgNames pushVariables [ %%function body
4365: [Argthis] Arglist join ArgNames mapset
4366: [ %%start of local variables
4367: /ans /n /i /m /r /tmp ] pushVariables [ %%local variables
4368: this [ %% function args
4369: fff n mm ] {zindicial0} sendmsg2
4370: /ans set
4371: Vvv %% if-condition
4372: { %%ifbody
4373: this [ %% function args
4374: ans ] {Println} sendmsg2
4375: }%%end if if body
4376: { %%if- else part
4377: } ifelse
4378: this [ %% function args
4379: ans ] {Length} sendmsg2
4380: /m set
4381: [ ] /r set
4382: Vvv %% if-condition
4383: { %%ifbody
4384: this [ %% function args
4385: this [ %% function args
4386: [ (------ The generic indicial polynomial along z[) this [ %% function args
4387: n (1).. {sub} sendmsg2
4388: ] {ToString} sendmsg2
4389: (] = 0 is the minimal degree polynomial of the following) (polynomials.) ] ] {AddString} sendmsg2
4390: ] {Println} sendmsg2
4391: this [ %% function args
4392: this [ %% function args
4393: [ (z[) this [ %% function args
4394: n ] {ToString} sendmsg2
4395: (] is equal to s.) ] ] {AddString} sendmsg2
4396: ] {Println} sendmsg2
4397: }%%end if if body
4398: { %%if- else part
4399: } ifelse
4400: (0).. %%PSfor initvalue.
4401: (integer) data_conversion
4402: m (1).. sub (integer) data_conversion 1 2 -1 roll
4403: { %% for body
4404: (universalNumber) data_conversion /i set
4405: ans [i ] Get
4406: /tmp set
4407: this [ %% function args
4408: tmp [ [ this [ %% function args
4409: this [ %% function args
4410: (z) n (1).. {sub} sendmsg2
4411: ] {Indexed} sendmsg2
4412: ] {Poly} sendmsg2
4413: this [ %% function args
4414: (1) ] {Poly} sendmsg2
4415: ] ] ] {Replace} sendmsg2
4416: /tmp set
4417: this [ %% function args
4418: tmp n ] {zrho} sendmsg2
4419: /tmp set
4420: Vvv %% if-condition
4421: { %%ifbody
4422: this [ %% function args
4423: i ] {Print} sendmsg2
4424: this [ %% function args
4425: ( : ) ] {Print} sendmsg2
4426: this [ %% function args
4427: tmp ] {Println} sendmsg2
4428: }%%end if if body
4429: { %%if- else part
4430: } ifelse
4431: this [ %% function args
4432: r tmp ] {Append} sendmsg2
4433: /r set
4434: } for
4435: Vvv %% if-condition
4436: { %%ifbody
4437: this [ %% function args
4438: ( ) ] {Println} sendmsg2
4439: }%%end if if body
4440: { %%if- else part
4441: } ifelse
4442: r /FunctionValue set {/ExitPoint goto} exec %%return
4443: /ExitPoint ]pop popVariables %%pop the local variables
4444: /ExitPoint ]pop popVariables %%pop argValues
4445: db.DebugStack setstack pop stdstack
4446: FunctionValue } def
4447: %%end of function
4448:
4449: /ztoDz {
4450: db.DebugStack setstack $In function : ztoDz of class PrimitiveObject$ stdstack
4451: /Arglist set /Argthis set /FunctionValue [ ] def
4452: [/this /f /n ] /ArgNames set ArgNames pushVariables [ %%function body
4453: [Argthis] Arglist join ArgNames mapset
4454: [ %%start of local variables
4455: /rule /i ] pushVariables [ %%local variables
4456: this [ %% function args
4457: n ] {NewArray} sendmsg2
4458: /rule set
4459: (0).. %%PSfor initvalue.
4460: (integer) data_conversion
4461: n (1).. sub (integer) data_conversion 1 2 -1 roll
4462: { %% for body
4463: (universalNumber) data_conversion /i set
4464: rule [i ] [ z [i ] Get
4465: Dz [i ] Get
4466: ] Put
4467: } for
4468: this [ %% function args
4469: f rule ] {Replace} sendmsg2
4470: /FunctionValue set {/ExitPoint goto} exec %%return
4471: /ExitPoint ]pop popVariables %%pop the local variables
4472: /ExitPoint ]pop popVariables %%pop argValues
4473: db.DebugStack setstack pop stdstack
4474: FunctionValue } def
4475: %%end of function
4476:
4477: /atolin {
4478: db.DebugStack setstack $In function : atolin of class PrimitiveObject$ stdstack
4479: /Arglist set /Argthis set /FunctionValue [ ] def
4480: [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
4481: [Argthis] Arglist join ArgNames mapset
4482: [ %%start of local variables
4483: /d /n /eqs /ans /i /j ] pushVariables [ %%local variables
4484: this [ %% function args
4485: a ] {Length} sendmsg2
4486: /d set
4487: this [ %% function args
4488: a [(0).. ] Get
4489: ] {Length} sendmsg2
4490: /n set
4491: this [ %% function args
4492: d ] {NewArray} sendmsg2
4493: /eqs set
4494: (0).. %%PSfor initvalue.
4495: (integer) data_conversion
4496: d (1).. sub (integer) data_conversion 1 2 -1 roll
4497: { %% for body
4498: (universalNumber) data_conversion /i set
4499: (0).. /ans set
4500: (0).. %%PSfor initvalue.
4501: (integer) data_conversion
4502: n (1).. sub (integer) data_conversion 1 2 -1 roll
4503: { %% for body
4504: (universalNumber) data_conversion /j set
4505: ans a [i j ] Get
4506: z [j ] Get
4507: {mul} sendmsg2
4508: Dz [j ] Get
4509: {mul} sendmsg2
4510: {add} sendmsg2
4511: /ans set
4512: } for
4513: ans z [n (1).. {add} sendmsg2
4514: i {add} sendmsg2
4515: ] Get
4516: {sub} sendmsg2
4517: /ans set
4518: eqs [i ] ans Put
4519: } for
4520: eqs /FunctionValue set {/ExitPoint goto} exec %%return
4521: /ExitPoint ]pop popVariables %%pop the local variables
4522: /ExitPoint ]pop popVariables %%pop argValues
4523: db.DebugStack setstack pop stdstack
4524: FunctionValue } def
4525: %%end of function
4526:
4527: ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ahg2.k.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / debug