% $OpenXM: OpenXM/src/kan96xx/Kan/var.sm1,v 1.4 2004/09/16 23:53:44 takayama Exp $ %% start of var.sm1. 1997, 2/27 %%(type in initv to initialize the variable stack and type in test.var to start a test) message (var.sm1 : Version 3/7, 1997) message %% Execute debugMode to override pushVariables and popVariables by %% localVariables and restroreVariables. /sm1.var.Verbose 0 def /@@@.quiet.var 1 def @@@.quiet.var { } { (var.sm1 (module for debugging): Version 3/7, 1997. cf. strictMode, debugMode) message } ifelse /db.initVariableStack { 1000 newstack /db.VariableStack set } def /localVariables { { dup [ 3 1 roll load ] } map /db.arg0 set db.VariableStack setstack db.arg0 stdstack } def /restoreVariables { db.VariableStack setstack % dup print { aload pop def } map pop stdstack } def /db.where { db.VariableStack setstack pstack stdstack } def /db.clear { db.VariableStack setstack /db.arg1 [(StackPointer) ] system_variable 2 sub def %% arg1 print 0 1 db.arg1 { pop pop } for stdstack } def /db.restore { %% You cannot use local variable in this function. db.VariableStack setstack /db.arg1 [(StackPointer) ] system_variable 2 sub def 0 1 db.arg1 { pop /db.variableArray set sm1.var.Verbose { db.variableArray print } { } ifelse db.variableArray isArray { db.variableArray length 0 gt { db.variableArray { aload pop def } map pop } { } ifelse } %%% Don't call restoreVariables. Otherwise, stack is set to stdstack. { } ifelse } for stdstack } def /db.initDebugStack { 1000 newstack /db.DebugStack set } def /db.where.ds { db.DebugStack setstack pstack stdstack } def /db.clear.ds { db.DebugStack setstack /db.arg1 [(StackPointer) ] system_variable 2 sub def %% arg1 print 0 1 db.arg1 { pop pop } for stdstack } def /db.initErrorStack { [(ErrorStack)] system_variable /db.ErrorStack set } def /db.where.es { db.ErrorStack setstack /db.arg1 [(StackPointer) ] system_variable 2 sub def %% db.arg1 print 0 1 db.arg1 { pop rc message %% pop rc message %% This caused coredump for %%Warning:The identifier... %% This bug was a mistery. (1997, 3/1) %% Perhaps you do not output dollar sign, you get the core. %% I found the missing "%s" in the function printObject() and fixed the %% bug. } for stdstack } def /db.clear.es { db.ErrorStack setstack /db.arg1 [(StackPointer) ] system_variable 2 sub def %% arg1 print 0 1 db.arg1 { pop pop } for stdstack } def %%% Usages. [(db.where) [(db.where shows the db.VariableStack) (cf. localVariables, restoreVariables,) ( db.clear, db.restore, db.where.ds, db.where.es, debugMode) ] ] putUsages [(db.clear) [(db.clear cleans db.VariableStack) (cf. db.restore, db.where, db.clear.ds, db.clear.es, debugMode) ] ] putUsages [(db.restore) [(db.restore recovers bindings of variables by reading db.VariableStack) (cf. localVariables, restoreVariables,) ( db.clear, db.where , debugMode) ] ] putUsages [(db.where.ds) [(db.where.ds shows the db.DebugStack) (db.DebugStack is used by kan/k? to get error lines.) (cf. db.clear.ds, db.where, debugMode) ] ] putUsages [(db.clear.ds) [(db.clear.ds cleans db.DebugStack) (cf. db.where.ds, db.clear, debugMode) ] ] putUsages [(db.where.es) [(db.where.es shows the db.ErrorStack) (Error and warning messages are put in db.ErrorStack when the global) (variables ErrorMessageMode or WarningMessageMode are set to 1 or 2.) (cf. db.where, system_variable) ] ] putUsages [(db.clear.es) [(db.clear.es cleans db.ErrorStack) (cf. db.clear, db.where.es) ] ] putUsages [(localVariables) [(This function is as same as pushVariables, but it pushes the variable to) (db.VariableStack) (cf. db.where, pushVariables, restoreVariables, debugMode) ] ] putUsages [(restoreVariables) [(This function is as same as popVariables, but it pops the variable from) (db.VariableStack) (cf. db.where, popVariables, localVariables, debugMode) ] ] putUsages /initv { db.initVariableStack db.initDebugStack db.initErrorStack } def initv %% (initv is executed.) message /db.pop.es { db.ErrorStack setstack /db.arg1 set stdstack db.arg1 } def /db.pop.ds { db.DebugStack setstack /db.arg1 set stdstack db.arg1 } def /db.push.ds { /db.arg1 set db.DebugStack setstack db.arg1 stdstack } def %%% if you like rigorous naming system execute the following command. /strictMode { [(Strict2) 1] system_variable [(or_attrs) 1] extension [(chattr) 0 /arg1] extension [(chattr) 0 /arg2] extension [(chattr) 0 /arg3] extension [(chattr) 0 /v1] extension %% used in join. [(chattr) 0 /v2] extension [(chattr) 0 /@.usages] extension [(chattr) 0 /@@@expand.arg1] extension [(chattr) 0 /f-expand] extension [(chattr) 0 /f-ans] extension [(chattr) 0 /in-expand] extension @@@.quiet.var { } { (var.sm1 : Strict control of the name space is enabled. (cf. extension)) message } ifelse } def [(strictMode) [(StrictMode enables the protection for an unexpected redefinition)] ] putUsages /debugMode { /pushVariables { localVariables } def /popVariables { restoreVariables } def } def [(debugMode) [(debugMode overrides on the functions pushVariables and popVariables) (and enables to use db.where. Never execute debugMode inside a block of) (pushVariables and popVariables) ] ] putUsages %%%% Test Codes. /foo1 { /arg1 set [/n /val] localVariables /n arg1 def n 2 le { /val 1 def } { /val n 1 sub foo1 n 2 sub foo1 add def } ifelse /arg1 val def restoreVariables arg1 } def /test.var.1 { (Now, we are testing new features ErrorStack of sm1 (1997, 3/1 )...) message (ErrorStack:) message [(ErrorStack)] system_variable /db.ErrorStack set db.ErrorStack message db.ErrorStack lc message db.ErrorStack rc message (ErrorMessageMode:) message [(ErrorMessageMode)] system_variable message [(ErrorMessageMode) 2 ] system_variable [(WarningMessageMode) 2 ] system_variable [(ErrorMessageMode)] system_variable message (Cause an error with the mode 1) message 0 1 get %% The macro breaks here. 0 2 get db.where.es db.clear.es db.where.es [(ErrorMessageMode) 0 ] system_variable [(ErrorMessageMode)] system_variable message (Cause an error with the mode 0) message 0 1 get 0 2 get db.where.es } def /test.var { (Now, we are testing new features <> of sm1 (1997, 3/1 )...) message [(x,y) ring_of_polynomials ( ) elimination_order 0] define_ring [(isReducible) (x^2 y). (x y).] gb message [(lcm) (x y). (y^2).] gb message [(grade) (x^2 y). ] gb message ( --- 1 , xy^2, 3 OK? ----) message (Computing isReducible for 1000 times.... ) messagen { 1 1 1000 { pop [(isReducible) (x^2 y). (x y).] gb pop } for ( ) message } timer (Done) message } def %%% end of test codes. %% end of var.sm1