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