File: [local] / OpenXM / src / k097 / lib / Attic / printSVector.sm1 (download)
Revision 1.1.1.1 (vendor branch), Fri Oct 8 02:12:15 1999 UTC (24 years, 10 months ago) by maekawa
Branch: OpenXM
CVS Tags: maekawa-ipv6, RELEASE_20000124, RELEASE_1_1_3, RELEASE_1_1_2, ALPHA Changes since 1.1: +0 -0
lines
o import OpenXM sources
|
%% incmac.sm1 , 1996, 4/2
%% macros for the translator.
%%% /goto { pop } def %% should be changed later.
( incmac.sm1: 8/15, 1996 ) 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
[ %% function args
(printSVector.ccc 1996, 8/17) ] Println
/printSVector {
/Arglist set /FunctionValue [ ] def
[/keys ] /ArgNames set ArgNames pushVariables [ %%function body
Arglist ArgNames mapset
[ %%start of local variables
/i /j /n /max /width /m /k /kk /tmp0 ] pushVariables [ %%local variables
/n [ %% function args
keys ] Length
def
/max (0).. 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}
[ %% function args
[/keys i ] Get
] Length
max gt
%% if-condition
{ %%ifbody
/max [ %% function args
[/keys i ] Get
] Length
def
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map
} loop %%end of for
/max max (3).. add
def
/width (80).. def
/m (0).. def
%%while
{ m max mul
(80).. lt
{ } {exit} ifelse
/m m (1).. add
def
} loop
/k (0).. def
/kk (0).. 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}
[ %% function args
[/keys i ] Get
] Print
/kk kk (1).. add
def
/k k [ %% function args
[/keys i ] Get
] Length
add
def
/tmp0 max [ %% function args
[/keys i ] Get
] Length
sub
def
/j (0).. def
%%for init.
%%for
{ j tmp0 lt
{ } {exit} ifelse
[ {%%increment
/j j (1).. add def
} %%end of increment{A}
{%%start of B part{B}
/k k (1).. add
def
kk m lt
%% if-condition
{ %%ifbody
[ %% function args
( ) ] Print
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map
} loop %%end of for
kk m greaterThanOrEqual
%% if-condition
{ %%ifbody
/kk (0).. def
/k (0).. def
[ %% function args
] Ln
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map
} loop %%end of for
[ %% function args
] Ln
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
FunctionValue } def
%%end of function