File: [local] / OpenXM / src / k097 / slib.sm1 (download)
Revision 1.5, Thu Dec 28 00:08:13 2000 UTC (23 years, 9 months ago) by takayama
Branch: MAIN
Changes since 1.4: +20 -0
lines
Added new functions: GetRing, SetRing, DC(*,"polynomial").
|
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 ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
Helplist s ] {Append} sendmsg2
/Helplist set
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} 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
/Indexed {
db.DebugStack setstack $In function : Indexed of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /name /i ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
name i s.Indexed /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Indexed2 {
db.DebugStack setstack $In function : Indexed2 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /name /i /j ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
name i j s.Indexed2 /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 /G ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f G reduction /FunctionValue set /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
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 ] {StringToIntegerArray} 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
this [ %% function args
[ (Map) [ (Map(karg,func) applies the function <<func>> to the <<karg>>(string func).) ( Ex. Map([82,83,85],"AsciiToString"):) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (Position) [ (Position(list,elem) returns the position p of the element <<elem>> in) ( the array <<list>>. If <<elem>> is not in <<list>>, it return -1) ( (array list).) (Ex. Position([1,34,2],34): ) ] ] ] {HelpAdd} sendmsg2
/StringToIntegerArray {
db.DebugStack setstack $In function : StringToIntegerArray 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
this [ %% function args
[ (StringToIntegerArray) [ (StringToIntegerArray(s) decomposes the string <<s>> into an array of) (ascii codes of <<s>> (string s).) (cf. AsciiToString.) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
s ] {StringToIntegerArray} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (StringToAsciiArray) [ (StringToAsciiArray(s) is StringToIntegerArray(s).) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (NewArray) [ (NewArray(n) returns an array of size n (integer n).) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (GetEnv) [ (GetEnv(s) returns the value of the environmental variable s (string s).) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (Boundp) [ (Boundp(s) checks if the symbol s is bounded to a value or not (string s).) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (Rest) [ (Rest(a) returns the rest (cdr) of a (list a).) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (GetPathName) [ (GetPathName(s) checks if the file s exists in the current directory or) (in LOAD_K_PATH. If there exists, it returns the path name (string s).) ] ] ] {HelpAdd} sendmsg2
/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
this [ %% function args
[ (Load_sm1) [ (Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....) (If loading is succeeded, the already-loaded flag is set to true.) ((list s, string flag).) ] ] ] {HelpAdd} sendmsg2
/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