File: [local] / OpenXM / src / k097 / slib.sm1 (download)
Revision 1.9, Sat Jan 13 01:17:36 2001 UTC (23 years, 8 months ago) by takayama
Branch: MAIN
CVS Tags: RELEASE_1_2_2, RELEASE_1_2_1 Changes since 1.8: +7 -0
lines
A demo program for my RIMS lecture on slopes of hypergeometric
D-modules.
Slope: computing all slopes.
See Doc/complex.texi for details.
|
K00_verbose %% if-condition
{ %%ifbody
( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message }%%end if if body
{ %%if- else part
} ifelse
[ ] /Helplist set
/HelpAdd {
db.DebugStack setstack $In function : HelpAdd of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /s /category ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n ] pushVariables [ %%local variables
this [ %% function args
Arglist ] {Length} sendmsg2
/n set
n (1).. lessThanOrEqual
%% if-condition
{ %%ifbody
null /category set
}%%end if if body
{ %%if- else part
} ifelse
true %% if-condition
{ %%ifbody
n (1).. eq
n (2).. eq
or
not
%% if-condition
{ %%ifbody
this [ %% function args
s ] {Println} sendmsg2
this [ %% function args
(HelpAdd: wrong argument length.) ] {Error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
category ] {Tag} sendmsg2
(0).. eq
this [ %% function args
category ] {Tag} sendmsg2
(5).. eq
or
not
%% if-condition
{ %%ifbody
this [ %% function args
category ] {Println} sendmsg2
this [ %% function args
(HelpAdd: wrong category.) ] {Error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
s ] {Tag} sendmsg2
(6).. eq
not
%% if-condition
{ %%ifbody
this [ %% function args
s ] {Println} sendmsg2
this [ %% function args
(HelpAdd: s must be an array.) ] {Error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
s [(0).. ] Get
] {Tag} sendmsg2
(5).. eq
not
%% if-condition
{ %%ifbody
this [ %% function args
s ] {Println} sendmsg2
this [ %% function args
(HelpAdd: s[0] must be a string.) ] {Error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
s [(1).. ] Get
] {Tag} sendmsg2
(5).. eq
this [ %% function args
s [(1).. ] Get
] {Tag} sendmsg2
(6).. eq
or
not
%% if-condition
{ %%ifbody
this [ %% function args
s ] {Println} sendmsg2
this [ %% function args
(HelpAdd: s[1] must be a string or an array.) ] {Error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
}%%end if if body
{ %%if- else part
} ifelse
[ category s ] /s set
this [ %% function args
Helplist s ] {Append} sendmsg2
/Helplist set
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/Tag {
db.DebugStack setstack $In function : Tag of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans ] pushVariables [ %%local variables
f etag (universalNumber) dc /ans set
ans /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Error {
db.DebugStack setstack $In function : Error of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
s error /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Print {
db.DebugStack setstack $In function : Print of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a messagen /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Println {
db.DebugStack setstack $In function : Println of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a message /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Ln {
db.DebugStack setstack $In function : Ln of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
( ) message /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Poly {
db.DebugStack setstack $In function : Poly of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f (poly) data_conversion /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/PolyR {
db.DebugStack setstack $In function : PolyR of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /r ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f r ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Degree {
db.DebugStack setstack $In function : Degree of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /v ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f v degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Append {
db.DebugStack setstack $In function : Append of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
f [ g ] ] {Join} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Length {
db.DebugStack setstack $In function : Length of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Transpose {
db.DebugStack setstack $In function : Transpose of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /mat ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
mat transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
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 {
db.DebugStack setstack $In function : Groebner of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
F {[[(h). (1).]] replace homogenize} map /arg1 set
[arg1] groebner 0 get
/FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/GroebnerTime {
db.DebugStack setstack $In function : GroebnerTime of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
F {[[(h). (1).]] replace homogenize} map /arg1 set
{ [arg1] groebner 0 get } timer
/FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/LiftStd {
db.DebugStack setstack $In function : LiftStd of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /F ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
F {[[(h). (1).]] replace homogenize} map /arg1 set
[arg1 [(needBack)]] groebner
/FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Reduction {
db.DebugStack setstack $In function : Reduction of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /myset ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n /indexTable /set2 /i /j /tmp /t_syz /r /rng /vsize /tt ] pushVariables [ %%local variables
null /vsize set
this [ %% function args
this [ %% function args
(1) ] {Poly} sendmsg2
] {GetRing} sendmsg2
/r set
this [ %% function args
f ] {GetRing} sendmsg2
/rng set
this [ %% function args
rng ] {Tag} sendmsg2
(0).. eq
%% if-condition
{ %%ifbody
this [ %% function args
myset ] {GetRing} sendmsg2
/rng set
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
rng ] {Tag} sendmsg2
(0).. eq not
%% if-condition
{ %%ifbody
this [ %% function args
rng ] {SetRing} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
f ] {Length} sendmsg2
/vsize set
[f] fromVectors 0 get /f set }%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
myset ] {Length} sendmsg2
/n set
n (0).. gt
%% if-condition
{ %%ifbody
this [ %% function args
myset [(0).. ] Get
] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
vsize this [ %% function args
myset [(0).. ] Get
] {Length} sendmsg2
eq not
%% if-condition
{ %%ifbody
this [ %% function args
(Reduction: size mismatch.) ] {Error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
myset fromVectors /myset set }%%end if if body
{ %%if- else part
} ifelse
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
n ] {NewArray} sendmsg2
/indexTable set
[ ] /set2 set
(0).. /j set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
myset [i ] Get
] {Tag} sendmsg2
(0).. eq
%% if-condition
{ %%ifbody
indexTable [i ] (1).. (0).. 2 1 roll {sub} sendmsg
Put
}%%end if if body
{ %%if- else part
myset [i ] Get
this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
indexTable [i ] (1).. (0).. 2 1 roll {sub} sendmsg
Put
}%%end if if body
{ %%if- else part
this [ %% function args
set2 myset [i ] Get
] {Append} sendmsg2
/set2 set
indexTable [i ] j Put
/j j (1).. {add} sendmsg2 def
} ifelse
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
f set2 (gradedPolySet) dc reduction /tmp set this [ %% function args
n ] {NewArray} sendmsg2
/t_syz set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
indexTable [i ] Get
(1).. (0).. 2 1 roll {sub} sendmsg
eq not
%% if-condition
{ %%ifbody
t_syz [i ] tmp [(2).. indexTable [i ] Get
] Get
Put
}%%end if if body
{ %%if- else part
t_syz [i ] this [ %% function args
(0) ] {Poly} sendmsg2
Put
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
this [ %% function args
vsize ] {Tag} sendmsg2
(0).. eq not
%% if-condition
{ %%ifbody
tmp [(0).. ] Get
/tt set
[vsize (integer) dc tt] toVectors /tt set tmp [(0).. ] tt Put
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
r ] {SetRing} sendmsg2
[ tmp [(0).. ] Get
tmp [(1).. ] Get
t_syz ] /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/IntegerToSm1Integer {
db.DebugStack setstack $In function : IntegerToSm1Integer of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f (integer) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/RingD {
db.DebugStack setstack $In function : RingD of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /vList /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/new0 /tmp /size /n /i /j /newtmp /ringpp /argsize ] pushVariables [ %%local variables
this [ %% function args
Arglist ] {Length} sendmsg2
/argsize set
this [ %% function args
vList ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
vList {toString} map from_records /vList set }%%end if if body
{ %%if- else part
} ifelse
argsize (1).. eq
%% if-condition
{ %%ifbody
[ vList ring_of_differential_operators ( ) elimination_order 0 ] define_ring
/tmp set this [ %% function args
] {SetRingVariables} sendmsg2
tmp /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
argsize (2).. eq
%% if-condition
{ %%ifbody
(0).. /pp set
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
pp ] {IntegerToSm1Integer} sendmsg2
/pp set
this [ %% function args
weightMatrix ] {Length} sendmsg2
/size set
this [ %% function args
size ] {NewVector} sendmsg2
/new0 set
/@@@.indexMode.flag.save @@@.indexMode.flag def 0 @@@.indexMode (0).. %%PSfor initvalue.
(integer) data_conversion
size (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
weightMatrix [i ] Get
/tmp set
this [ %% function args
tmp ] {Length} sendmsg2
/n set
this [ %% function args
n ] {NewVector} sendmsg2
/newtmp set
(1).. /j set
%%for init.
%%for
{ j n lt
{ } {exit} ifelse
[ {%%increment
j (2).. {add} sendmsg2
/j set
} %%end of increment{A}
{%%start of B part{B}
newtmp [j (1).. {sub} sendmsg2
] tmp [j (1).. {sub} sendmsg2
] Get
Put
newtmp [j ] this [ %% function args
tmp [j ] Get
] {IntegerToSm1Integer} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
new0 [i ] newtmp Put
} for
[ vList ring_of_differential_operators new0 weight_vector pp ] define_ring /ringpp set
this [ %% function args
] {SetRingVariables} sendmsg2
@@@.indexMode.flag.save @@@.indexMode ringpp /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/getxvar {
db.DebugStack setstack $In function : getxvar of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /i ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(x) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/getdvar {
db.DebugStack setstack $In function : getdvar of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /i ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(D) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/getvarn {
db.DebugStack setstack $In function : getvarn of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
[(N)] system_variable (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
false /SetRingVariables_Verbose set
/SetRingVariables {
db.DebugStack setstack $In function : SetRingVariables of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
(SetRingVariables() Setting the global variables : ) ] {Print} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
(0).. [(N)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
%% if-condition
{ %%ifbody
define_ring_variables }%%end if if body
{ %%if- else part
} ifelse
SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
] {Ln} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/k00AreThereLeftBrace {
db.DebugStack setstack $In function : k00AreThereLeftBrace of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/leftBrace /jj /slist ] pushVariables [ %%local variables
$[$ (array) dc 0 get (universalNumber) dc /leftBrace set
this [ %% function args
this [ %% function args
s ] {StringToAsciiArray} sendmsg2
leftBrace ] {Position} sendmsg2
/jj set
jj (1).. (0).. 2 1 roll {sub} sendmsg
eq not
%% if-condition
{ %%ifbody
true /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
false /FunctionValue set {/ExitPoint goto} exec %%return
} ifelse
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/k00setRingVariables {
db.DebugStack setstack $In function : k00setRingVariables of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /p /q ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/v /i ] pushVariables [ %%local variables
p /i set
%%for init.
%%for
{ i q lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
i ] {getxvar} sendmsg2
/v set
this [ %% function args
v ] {k00AreThereLeftBrace} sendmsg2
%% if-condition
{ %%ifbody
false /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
i ] {getdvar} sendmsg2
/v set
this [ %% function args
v ] {k00AreThereLeftBrace} sendmsg2
%% if-condition
{ %%ifbody
false /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
true /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/AddString {
db.DebugStack setstack $In function : AddString of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f aload length cat_n /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/IntegerToString {
db.DebugStack setstack $In function : IntegerToString of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Replace {
db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/AsciiToString {
db.DebugStack setstack $In function : AsciiToString of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /c ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
c (integer) dc (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/ToString {
db.DebugStack setstack $In function : ToString of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /p ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n /ans /i ] pushVariables [ %%local variables
[ ] /ans set
this [ %% function args
p ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
p ] {Length} sendmsg2
/n set
this [ %% function args
ans ([ ) ] {Append} sendmsg2
/ans set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
ans this [ %% function args
p [i ] Get
] {ToString} sendmsg2
] {Append} sendmsg2
/ans set
i n (1).. {sub} sendmsg2
eq not
%% if-condition
{ %%ifbody
this [ %% function args
ans ( , ) ] {Append} sendmsg2
/ans set
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
this [ %% function args
ans ( ] ) ] {Append} sendmsg2
/ans set
}%%end if if body
{ %%if- else part
[ p (dollar) dc ] /ans set
} ifelse
this [ %% function args
ans ] {AddString} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/IsArray {
db.DebugStack setstack $In function : IsArray of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /p ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
p isArray /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Denominator {
db.DebugStack setstack $In function : Denominator of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f (denominator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Numerator {
db.DebugStack setstack $In function : Numerator of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f (numerator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Replace {
db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /n /tmp /i /num /den ] pushVariables [ %%local variables
this [ %% function args
f ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
f ] {Length} sendmsg2
/n set
[ ] /ans set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
ans this [ %% function args
f [i ] Get
rule ] {Replace} sendmsg2
] {Append} sendmsg2
/ans set
} %% end of B part. {B}
2 1 roll] {exec} map pop
} 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
this [ %% function args
f ] {Numerator} sendmsg2
/num set
this [ %% function args
f ] {Denominator} sendmsg2
/den set
num rule replace /num set
den rule replace /den set
num den {div} sendmsg2
/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
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Map {
db.DebugStack setstack $In function : Map of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /karg /func ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
karg { [ 2 -1 roll ] this 2 -1 roll [(parse) func ] extension pop } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Position {
db.DebugStack setstack $In function : Position of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /list /elem ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n /pos /i ] pushVariables [ %%local variables
this [ %% function args
list ] {Length} sendmsg2
/n set
(1).. (0).. 2 1 roll {sub} sendmsg
/pos set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
elem list [i ] Get
eq
%% if-condition
{ %%ifbody
i /pos set
/k00.label0 goto }%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
/k00.label0 pos /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/StringToAsciiArray {
db.DebugStack setstack $In function : StringToAsciiArray of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
s (array) dc { (universalNumber) dc } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/NewArray {
db.DebugStack setstack $In function : NewArray of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /n ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
n ] {NewVector} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/GetEnv {
db.DebugStack setstack $In function : GetEnv of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(getenv) s] extension /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Boundp {
db.DebugStack setstack $In function : Boundp of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/b ] pushVariables [ %%local variables
[(parse) [(/) a ( load tag 0 eq
{ /FunctionValue 0 def }
{ /FunctionValue 1 def } ifelse )] cat ] extension /ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Rest {
db.DebugStack setstack $In function : Rest of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a rest /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/GetPathName {
db.DebugStack setstack $In function : GetPathName of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /s ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/t /sss ] pushVariables [ %%local variables
s /sss set
[(stat) s] extension 0 get /t set this [ %% function args
t ] {Tag} sendmsg2
(0).. eq
%% if-condition
{ %%ifbody
this [ %% function args
[ this [ %% function args
(LOAD_K_PATH) ] {GetEnv} sendmsg2
(/) s ] ] {AddString} sendmsg2
/s set
[(stat) s] extension 0 get /t set this [ %% function args
t ] {Tag} sendmsg2
(0).. eq
%% if-condition
{ %%ifbody
null /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
s /FunctionValue set {/ExitPoint goto} exec %%return
} ifelse
}%%end if if body
{ %%if- else part
s /FunctionValue set {/ExitPoint goto} exec %%return
} ifelse
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Load_sm1 {
db.DebugStack setstack $In function : Load_sm1 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /fnames /flag ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ppp /n /i /cmd ] pushVariables [ %%local variables
this [ %% function args
flag ] {Boundp} sendmsg2
%% if-condition
{ %%ifbody
}%%end if if body
{ %%if- else part
this [ %% function args
fnames ] {Length} sendmsg2
/n set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. {add} sendmsg2 def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
fnames [i ] Get
] {GetPathName} sendmsg2
/ppp set
this [ %% function args
ppp ] {Tag} sendmsg2
(0).. eq not
%% if-condition
{ %%ifbody
[(parse) ppp pushfile ] extension this [ %% function args
[ (/) flag ( 1 def ) ] ] {AddString} sendmsg2
/cmd set
[(parse) cmd ] extension n /i set
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
} ifelse
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/GetRing {
db.DebugStack setstack $In function : GetRing of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f getRing /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/SetRing {
db.DebugStack setstack $In function : SetRing of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /r ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
r ring_def /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/ReParse {
db.DebugStack setstack $In function : ReParse of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/c ] pushVariables [ %%local variables
this [ %% function args
a ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
a (ReParse) ] {Map} sendmsg2
/c set
}%%end if if body
{ %%if- else part
a toString . /c set } ifelse
c /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Pmat {
db.DebugStack setstack $In function : Pmat of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a pmat /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function