Return to setvariables.sm1 CVS log

Up to [local] / OpenXM / src / k097 / lib

o import OpenXM sources

%%  incmac.sm1 ,   1996, 4/2
%% macros for the translator.
%%% /goto { pop } def  %% should be changed later.
( incmac.sm1: 2/25, 1997 ) messagen 
%% Note that you cannot use incmac.k as an argument of the local function.
%% BUG: [/incmac.k] pushvarable was [/k] pushVariables, but it caused 
%% error when you try to run a program foo(k) { for (i=0; i<k; i++) ... }.
/mapset {
  /arg2 set /arg1 set
  [/incmac.k ] pushVariables
  0 1 arg1 length 1 sub {
    /incmac.k set
    arg1 incmac.k get
    arg2 incmac.k get
    set
  } for
  popVariables
} def

/a [[1 2] [3 4]] def
/@@@.indexMode {
0 eq {  %%% C-style
 /@@@.indexMode.flag  0 def
 /Get {
 /arg1 set
 [/incmac.k ] pushVariables
 [
   arg1 0 get load
   1 1 arg1 length 1 sub {
      /incmac.k set
      arg1 incmac.k get ..int get
   } for
   /arg1 set
  ] pop 
  popVariables
  arg1
 } def

 /Put {
 /arg2 set
 /arg1 set
 [/incmac.k ] pushVariables
 arg1 0 get load
 [ 1 1 arg1 length 1 sub {
     /incmac.k set
     arg1 incmac.k get ..int
   } for
 ] arg2 put
 popVariables
 } def
} { %% else
 /@@@.indexMode.flag  1 def
 /Get {
 /arg1 set
 [/incmac.k ] pushVariables
 [
   arg1 0 get load
   1 1 arg1 length 1 sub {
      /incmac.k set
      arg1 incmac.k get ..int 1 sub get
   } for
   /arg1 set
  ] pop 
  popVariables
  arg1
 } def

 /Put {
 /arg2 set
 /arg1 set
 [/incmac.k ] pushVariables
 arg1 0 get load
 [ 1 1 arg1 length 1 sub {
     /incmac.k set
     arg1 incmac.k get ..int 1 sub
   } for
 ] arg2 put
 popVariables
 } def
} ifelse
} def

0 @@@.indexMode   %% Default index mode is C-style




%%%%%%%%%%%%  1996, 4/28
%% (2).. NewVector
/NewVector {
  0 get /arg1 set
  arg1 (integer) dc /arg1 set
  [ 1 1 arg1 { pop (0).. } for ]
} def

%% (2).. (3).. NewMatrix
/NewMatrix {
  dup 0 get /arg1 set  
      1 get /arg2 set  
  arg1 (integer) dc /arg1 set
  arg2 (integer) dc /arg2 set
  [1 1 arg1 { pop [arg2] NewVector } for ]
} def

/Join {
  aload pop join
} def


/greaterThanOrEqual {
  /arg2 set /arg1 set
  arg1 arg2 gt { 1 }
  { arg1 arg2 eq {1} {0} ifelse} ifelse
} def

/lessThanOrEqual {
  /arg2 set /arg1 set
  arg1 arg2 lt { 1 }
  { arg1 arg2 eq {1} {0} ifelse} ifelse
} def

/k.mapReplace {  {[[(h). (1).]] replace} map } def
/Dehomogenize {
  0 get /arg1 set
  [
    arg1 isArray not { arg1 [[(h). (1).]] replace } 
    { arg1 0 get isArray not { arg1 k.mapReplace }
                             { arg1 {k.mapReplace} map } ifelse
    } ifelse
    /arg1 set
  ] pop
  arg1
} def




  ( slib.ccc: 8/17,1996 ) message  /Print {
 /Arglist set /FunctionValue [ ] def
 [/a  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 a   messagen /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Println {
 /Arglist set /FunctionValue [ ] def
 [/a  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 a   message /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Ln {
 /Arglist set /FunctionValue [ ] def
 [ ] /ArgNames set ArgNames pushVariables [ %%function body
  ( ) message /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Poly {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f   expand /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/PolyR {
 /Arglist set /FunctionValue [ ] def
 [/f /r  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f  r   ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Degree {
 /Arglist set /FunctionValue [ ] def
 [/f /v  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f  v   degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Append {
 /Arglist set /FunctionValue [ ] def
 [/f /g  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
[ %% function args 
f [ g   ] ] Join
 /FunctionValue set  {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Length {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f   length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Indexed {
 /Arglist set /FunctionValue [ ] def
 [/name /i  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 name  i   s.Indexed /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Indexed2 {
 /Arglist set /FunctionValue [ ] def
 [/name /i /j  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 name  i  j   s.Indexed2 /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Transpose {
 /Arglist set /FunctionValue [ ] def
 [/mat  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 mat   transpose /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

 
/s.Indexed {
  (integer) dc /arg2 set
  /arg1 set
  arg1 ([) arg2 (dollar) dc (]) 4 cat_n
} def

/s.Indexed2 {
  (integer) dc /arg3 set
  (integer) dc /arg2 set
  /arg1 set
  arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
} def
 /Groebner {
 /Arglist set /FunctionValue [ ] def
 [/F  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 F   {[[(h). (1).]] replace homogenize} map /arg1 set
                            [arg1] groebner 0 get 
                            /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/GroebnerTime {
 /Arglist set /FunctionValue [ ] def
 [/F  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 F   {[[(h). (1).]] replace homogenize} map /arg1 set
                            { [arg1] groebner 0 get } timer
                            /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/LiftStd {
 /Arglist set /FunctionValue [ ] def
 [/F  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 F   {[[(h). (1).]] replace homogenize} map /arg1 set
                            [arg1 [(needBack)]] groebner 
                            /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Reduction {
 /Arglist set /FunctionValue [ ] def
 [/f /G  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f  G   reduction /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/IntegerToMachineInteger {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f   (integer) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/RingD {
 /Arglist set /FunctionValue [ ] def
 [/vList /weightMatrix  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
[ %%start of local variables
/new /tmp /size /n /i /j /newtmp /ringpp ] pushVariables [ %%local variables
[ %% function args 
Arglist ] Length
(2)..  lt
 %% if-condition
  { %%ifbody
 [  vList  ring_of_differential_operators ( ) elimination_order 0 ] define_ring
         /tmp set  tmp  /FunctionValue set  {/ExitPoint goto} exec %%return
  }%%end if if body
  { %%if- else part
  } ifelse
/size [ %% function args 
weightMatrix ] Length
 def
/new [ %% function args 
size ] NewVector
 def
  /@@@.indexMode.flag.save @@@.indexMode.flag def    0 @@@.indexMode  /i (0)..  def
%%for init.
%%for
{ i size  lt
 {  } {exit} ifelse
[ {%%increment
/i  i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
/tmp [/weightMatrix i  ]  Get
 def
/n [ %% function args 
tmp ] Length
 def
/newtmp [ %% function args 
n ] NewVector
 def
/j (1)..  def
%%for init.
%%for
{ j n  lt
 {  } {exit} ifelse
[ {%%increment
/j j (2)..  add
 def
} %%end of increment{A}
{%%start of B part{B}
[/newtmp j (1)..  sub
 ] [/tmp j (1)..  sub
 ]  Get
 Put
[/newtmp j  ] [ %% function args 
[/tmp j  ]  Get
] IntegerToMachineInteger
 Put
} %% end of B part. {B}
 2 1 roll] {exec} map
} loop %%end of for
[/new i  ] newtmp  Put
} %% end of B part. {B}
 2 1 roll] {exec} map
} loop %%end of for
/ringpp  [  vList  ring_of_differential_operators   new   weight_vector 0 ] define_ring  def
  @@@.indexMode.flag.save @@@.indexMode  ringpp  /FunctionValue set  {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/getxvar {
 /Arglist set /FunctionValue [ ] def
 [/i  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 [(x) (var)   i   ..int ] system_variable /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/getdvar {
 /Arglist set /FunctionValue [ ] def
 [/i  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 [(D) (var)   i   ..int ] system_variable /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/getvarn {
 /Arglist set /FunctionValue [ ] def
 [ ] /ArgNames set ArgNames pushVariables [ %%function body
 [(N)] system_variable (universalNumber) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/setRingVariables {
 /Arglist set /FunctionValue [ ] def
 [ ] /ArgNames set ArgNames pushVariables [ %%function body
[ %%start of local variables
/n /i /v /f ] pushVariables [ %%local variables
/n [ %% function args 
] getvarn
 def
/i (0)..  def
%%for init.
%%for
{ i n  lt
 {  } {exit} ifelse
[ {%%increment
/i  i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
/v [ %% function args 
i ] getxvar
 def
/f [ %% function args 
v ] Poly
 def
 v   (literal) dc   f   def  /v [ %% function args 
i ] getdvar
 def
/f [ %% function args 
v ] Poly
 def
 v   (literal) dc   f   def  } %% end of B part. {B}
 2 1 roll] {exec} map
} loop %%end of for
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/AddString {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f    aload length cat_n /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/IntegerToString {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f   (string) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Replace {
 /Arglist set /FunctionValue [ ] def
 [/f /rule  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f  rule   replace /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/AsciiToString {
 /Arglist set /FunctionValue [ ] def
 [/c  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 c   (integer) dc (string) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/ToString {
 /Arglist set /FunctionValue [ ] def
 [/p  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
[ %%start of local variables
/n /ans /i ] pushVariables [ %%local variables
/ans [   ]  def
[ %% function args 
p ] IsArray
 %% if-condition
  { %%ifbody
/n [ %% function args 
p ] Length
 def
/ans [ %% function args 
ans ([ ) ] Append
 def
/i (0)..  def
%%for init.
%%for
{ i n  lt
 {  } {exit} ifelse
[ {%%increment
/i  i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
/ans [ %% function args 
ans [ %% function args 
[/p i  ]  Get
] ToString
] Append
 def
i n (1)..  sub
 eq not
 %% if-condition
  { %%ifbody
/ans [ %% function args 
ans ( , ) ] Append
 def
  }%%end if if body
  { %%if- else part
  } ifelse
} %% end of B part. {B}
 2 1 roll] {exec} map
} loop %%end of for
/ans [ %% function args 
ans ( ] ) ] Append
 def
  }%%end if if body
  { %%if- else part
/ans [  p   (dollar) dc    ]  def
  } ifelse
[ %% function args 
ans ] AddString
 /FunctionValue set  {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/IsArray {
 /Arglist set /FunctionValue [ ] def
 [/p  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 p   isArray /FunctionValue set   /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Denominator {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f   (denominator) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Numerator {
 /Arglist set /FunctionValue [ ] def
 [/f  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 f   (numerator) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/Replace {
 /Arglist set /FunctionValue [ ] def
 [/f /rule  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
[ %%start of local variables
/ans /n /tmp /i /num /den ] pushVariables [ %%local variables
[ %% function args 
f ] IsArray
 %% if-condition
  { %%ifbody
/n [ %% function args 
f ] Length
 def
/ans [   ]  def
/i (0)..  def
%%for init.
%%for
{ i n  lt
 {  } {exit} ifelse
[ {%%increment
/i  i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
/ans [ %% function args 
ans [ %% function args 
[/f i  ]  Get
rule ] Replace
] Append
 def
} %% end of B part. {B}
 2 1 roll] {exec} map
} loop %%end of for
ans  /FunctionValue set  {/ExitPoint goto} exec %%return
  }%%end if if body
  { %%if- else part
  } ifelse
 f   tag RationalFunctionP eq   %% if-condition
  { %%ifbody
/num [ %% function args 
f ] Numerator
 def
/den [ %% function args 
f ] Denominator
 def
/num  num  rule   replace   def
/den  den  rule   replace   def
num den  div
 /FunctionValue set  {/ExitPoint goto} exec %%return
  }%%end if if body
  { %%if- else part
  } ifelse
 f  rule   replace /FunctionValue set  /ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

  0 @@@.indexMode  /getxvar {
 /Arglist set /FunctionValue [ ] def
 [/i  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 [(x) (var)   i   ..int ] system_variable /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/getdvar {
 /Arglist set /FunctionValue [ ] def
 [/i  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
 [(D) (var)   i   ..int ] system_variable /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/getvarn {
 /Arglist set /FunctionValue [ ] def
 [ ] /ArgNames set ArgNames pushVariables [ %%function body
 [(N)] system_variable (universalNumber) dc /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/SetRingVariables {
 /Arglist set /FunctionValue [ ] def
 [ ] /ArgNames set ArgNames pushVariables [ %%function body
[ %% function args 
(SetRingVariables() Setting the global variables : ) ] Print
[ %% function args 
(0)..  [(CC)] system_variable (universalNumber) dc  ] setRingVariables002
[ %% function args 
 [(C)] system_variable (universalNumber) dc   [(LL)] system_variable (universalNumber) dc  ] setRingVariables002
[ %% function args 
 [(L)] system_variable (universalNumber) dc   [(MM)] system_variable (universalNumber) dc  ] setRingVariables002
[ %% function args 
 [(M)] system_variable (universalNumber) dc   [(NN)] system_variable (universalNumber) dc  ] setRingVariables002
[ %% function args 
] Ln
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function

/setRingVariables002 {
 /Arglist set /FunctionValue [ ] def
 [/tmp002_p /tmp002_q  ] /ArgNames set ArgNames pushVariables [ %%function body
 Arglist ArgNames mapset
[ %%start of local variables
/tmp002_i /tmp002_v /tmp002_str ] pushVariables [ %%local variables
/tmp002_i tmp002_p  def
%%for init.
%%for
{ tmp002_i tmp002_q  lt
 {  } {exit} ifelse
[ {%%increment
/tmp002_i  tmp002_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
/tmp002_v [ %% function args 
tmp002_i ] getxvar
 def
[ %% function args 
tmp002_v ] Print
[ %% function args 
( ) ] Print
/str [ %% function args 
[ (/) tmp002_v ( $) tmp002_v ($ expand def )   ] ] AddString
 def
 [(parse)   str   ] extension  /tmp002_v [ %% function args 
tmp002_i ] getdvar
 def
[ %% function args 
tmp002_v ] Print
[ %% function args 
( ) ] Print
/str [ %% function args 
[ (/) tmp002_v ( $) tmp002_v ($ expand def )   ] ] AddString
 def
 [(parse)   str   ] extension  } %% end of B part. {B}
 2 1 roll] {exec} map
} loop %%end of for
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
} def
%%end of function