Return to var.sm1 CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Several small changes.
1. Changed an algorithm of oxGenPass.
2. The operator "." is equivalent to "exec" when the argument is an executable
   array.  Example.  { 1 2 add }. message
3. The function [(or_attrs) literal] extension is added.
   In strictMode in var.sm1, or_attrs is called instead of chattrs to
   protect all pre-defined symbols.  The function strictMode is called
   from k0 when it starts.

% $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 <<gb>> 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