Annotation of OpenXM/src/kan96xx/Kan/var.sm1, Revision 1.1.1.1
1.1 maekawa 1:
2:
3: %% start of var.sm1. 1997, 2/27
4: %%(type in initv to initialize the variable stack and type in test.var to start a test) message
5:
6: /sm1.var.Verbose 0 def
7: /@@@.quiet.var 1 def
8: @@@.quiet.var { }
9: { (var.sm1 (module for debugging): Version 3/7, 1997. cf. strictMode, debugMode) message } ifelse
10:
11: /db.initVariableStack {
12: 1000 newstack /db.VariableStack set
13: } def
14:
15:
16: /localVariables {
17: { dup [ 3 1 roll load ] } map /db.arg0 set
18: db.VariableStack setstack db.arg0 stdstack
19: } def
20:
21: /restoreVariables {
22: db.VariableStack setstack
23: % dup print
24: { aload pop def } map pop
25: stdstack
26: } def
27:
28:
29:
30: /db.where {
31: db.VariableStack setstack
32: pstack
33: stdstack
34: } def
35:
36: /db.clear {
37: db.VariableStack setstack
38: /db.arg1 [(StackPointer) ] system_variable 2 sub def
39: %% arg1 print
40: 0 1 db.arg1
41: {
42: pop pop
43: } for
44: stdstack
45: } def
46:
47: /db.restore { %% You cannot use local variable in this function.
48: db.VariableStack setstack
49: /db.arg1 [(StackPointer) ] system_variable 2 sub def
50: 0 1 db.arg1
51: {
52: pop /db.variableArray set
53: sm1.var.Verbose { db.variableArray print } { } ifelse
54: db.variableArray isArray
55: { db.variableArray length 0 gt
56: {
57: db.variableArray { aload pop def } map pop
58: }
59: { } ifelse
60: }
61: %%% Don't call restoreVariables. Otherwise, stack is set to stdstack.
62: { } ifelse
63: } for
64: stdstack
65: } def
66:
67:
68:
69: /db.initDebugStack { 1000 newstack /db.DebugStack set } def
70:
71:
72: /db.where.ds {
73: db.DebugStack setstack
74: pstack
75: stdstack
76: } def
77:
78: /db.clear.ds {
79: db.DebugStack setstack
80: /db.arg1 [(StackPointer) ] system_variable 2 sub def
81: %% arg1 print
82: 0 1 db.arg1
83: {
84: pop pop
85: } for
86: stdstack
87: } def
88:
89:
90: /db.initErrorStack {
91: [(ErrorStack)] system_variable /db.ErrorStack set
92: } def
93:
94: /db.where.es {
95: db.ErrorStack setstack
96: /db.arg1 [(StackPointer) ] system_variable 2 sub def
97: %% db.arg1 print
98: 0 1 db.arg1
99: {
100: pop rc message
101: %% pop rc message %% This caused coredump for %%Warning:The identifier...
102: %% This bug was a mistery. (1997, 3/1)
103: %% Perhaps you do not output dollar sign, you get the core.
104: %% I found the missing "%s" in the function printObject() and fixed the
105: %% bug.
106: } for
107: stdstack
108: } def
109:
110:
111: /db.clear.es {
112: db.ErrorStack setstack
113: /db.arg1 [(StackPointer) ] system_variable 2 sub def
114: %% arg1 print
115: 0 1 db.arg1
116: {
117: pop pop
118: } for
119: stdstack
120: } def
121:
122: %%% Usages.
123: [(resolution)
124: [(Efficient resolution is still be tested. See Kan/debug/tower-sugar.sm1)
125: (DMacaulay provides a function to compute resolution in the ring of)
126: (homogenized differential operators. See http://www.math.kobe-u.ac.jp/KAN)
127: ]
128: ] putUsages
129:
130: [(db.where)
131: [(db.where shows the db.VariableStack)
132: (cf. localVariables, restoreVariables,)
133: ( db.clear, db.restore, db.where.ds, db.where.es, debugMode)
134: ]
135: ] putUsages
136:
137: [(db.clear)
138: [(db.clear cleans db.VariableStack)
139: (cf. db.restore, db.where, db.clear.ds, db.clear.es, debugMode)
140: ]
141: ] putUsages
142:
143: [(db.restore)
144: [(db.restore recovers bindings of variables by reading db.VariableStack)
145: (cf. localVariables, restoreVariables,)
146: ( db.clear, db.where , debugMode)
147: ]
148: ] putUsages
149:
150: [(db.where.ds)
151: [(db.where.ds shows the db.DebugStack)
152: (db.DebugStack is used by kan/k? to get error lines.)
153: (cf. db.clear.ds, db.where, debugMode)
154: ]
155: ] putUsages
156:
157: [(db.clear.ds)
158: [(db.clear.ds cleans db.DebugStack)
159: (cf. db.where.ds, db.clear, debugMode)
160: ]
161: ] putUsages
162:
163: [(db.where.es)
164: [(db.where.es shows the db.ErrorStack)
165: (Error and warning messages are put in db.ErrorStack when the global)
166: (variables ErrorMessageMode or WarningMessageMode are set to 1 or 2.)
167: (cf. db.where, system_variable)
168: ]
169: ] putUsages
170:
171: [(db.clear.es)
172: [(db.clear.es cleans db.ErrorStack)
173: (cf. db.clear, db.where.es)
174: ]
175: ] putUsages
176:
177: [(localVariables)
178: [(This function is as same as pushVariables, but it pushes the variable to)
179: (db.VariableStack)
180: (cf. db.where, pushVariables, restoreVariables, debugMode)
181: ]
182: ] putUsages
183:
184: [(restoreVariables)
185: [(This function is as same as popVariables, but it pops the variable from)
186: (db.VariableStack)
187: (cf. db.where, popVariables, localVariables, debugMode)
188: ]
189: ] putUsages
190:
191: /initv { db.initVariableStack db.initDebugStack db.initErrorStack } def
192: initv
193: %% (initv is executed.) message
194:
195: /db.pop.es {
196: db.ErrorStack setstack
197: /db.arg1 set
198: stdstack
199: db.arg1
200: } def
201:
202: /db.pop.ds {
203: db.DebugStack setstack
204: /db.arg1 set
205: stdstack
206: db.arg1
207: } def
208:
209: /db.push.ds {
210: /db.arg1 set
211: db.DebugStack setstack
212: db.arg1
213: stdstack
214: } def
215:
216:
217: %%% if you like rigorous naming system execute the following command.
218: /strictMode {
219: [(Strict2) 1] system_variable
220: [(chattrs) 1] extension
221: [(chattr) 0 /arg1] extension
222: [(chattr) 0 /arg2] extension
223: [(chattr) 0 /arg3] extension
224: [(chattr) 0 /v1] extension %% used in join.
225: [(chattr) 0 /v2] extension
226: [(chattr) 0 /@.usages] extension
227: @@@.quiet.var { }
228: { (var.sm1 : Strict control of the name space is enabled. (cf. extension)) message }
229: ifelse
230: } def
231: [(strictMode)
232: [(StrictMode enables the protection for an unexpected redefinition)]
233: ] putUsages
234:
235: /debugMode {
236: /pushVariables { localVariables } def
237: /popVariables { restoreVariables } def
238: } def
239: [(debugMode)
240: [(debugMode overrides on the functions pushVariables and popVariables)
241: (and enables to use db.where)
242: ]
243: ] putUsages
244:
245: %%%% Test Codes.
246: /foo1 {
247: /arg1 set
248: [/n /val] localVariables
249: /n arg1 def
250: n 2 le
251: {
252: /val 1 def
253: }
254: {
255: /val n 1 sub foo1 n 2 sub foo1 add def
256: } ifelse
257: /arg1 val def
258: restoreVariables
259: arg1
260: } def
261:
262: /test.var.1 {
263: (Now, we are testing new features ErrorStack of sm1 (1997, 3/1 )...) message
264: (ErrorStack:) message
265: [(ErrorStack)] system_variable /db.ErrorStack set
266: db.ErrorStack message
267: db.ErrorStack lc message
268: db.ErrorStack rc message
269: (ErrorMessageMode:) message
270: [(ErrorMessageMode)] system_variable message
271: [(ErrorMessageMode) 2 ] system_variable
272: [(WarningMessageMode) 2 ] system_variable
273: [(ErrorMessageMode)] system_variable message
274:
275: (Cause an error with the mode 1) message
276: 0 1 get %% The macro breaks here.
277: 0 2 get
278: db.where.es
279: db.clear.es
280: db.where.es
281:
282: [(ErrorMessageMode) 0 ] system_variable
283: [(ErrorMessageMode)] system_variable message
284:
285: (Cause an error with the mode 0) message
286: 0 1 get
287: 0 2 get
288: db.where.es
289: } def
290:
291: /test.var {
292: (Now, we are testing new features <<gb>> of sm1 (1997, 3/1 )...) message
293: [(x,y) ring_of_polynomials ( ) elimination_order 0] define_ring
294: [(isReducible) (x^2 y). (x y).] gb message
295: [(lcm) (x y). (y^2).] gb message
296: [(grade) (x^2 y). ] gb message
297: ( --- 1 , xy^2, 3 OK? ----) message
298: (Computing isReducible for 1000 times.... ) messagen
299: { 1 1 1000 { pop [(isReducible) (x^2 y). (x y).] gb pop } for
300: ( ) message } timer
301: (Done) message
302: } def
303: %%% end of test codes.
304: %% end of var.sm1
305:
306:
307:
308:
309:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to var.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan