File: [local] / OpenXM / src / k097 / debug / ahg2.k.sm1 (download)
Revision 1.1.1.1 (vendor branch), Fri Oct 8 02:12:16 1999 UTC (24 years, 8 months ago) by maekawa
Branch: OpenXM, MAIN
CVS Tags: maekawa-ipv6, R_1_3_1-2, RELEASE_20000124, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, RELEASE_1_1_3, RELEASE_1_1_2, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9, ALPHA
Changes since 1.1: +0 -0
lines
o import OpenXM sources
|
/K00_verbose 0 def
%% start of var.sm1. 1997, 2/27
%%(type in initv to initialize the variable stack and type in test.var to start a test) message
/sm1.var.Verbose 0 def
/@@@.quiet.var 1 def
@@@.quiet.var { }
{ (var.sm1 (module for debugging): Version 3/7, 1997. cf. strictMode, debugMode) message } ifelse
/db.initVariableStack {
1000 newstack /db.VariableStack set
} def
/localVariables {
{ dup [ 3 1 roll load ] } map /db.arg0 set
db.VariableStack setstack db.arg0 stdstack
} def
/restoreVariables {
db.VariableStack setstack
% dup print
{ aload pop def } map pop
stdstack
} def
/db.where {
db.VariableStack setstack
pstack
stdstack
} def
/db.clear {
db.VariableStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% arg1 print
0 1 db.arg1
{
pop pop
} for
stdstack
} def
/db.restore { %% You cannot use local variable in this function.
db.VariableStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
0 1 db.arg1
{
pop /db.variableArray set
sm1.var.Verbose { db.variableArray print } { } ifelse
db.variableArray isArray
{ db.variableArray length 0 gt
{
db.variableArray { aload pop def } map pop
}
{ } ifelse
}
%%% Don't call restoreVariables. Otherwise, stack is set to stdstack.
{ } ifelse
} for
stdstack
} def
/db.initDebugStack { 1000 newstack /db.DebugStack set } def
/db.where.ds {
db.DebugStack setstack
pstack
stdstack
} def
/db.clear.ds {
db.DebugStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% arg1 print
0 1 db.arg1
{
pop pop
} for
stdstack
} def
/db.initErrorStack {
[(ErrorStack)] system_variable /db.ErrorStack set
} def
/db.where.es {
db.ErrorStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% db.arg1 print
0 1 db.arg1
{
pop rc message
%% pop rc message %% This caused coredump for %%Warning:The identifier...
%% This bug was a mistery. (1997, 3/1)
%% Perhaps you do not output dollar sign, you get the core.
%% I found the missing "%s" in the function printObject() and fixed the
%% bug.
} for
stdstack
} def
/db.clear.es {
db.ErrorStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% arg1 print
0 1 db.arg1
{
pop pop
} for
stdstack
} def
%%% Usages.
[(resolution)
[(Only slow version of resolution is implemented in kan/sm1.)
(DMacaulay provides a function to compute resolution in the ring of)
(differential operators. See http://www.math.s.kobe-u.ac.jp/KAN)
]
] putUsages
[(db.where)
[(db.where shows the db.VariableStack)
(cf. localVariables, restoreVariables,)
( db.clear, db.restore, db.where.ds, db.where.es, debugMode)
]
] putUsages
[(db.clear)
[(db.clear cleans db.VariableStack)
(cf. db.restore, db.where, db.clear.ds, db.clear.es, debugMode)
]
] putUsages
[(db.restore)
[(db.restore recovers bindings of variables by reading db.VariableStack)
(cf. localVariables, restoreVariables,)
( db.clear, db.where , debugMode)
]
] putUsages
[(db.where.ds)
[(db.where.ds shows the db.DebugStack)
(db.DebugStack is used by kan/k? to get error lines.)
(cf. db.clear.ds, db.where, debugMode)
]
] putUsages
[(db.clear.ds)
[(db.clear.ds cleans db.DebugStack)
(cf. db.where.ds, db.clear, debugMode)
]
] putUsages
[(db.where.es)
[(db.where.es shows the db.ErrorStack)
(Error and warning messages are put in db.ErrorStack when the global)
(variables ErrorMessageMode or WarningMessageMode are set to 1 or 2.)
(cf. db.where, system_variable)
]
] putUsages
[(db.clear.es)
[(db.clear.es cleans db.ErrorStack)
(cf. db.clear, db.where.es)
]
] putUsages
[(localVariables)
[(This function is as same as pushVariables, but it pushes the variable to)
(db.VariableStack)
(cf. db.where, pushVariables, restoreVariables, debugMode)
]
] putUsages
[(restoreVariables)
[(This function is as same as popVariables, but it pops the variable from)
(db.VariableStack)
(cf. db.where, popVariables, localVariables, debugMode)
]
] putUsages
/initv { db.initVariableStack db.initDebugStack db.initErrorStack } def
initv
%% (initv is executed.) message
/db.pop.es {
db.ErrorStack setstack
/db.arg1 set
stdstack
db.arg1
} def
/db.pop.ds {
db.DebugStack setstack
/db.arg1 set
stdstack
db.arg1
} def
/db.push.ds {
/db.arg1 set
db.DebugStack setstack
db.arg1
stdstack
} def
%%% if you like rigorous naming system execute the following command.
/strictMode {
[(Strict2) 1] system_variable
[(chattrs) 1] extension
[(chattr) 0 /arg1] extension
[(chattr) 0 /arg2] extension
[(chattr) 0 /arg3] extension
[(chattr) 0 /v1] extension %% used in join.
[(chattr) 0 /v2] extension
[(chattr) 0 /@.usages] extension
@@@.quiet.var { }
{ (var.sm1 : Strict control of the name space is enabled. (cf. extension)) message }
ifelse
} def
[(strictMode)
[(StrictMode enables the protection for an unexpected redefinition)]
] putUsages
/debugMode {
/pushVariables { localVariables } def
/popVariables { restoreVariables } def
} def
[(debugMode)
[(debugMode overrides on the functions pushVariables and popVariables)
(and enables to use db.where)
]
] putUsages
%%%% Test Codes.
/foo1 {
/arg1 set
[/n /val] localVariables
/n arg1 def
n 2 le
{
/val 1 def
}
{
/val n 1 sub foo1 n 2 sub foo1 add def
} ifelse
/arg1 val def
restoreVariables
arg1
} def
/test.var.1 {
(Now, we are testing new features ErrorStack of sm1 (1997, 3/1 )...) message
(ErrorStack:) message
[(ErrorStack)] system_variable /db.ErrorStack set
db.ErrorStack message
db.ErrorStack lc message
db.ErrorStack rc message
(ErrorMessageMode:) message
[(ErrorMessageMode)] system_variable message
[(ErrorMessageMode) 2 ] system_variable
[(WarningMessageMode) 2 ] system_variable
[(ErrorMessageMode)] system_variable message
(Cause an error with the mode 1) message
0 1 get %% The macro breaks here.
0 2 get
db.where.es
db.clear.es
db.where.es
[(ErrorMessageMode) 0 ] system_variable
[(ErrorMessageMode)] system_variable message
(Cause an error with the mode 0) message
0 1 get
0 2 get
db.where.es
} def
/test.var {
(Now, we are testing new features <<gb>> of sm1 (1997, 3/1 )...) message
[(x,y) ring_of_polynomials ( ) elimination_order 0] define_ring
[(isReducible) (x^2 y). (x y).] gb message
[(lcm) (x y). (y^2).] gb message
[(grade) (x^2 y). ] gb message
( --- 1 , xy^2, 3 OK? ----) message
(Computing isReducible for 1000 times.... ) messagen
{ 1 1 1000 { pop [(isReducible) (x^2 y). (x y).] gb pop } for
( ) message } timer
(Done) message
} def
%%% end of test codes.
%% end of var.sm1
%% incmac.sm1 , 1996, 4/2.
%% macros for the translator.
%%% /goto { pop } def %% should be changed later.
%( incmac.sm1: 4/16, 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} primmsg {
/incmac.k set
arg1 incmac.k get
arg2 incmac.k get
set
} for
popVariables
} def
%%% a [i] b Put <=== a[i] = b;
%%% a [i] Get <=== a[i]
/a [[1 2] [3 4]] def
/@@@.indexMode {
0 eq { %%% C-style
/@@@.indexMode.flag 0 def
/Get {
/arg2 set
/arg1 set
[/incmac.k ] pushVariables
[
arg1
0 1 arg2 length 1 {sub} primmsg {
/incmac.k set
arg2 incmac.k get ..int get
} for
/arg1 set
] pop
popVariables
arg1
} def
/Put {
/arg3 set
/arg2 set
/arg1 set
[/incmac.k ] pushVariables
arg1
[ 0 1 arg2 length 1 {sub} primmsg {
/incmac.k set
arg2 incmac.k get ..int
} for
] arg3 put
popVariables
} def
} { %% else
(Warning: Do not use indexmode 1.) message
(Warning: Do not use indexmode 1.) message
/@@@.indexMode.flag 1 def
/Get {
/arg1 set
[/incmac.k ] pushVariables
[
arg1 0 get load
1 1 arg1 length 1 {sub} primmsg {
/incmac.k set
arg1 incmac.k get ..int 1 {sub} primmsg 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} primmsg {
/incmac.k set
arg1 incmac.k get ..int 1 {sub} primmsg
} 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
pop %% remove this
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
pop %% remove this
arg1 (integer) dc /arg1 set
arg2 (integer) dc /arg2 set
[1 1 arg1 { pop this [arg2] NewVector } for ]
} def
/Join {
2 -1 roll pop %% remove this.
aload pop join
} def
/lessThanOrEqual {
/arg2 set /arg1 set
arg1 arg2 lt { 1 }
{ arg1 arg2 eq {1} {0} ifelse} ifelse
} def
%%% For objects
/this null def
/PrimitiveContextp StandardContextp def
/PrimitiveObject [PrimitiveContextp] def
/showln { pop message } def
/KxxTrash0 { % we do not need.
/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
} def
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 expand /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 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
@@@.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
true /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).. [(CC)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
this [ %% function args
[(C)] system_variable (universalNumber) dc [(LL)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
this [ %% function args
[(L)] system_variable (universalNumber) dc [(MM)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
this [ %% function args
[(M)] system_variable (universalNumber) dc [(NN)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2
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 /tmp002_p /tmp002_q ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/tmp002_i /tmp002_v /tmp002_str ] pushVariables [ %%local variables
tmp002_p %%PSfor initvalue.
(integer) data_conversion
tmp002_q (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /tmp002_i set
this [ %% function args
tmp002_i ] {getxvar} sendmsg2
/tmp002_v set
this [ %% function args
tmp002_v ] {k00AreThereLeftBrace} sendmsg2
%% if-condition
{ %%ifbody
}%%end if if body
{ %%if- else part
SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
tmp002_v ] {Print} sendmsg2
this [ %% function args
( ) ] {Print} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
[ (/) tmp002_v ( $) tmp002_v ($ expand def ) ] ] {AddString} sendmsg2
/str set
[(parse) str ] extension } ifelse
this [ %% function args
tmp002_i ] {getdvar} sendmsg2
/tmp002_v set
this [ %% function args
tmp002_v ] {k00AreThereLeftBrace} sendmsg2
%% if-condition
{ %%ifbody
}%%end if if body
{ %%if- else part
SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
tmp002_v ] {Print} sendmsg2
this [ %% function args
( ) ] {Print} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
[ (/) tmp002_v ( $) tmp002_v ($ expand def ) ] ] {AddString} sendmsg2
/str set
[(parse) str ] extension } ifelse
} for
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} 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 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 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 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
%% This package requires kan/sm1 version 951228 or later.
%% The binary file of kan/sm1 of this version is temporary obtainable from
%% ftp.math.s.kobe-u.ac.jp. The file /pub/kan/sm1.binary.sunos4.3.japanese
%% is for sun with JLE.
%% How to Install
%% 1.Copy this file and rename it to sm1 (mv sm1.binary.sunos4.3.japanese sm1).
%% 2.Add executable property (chmod +x sm1).
%% NEW feature of factor-b.sm1. [ ---> kanLeftBrace, ] ---> kanRightBrace
{
(factor-b.sm1 : kan/sm1 package to factor polynomials by calling risa/asir.)
message
( : kan/sm1 package to simplify rationals by calling risa/asir.)
message
( CANCEL HAS NOT BEEN TESTED.) message
( : kan/sm1 package to compute hilbert polynomials by calling sm0.)
message
( Version March 5, 1997. It runs on kan/sm1 version 951228 or later.) message
}
[(factor)
[(polynomial factor list_of_strings)
(Example: (x^2-1). factor :: ---> [[$1$ $1$] [$x-1$ $1$] [$x+1$ $1$]])
(cf.: data_conversion, map, get, pushfile)
(Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
( asir-tmp-out.t, asir-tmp-log.t and asir-tmp-out.tt )
( in the current directory.)
]
] putUsages
%% /f (Dx^10*d*a-d*a) def
/factor-asir-1 {
/arg1 set
[/f /fd /fnewline] pushVariables
[
arg1 /f set
%%(factor-asir-1 is tested with Asir version 950831 on Linux.) message
(asir-tmp.t) (w) file /fd set
/fnewline { fd 10 (string) data_conversion writestring } def
fd $output("asir-tmp-out.t");$ writestring fnewline
fd $fctr($ writestring
fd f writestring
fd $); output(); quit(); $ writestring fnewline
fd closefile
(/bin/rm -f asir-tmp.tt) system
(sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" | sed "s/\[/kanLeftBrace/g" | sed "s/\]/kanRightBrace/g" | sed "s/\,/kanComma/g" >asir-tmp.tt) system
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
(asir <asir-tmp.tt >asir-tmp-log.t) system
(sed "s/\[1\]/ /g" asir-tmp-out.t | sed "s/\[2\]/ /g" | sed "1s/1/ /g"| sed "s/\[/{/g" | sed "s/\]/}/g" | sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" | sed "s/kanLeftBrace/\[/g" | sed "s/kanRightBrace/\]/g" | sed "s/kanComma/\,/g" >asir-tmp-out.tt) system
] pop
popVariables
} def
/clean-workfiles {
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp.t asir-tmp.tt sm0-tmp.t sm0-tmp-out.t asir-tmp-log.t sm0-tmp-out.tt) system
} def
%% comment: there is not data conversion function from string --> array
%% e.g. (abc) ---> [0x61, 0x62, 0x63]
%% We can do (abc) 1 10 put, but "get" does not work for strings.
%% f factor-asir-1
%%/aaa
%% ({{1,1},{x-1,1},{x+1,1},{x^4+x^3+x^2+x+1,1},{x^4-x^3+x^2-x+1,1}})
%%def
/asir-list-to-kan {
/arg1 set
[/aaa /ftmp /ftmp2] pushVariables
[
/aaa arg1 def
[ aaa to_records pop ] /ftmp set
ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
/arg1 ftmp2 def
] pop
popVariables
arg1
} def
/foo {
(input string is in f) message
f ::
f factor-asir-1
%% (asir-tmp-out.tt) run
%% (answer in @asir.out) message
%% bug of run.
(asir-tmp-out.tt) pushfile /@asir.out set
@asir.out asir-list-to-kan /ff2 set
(answer in ff2) message
} def
/factor {
(string) data_conversion
factor-asir-1
(asir-tmp-out.tt) pushfile asir-list-to-kan
} def
%%%%%%%%%%%%%%%%% macros for simplification (reduction, cancel)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
[(cancel)
[(polynomial cancel list_of_strings)
(This function simplifies rationals.)
(Example: $x^2-1$. $x+1$. div cancel :: ---> [[$x-1$ , $1$]])
(Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
( in the current directory.)
]
] putUsages
/reduce-asir-1 {
/arg1 set
[/f /fd /fnewline] pushVariables
[
arg1 /f set
%% (reduce-asir-1 is tested with Asir version 950831 on Linux.) message
(asir-tmp.t) (w) file /fd set
/fnewline { fd 10 (string) data_conversion writestring } def
fd $output("asir-tmp-out.t");$ writestring fnewline
fd $AsirTmp012=red($ writestring
fd f writestring
fd $)$ writestring
fd ($ ) writestring fnewline
fd $[[nm(AsirTmp012), dn(AsirTmp012)]];output();quit(); $ writestring fnewline
fd closefile
(/bin/rm -f asir-tmp.tt) system
(sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
(asir <asir-tmp.tt >asir-tmp-log.t) system
(sed "s/\[1\]/ /g" asir-tmp-out.t | sed "s/\[2\]/ /g" |sed "s/\[3\]/ /g" | sed "1s/1/ /g"| sed "s/\[/{/g" | sed "s/\]/}/g" | sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" | sed "s/kanLeftBrace/\[/g" | sed "s/kanRightBrace/\]/g" | sed "s/kanComma/\,/g" >asir-tmp-out.tt) system
] pop
popVariables
} def
/cancel {
(string) data_conversion
reduce-asir-1
(asir-tmp-out.tt) pushfile asir-list-to-kan
} def
%%%%%%%%%%%%%%%%% macros for Hilbert functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/hilbert {
/arg2 set
/arg1 set
[/bases /vars] pushVariables
[
/bases arg1 def
/vars arg2 def
bases {init (string) data_conversion} map /bases set
bases vars execSm0
(sed '1s/^\$/{/g' sm0-tmp-out.t | sed '1s/\$$/ , /g' | sed '2s/^\$//g' | sed '2s/\$$/}/g' | sed 's/V//g' >sm0-tmp-out.tt) system
] pop
popVariables
[ (sm0-tmp-out.tt) pushfile to_records pop]
} def
[(hilbert)
[(------------------------------------------------------------------------)
(list_of_polynomials variables hilbert hilbert_function)
(Example: [(x^2-1). (x y -2).] (x,y) hilbert :: ---> [$...$ $,,,$] )
(cf.: data_conversion, map, get, pushfile)
(Note: The function call creates work files sm0-tmp.t, sm0-tmp-out.tt,)
( sm0-tmp-log.t and sm0-tmp-out.t in the current directory.)
]
] putUsages
%% Ex. [(x^2) (y^3) (x y)] (x,y) execSm0
/execSm0 {
/arg2 set
/arg1 set
[/monoms /fd /tmp /vars] pushVariables
[
/monoms arg1 def
/vars arg2 def
(/bin/rm -f sm0-tmp-out.t sm0-tmp-out.tt sm0-tmp-log.t) system
(sm0-tmp.t) (w) file /fd set
fd ( ${-p,0}$ options ) writestring
fd ( $) writestring
${$ vars $}$ 3 cat_n /tmp set
fd tmp writestring
fd ($ ) writestring
fd ( polynomial_ring set_up_ring ${-proof}$ options ) writestring
fd monoms writeArray
fd ( /ff = ff yaGroebner /gg = gg hilbert2 /ans = ) writestring
fd (ans :: ans decompose $sm0-tmp-out.t$ printn_to_file quit) writestring
fd closefile
(sm0 -f sm0-tmp.t >sm0-tmp-log.t) system
(When the output is [$ a V^k + ... $ $p!$], the multiplicity is ) message
$ (k! a)/p! $ message
( ) message
] pop
popVariables
} def
/writeArray {
/arg2 set /arg1 set
[/fd /arr /k] pushVariables
[ /fd arg1 def
/arr arg2 def
fd ([ ) writestring
0 1 arr length 1 sub
{
/k set
fd ($ ) writestring
fd arr k get writestring
fd ($ ) writestring
} for
fd ( ] ) writestring
] pop
popVariables
} def
%%(Loaded macros "factor", "hilbert".) message
[(primadec)
[([polynomials] [variables] primadec list_of_strings)
(cf.: data_conversion, map, get, pushfile)
(Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
( asir-tmp-out.t, asir-tmp-log.t and asir-tmp-out.tt )
( in the current directory.)
]
] putUsages
/sendcommand-to-asir2 { %% arg1 arg2 command sendcommand-to-asir2
/arg3 set /arg2 set /arg1 set
[/f /fd /fnewline /com /g] pushVariables
[
arg1 /f set arg2 /g set arg3 /com set
(asir-tmp.t) (w) file /fd set
/fnewline { fd 10 (string) data_conversion writestring } def
fd $load("gr"); load("primdec"); output("asir-tmp-out.t");$ writestring fnewline
fd com $($ 2 cat_n writestring
fd f writestring
fd $,$ writestring
fd g writestring
fd $); output(); quit(); $ writestring fnewline
fd closefile
(/bin/rm -f asir-tmp.tt) system
(sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
(asir <asir-tmp.tt >asir-tmp-log.t) system
(sed "s/\[147\]/ /g" asir-tmp-out.t | sed "s/\[148\]/ /g" | sed "1s/1/ /g"| sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" >asir-tmp-out.tt) system
] pop
popVariables
} def
/clean-workfiles {
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp.t asir-tmp.tt sm0-tmp.t sm0-tmp-out.t asir-tmp-log.t sm0-tmp-out.tt) system
} def
/asir-list-to-kan {
/arg1 set
[/aaa /ftmp /ftmp2] pushVariables
[
/aaa arg1 def
[ aaa to_records pop ] /ftmp set
ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
/arg1 ftmp2 def
] pop
popVariables
arg1
} def
/primadec {
/arg2 set /arg1 set
[/f /g] pushVariables
[
/f arg1 def /g arg2 def
f { (string) dc removeBrace } map toString
g { (string) dc removeBrace } map toString (primadec)
sendcommand-to-asir2
(asir-tmp-out.tt) pushfile asir-list-to-kan /arg1
] pop popVariables
arg1
} def
/removeBrace { %% string removeBrace string
%% (z[1]^2-1) removeBrace (z_1 ^2-1)
/arg1 set
[/f /i /ans /fa] pushVariables
[
/f arg1 def f 1 copy /f set
f (array) dc /fa set
0 1 fa length 1 sub {
/i set
fa i get 91 eq
{ f i 95 put }
{ } ifelse
fa i get 93 eq
{ f i 32 put }
{ } ifelse
} for
% fa aload length cat_n /arg1 set %% This may cause operand stack overflow.
f /arg1 set
] pop
popVariables
arg1
} def
K00_verbose %% if-condition
{ %%ifbody
this [ %% function args
(help.k (help.ccc). 8/6, 1996 --- 8/7, 1996. 3/6, 1997 --- 4/29, 1997.) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
/help {
db.DebugStack setstack $In function : help of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /x ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
Arglist ] {Length} sendmsg2
(1).. lt
%% if-condition
{ %%ifbody
this [ %% function args
( ) ] {ShowKeyWords} sendmsg2
}%%end if if body
{ %%if- else part
this [ %% function args
x ] {Help} sendmsg2
} ifelse
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Help {
db.DebugStack setstack $In function : Help of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /key ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n /i /item /m /item1 /j ] pushVariables [ %%local variables
this [ %% function args
Arglist ] {Length} sendmsg2
(1).. lt
%% if-condition
{ %%ifbody
this [ %% function args
( ) ] {ShowKeyWords} sendmsg2
[ ] /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
key (ALL) eq
%% if-condition
{ %%ifbody
this [ %% function args
(ALL) ] {ShowKeyWords} sendmsg2
(0).. /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
Helplist ] {Length} sendmsg2
/n set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
Helplist [i ] Get
/item set
item [(0).. ] Get
key eq
%% if-condition
{ %%ifbody
this [ %% function args
item [(1).. ] Get
] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
item [(1).. ] Get
/item1 set
this [ %% function args
item1 ] {Length} sendmsg2
/m set
(0).. /j set
%%for init.
%%for
{ j m lt
{ } {exit} ifelse
[ {%%increment
/j j (1).. add def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
item1 [j ] Get
] {Println} sendmsg2
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
}%%end if if body
{ %%if- else part
this [ %% function args
item [(1).. ] Get
] {Println} sendmsg2
} ifelse
item /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
} for
this [ %% function args
(The key word <<) ] {Print} sendmsg2
this [ %% function args
key ] {Print} sendmsg2
this [ %% function args
(>> could not be found.) ] {Println} 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
/ShowKeyWords {
db.DebugStack setstack $In function : ShowKeyWords of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /ss ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/i /j /n /keys /max /width /m /k /kk /tmp0 ] pushVariables [ %%local variables
this [ %% function args
] {Ln} sendmsg2
this [ %% function args
Helplist ] {Length} sendmsg2
/n set
[ ( ) ] /keys set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
keys Helplist [i (0).. ] Get
] {Append} sendmsg2
/keys set
} for
keys shell /keys set
this [ %% function args
keys ] {Length} sendmsg2
/n set
ss (ALL) eq
%% if-condition
{ %%ifbody
(1).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
(# ) ] {Print} sendmsg2
this [ %% function args
keys [i ] Get
] {Print} sendmsg2
this [ %% function args
] {Ln} sendmsg2
this [ %% function args
keys [i ] Get
] {Help} sendmsg2
this [ %% function args
] {Ln} sendmsg2
} for
(0).. /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
(0).. /max set
(1).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
keys [i ] Get
] {Length} sendmsg2
max gt
%% if-condition
{ %%ifbody
this [ %% function args
keys [i ] Get
] {Length} sendmsg2
/max set
}%%end if if body
{ %%if- else part
} ifelse
} for
max (3).. {add} sendmsg2
/max set
(80).. /width set
(0).. /m set
%%while
{ m max {mul} sendmsg2
(80).. lt
{ } {exit} ifelse
m (1).. {add} sendmsg2
/m set
} loop
m (1).. gt
%% if-condition
{ %%ifbody
m (1).. {sub} sendmsg2
/m set
}%%end if if body
{ %%if- else part
} ifelse
(0).. /k set
(0).. /kk set
(1).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
keys [i ] Get
] {Print} sendmsg2
kk (1).. {add} sendmsg2
/kk set
k this [ %% function args
keys [i ] Get
] {Length} sendmsg2
{add} sendmsg2
/k set
max this [ %% function args
keys [i ] Get
] {Length} sendmsg2
{sub} sendmsg2
/tmp0 set
k tmp0 {add} sendmsg2
/k set
kk m lt
%% if-condition
{ %%ifbody
[ 0 1 tmp0 (integer) dc 1 sub { pop $ $ } for ] aload length cat_n messagen }%%end if if body
{ %%if- else part
} ifelse
kk m greaterThanOrEqual
%% if-condition
{ %%ifbody
(0).. /kk set
(0).. /k set
this [ %% function args
] {Ln} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
} for
this [ %% function args
] {Ln} sendmsg2
this [ %% function args
(Type in Help(keyword); to see a help message (string keyword).) ] {Println} sendmsg2
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/ShowKeyWordsOfSm1 {
db.DebugStack setstack $In function : ShowKeyWordsOfSm1 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /ss ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/i /j /n /keys /max /width /m /k /kk /tmp0 ] pushVariables [ %%local variables
this [ %% function args
] {Ln} sendmsg2
/help_Sm1Macro @.usages def this [ %% function args
help_Sm1Macro ] {Length} sendmsg2
/n set
[ ( ) ] /keys set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
keys help_Sm1Macro [i (0).. ] Get
] {Append} sendmsg2
/keys set
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
keys shell /keys set
this [ %% function args
keys ] {Length} sendmsg2
/n set
ss (ALL) eq
%% if-condition
{ %%ifbody
(1).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
keys [i ] Get
/tmp0 set
this [ %% function args
(# ) ] {Print} sendmsg2
this [ %% function args
tmp0 ] {Print} sendmsg2
this [ %% function args
] {Ln} sendmsg2
tmp0 usage this [ %% function args
] {Ln} sendmsg2
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
(0).. /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
(0).. /max set
(1).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
keys [i ] Get
] {Length} sendmsg2
max gt
%% if-condition
{ %%ifbody
this [ %% function args
keys [i ] Get
] {Length} sendmsg2
/max set
}%%end if if body
{ %%if- else part
} ifelse
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
max (3).. {add} sendmsg2
/max set
(80).. /width set
(0).. /m set
%%while
{ m max {mul} sendmsg2
(80).. lt
{ } {exit} ifelse
m (1).. {add} sendmsg2
/m set
} loop
(0).. /k set
(0).. /kk set
(1).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
keys [i ] Get
] {Print} sendmsg2
kk (1).. {add} sendmsg2
/kk set
k this [ %% function args
keys [i ] Get
] {Length} sendmsg2
{add} sendmsg2
/k set
max this [ %% function args
keys [i ] Get
] {Length} sendmsg2
{sub} sendmsg2
/tmp0 set
kk m greaterThanOrEqual
%% if-condition
{ %%ifbody
}%%end if if body
{ %%if- else part
(0).. /j set
%%for init.
%%for
{ j tmp0 lt
{ } {exit} ifelse
[ {%%increment
/j j (1).. add def
} %%end of increment{A}
{%%start of B part{B}
k (1).. {add} sendmsg2
/k set
this [ %% function args
( ) ] {Print} sendmsg2
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
} ifelse
kk m greaterThanOrEqual
%% if-condition
{ %%ifbody
(0).. /kk set
(0).. /k set
this [ %% function args
] {Ln} sendmsg2
}%%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
] {Ln} sendmsg2
this [ %% function args
] {Ln} sendmsg2
this [ %% function args
(Type in (keyword) usage ; to see a help message.) ] {Println} sendmsg2
/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
[ (Help) (Help(key) shows an explanation on the key (string key).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (HelpAdd) [ (HelpAdd([key,explanation]) (string key, string explanation)) ( or (string key, array explanation).) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (load) [ (load(fname) loads the file << fname >>(string fname).) (load fname loads the file << fname >>.) (load[fname] loads the file << fname >> with the preprocessing by /lib/cpp.) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Ln) (Ln() newline.) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Println) (Println(f) prints f and goes to the new line.) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Print) (Print(f) prints f.) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Poly) (Poly(name) returns the polynomial name in the current ring
(string name).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (PolyR) (PolyR(name,r) returns the polynomial name in the ring r
(string name, ring r).
Ex. r = RingD("x,y"); y = PolyR("y",r); ) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (RingD) [ (RingD(names) defines a new ring (string names).) (RingD(names,weight_vector) defines a new ring with the weight vector) ((string names, array weight_vector).) (RingD(names,weight_vector,characteristic)) ( Ex. RingD("x,y",[["x",2,"y",1]]) ) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Reduction) (Reduction(f,G) returns the remainder and sygygies when
f is devided by G (polynomial f, array G).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (AddString) (AddString(list) returns the concatnated string (array list).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (AsciiToString) (AsciiToString(ascii_code) returns the string of which
ascii code is ascii_code (integer ascii_code).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (ToString) (ToString(obj) transforms the <<obj>> to a string.) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Numerator) (Numerator(f) returns the numerator of <<f>> (rational f).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Denominator) (Denominator(f) returns the denominator of <<f>> (rational f).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Replace) (Replace(f,rule) (polynomial f, array rule).
Ex. Replace( (x+y)^3, [[x,Poly("1")]])) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (SetRingVariables) (SetRingVariables()
Set the generators of the current ring as global variables.
cf. RingD(), Poly(), PolyR()) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Append) (Append([f1,...,fn],g) returns the list [f1,...,fn,g]) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Join) (Join([f1,...,fn],[g1,...,gm]) returns the list
[f1,...,fn,g1,...,gm]) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Indexed) (Indexed(name,i) returns the string name[i]
(string name, integer i)) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (-ReservedName1) [ (The names k00*, K00*, sm1* , arg1,arg2,arg3,arg4,....,) (Helplist, Arglist, FunctionValue,) (@@@*, db.*, k.*, tmp002*, tmp00* are used for system functions.) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (IntegerToSm1Integer) (IntegerToSm1Integer(i) translates integer i
to sm1.integer (integer i).) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (true) (true returns sm1.integer 1.) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (false) (false returns sm1.integer 0.) ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (IsArray) [ (If f is the array object, then IsArray(f) returns true,) (else IsArray(f) returns false.) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Init_w) [ (Init_w(f,vars,w) returns the initial terms with respect to the) (weight vector <<w>> (array of integer) of the polynomial <<f>>) ((polynomial). Here, <<f>> is regarded as a polynomial with respect) (to the variables <<vars>> (array of polynomials).) (Example: Init_w(x^2+y^2+x,[x,y],[1,1]):) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (RingDonIndexedVariables) [ (RingDonIndexedVariables(name,n) defines and returns the ring of) (homogenized differential operators) (Q<h, name[0], ..., name[n-1], Dname[0], ..., Dname[n-1]>) (where <<name>> is a string and <<n>> is an integer.) (Note that this function defines global variables) (h, name[0], ..., name[n-1], Dname[0], ..., Dname[n-1].) (Example: RingDonIndexedVariables("x",3).) (RingDonIndexedVariables(name,n,w) defines and returns the ring of) (homogenized differential operators with the ordering defined by ) (the weight vector <<w>> (array)) (Example: RingDonIndexedVariables("x",3,[["x[0]",1,"x[2]",3]]).) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Groebner) [ (Groebner(input) returns Groebner basis of the left module (or ideal)) (defined by <<input>> (array of polynomials)) (The order is that of the ring to which each element of <<input>>) (belongs.) (The input is automatically homogenized.) (Example: RingD("x,y",[["x" 10 "y" 1]]);) ( Groebner([Poly(" x^2+y^2-4"),Poly(" x*y-1 ")]):) (cf. RingD, Homogenize) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (RingPoly) [ (RingPoly(names) defines a Ring of Polyomials (string names).) (The names of variables of that ring are <<names>> and ) (the homogenization variable h.) (cf. SetRingVariables, RingD) (Example: R=RingPoly("x,y");) ( ) (RingPoly(names,weight_vector) defines a Ring of Polynomials) (with the order defined by the << weight_vector >>) ((string names, array of array weight_vector).) (RingPoly(names,weight_vector,characteristic)) (Example: R=RingPoly("x,y",[["x",10,"y",1]]);) ( (x+y)^10: ) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (CancelNumber) [ (CancelNumber(rn) reduces the rational number <<rn>>) ((rational rn).) (Example: CancelNumber( 2/6 ) : ) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (IsString) [ (IsString(obj) returns true if << obj >> is a string (object obj).) (Example: if (IsString("abc")) Println("Hello"); ;) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (IsSm1Integer) [ (IsSm1Integer(obj) returns true if << obj >> is an integer of sm1(object obj).) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (sm1) [ (sm1(arg1,arg2,...) is used to embed sm1 native code in the kxx program.) (Example: sm1( 2, 2, " add print "); ) (Example: def myadd(a,b) { sm1(a,b," add /FunctionValue set "); }) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (DC) [ (DC(obj,key) converts << obj >> to a new object in the primitive) (class << key >> (object obj, string key)) (Example: DC(" (x+1)^10 ", "polynomial"): ) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Length) [ (Length(vec) returns the length of the array << vec >>) ((array vec)) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Transpose) [ (Transpose(m) return the transpose of the matrix << m >>) ((array of array m).) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Save) [ (Save(obj) appends << obj >> to the file sm1out.txt (object obj).) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Coefficients) [ (Coefficients(f,v) returns [exponents, coefficients] of << f >>) (with respect to the variable << v >>) ((polynomial f,v).) (Example: Coefficients(Poly("(x+1)^2"),Poly("x")): ) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (System) [ (System(comm) executes the unix system command << comm >>) ((string comm)) (Example: System("ls");) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Exponent) [ (Expoent(f,vars) returns the vector of exponents of the polynomial f) (Ex. Exponent( x^2*y-1,[x,y])) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (Protect) [ (Protect(name) protects the symbol <<name>> (string)) (Protect(name,level) protects the symbol <<name>> (string) with ) (<<level>> ) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (IsPolynomial) [ (IsPolynomial(f) returns true if <<f>> (object) is a polynomial.) ] ] ] {HelpAdd} sendmsg2
/RingPoly {
db.DebugStack setstack $In function : RingPoly 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_polynomials ( ) elimination_order 0 ] define_ring
/tmp set 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).. /i set
%%for init.
%%for
{ i size lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
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
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
[ vList ring_of_polynomials new0 weight_vector pp ] define_ring /ringpp set
@@@.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
/IsString {
db.DebugStack setstack $In function : IsString of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /ob ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
ob isString /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/IsSm1Integer {
db.DebugStack setstack $In function : IsSm1Integer of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /ob ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
ob isInteger /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/CancelNumber {
db.DebugStack setstack $In function : CancelNumber of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /rn ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/tmp ] pushVariables [ %%local variables
[(cancel) rn ] mpzext /tmp set this [ %% function args
tmp ] {IsInteger} sendmsg2
%% if-condition
{ %%ifbody
tmp /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
tmp (denominator) dc (1).. eq { /FunctionValue tmp (numerator) dc def} { /FunctionValue tmp def } ifelse /ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/DC {
db.DebugStack setstack $In function : DC of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /obj /key ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
key (string) eq
%% if-condition
{ %%ifbody
this [ %% function args
obj ] {ToString} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
key (integer) eq
%% if-condition
{ %%ifbody
(universalNumber) /key set
}%%end if if body
{ %%if- else part
key (sm1integer) eq
%% if-condition
{ %%ifbody
(integer) /key set
}%%end if if body
{ %%if- else part
key (polynomial) eq
%% if-condition
{ %%ifbody
(poly) /key set
}%%end if if body
{ %%if- else part
} ifelse
} ifelse
} ifelse
} ifelse
obj key data_conversion /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 /m ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
m transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Save {
db.DebugStack setstack $In function : Save of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /obj ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
obj output /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/System {
db.DebugStack setstack $In function : System of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /comm ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
comm system /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/IsReducible {
db.DebugStack setstack $In function : IsReducible of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ (isReducible) f g ] gbext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/IsPolynomial {
db.DebugStack setstack $In function : IsPolynomial of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f isPolynomial /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/k00.toric0.mydegree {2 1 roll degree} def /Exponent {
db.DebugStack setstack $In function : Exponent of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /vars ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n /i /ans ] pushVariables [ %%local variables
f this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
[ ] /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
f /ff.tmp set vars {ff.tmp k00.toric0.mydegree (universalNumber) dc }map /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Protect {
db.DebugStack setstack $In function : Protect of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /name /level ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/n /str ] pushVariables [ %%local variables
this [ %% function args
Arglist ] {Length} sendmsg2
/n set
n (1).. eq
%% if-condition
{ %%ifbody
(1).. /level set
this [ %% function args
[ ([(chattr) ) this [ %% function args
level ] {ToString} sendmsg2
( /) name ( ) ( ] extension pop ) ] ] {AddString} sendmsg2
/str set
[(parse) str ] extension pop }%%end if if body
{ %%if- else part
n (2).. eq
%% if-condition
{ %%ifbody
this [ %% function args
[ ([(chattr) ) this [ %% function args
level ] {ToString} sendmsg2
( /) name ( ) ( ] extension pop ) ] ] {AddString} sendmsg2
/str set
[(parse) str ] extension pop }%%end if if body
{ %%if- else part
this [ %% function args
(Protect) (Arguments must be one or two. ) ] {k00_error} sendmsg2
error } ifelse
} ifelse
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/k00_error {
db.DebugStack setstack $In function : k00_error of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /name /msg ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
(Error in ) ] {Print} sendmsg2
this [ %% function args
name ] {Print} sendmsg2
this [ %% function args
(. ) ] {Print} sendmsg2
this [ %% function args
msg ] {Println} sendmsg2
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/Init {
db.DebugStack setstack $In function : Init of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
f ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
f (Init) ] {Map} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
this [ %% function args
f ] {IsPolynomial} sendmsg2
%% if-condition
{ %%ifbody
f init /FunctionValue set }%%end if if body
{ %%if- else part
this [ %% function args
(Init) (Argment must be polynomial or an array of polynomials) ] {k00_error} sendmsg2
error } ifelse
} ifelse
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (Init) [ (Init(f) returns the initial term of the polynomial <<f>> (polynomial)) (Init(list) returns the array of initial terms of the array of polynomials) (<< list >> (array)) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
[ (NewMatrix) [ (NewMatrix(m,n) returns the (m,n)-matrix (array) with the entries 0.) ] ] ] {HelpAdd} sendmsg2
/Eliminatev {
db.DebugStack setstack $In function : Eliminatev of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /list /var ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
list var eliminatev /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (Eliminatev) [ (Eliminatev(list,var) prunes polynomials in << list >>(array of polynomials)) (which contains the variables in << var >> ( array of strings )) (Example: Eliminatev([Poly(" x+h "),Poly(" x ")],[ "h" ]): ) ] ] ] {HelpAdd} sendmsg2
/ReducedBase {
db.DebugStack setstack $In function : ReducedBase of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /base ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
base reducedBase /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (ReducedBase) [ (ReducedBase[base] prunes redundant elements in the Grobner basis <<base>> (array).) ] ] ] {HelpAdd} sendmsg2
/IndexedVariables {
db.DebugStack setstack $In function : IndexedVariables of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /name /size ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/result /i /result2 ] pushVariables [ %%local variables
[ ] /result set
(0).. /i set
%%for init.
%%for
{ i size (1).. {sub} sendmsg2
lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
this [ %% function args
result this [ %% function args
name i ] {Indexed} sendmsg2
] {Append} sendmsg2
/result set
this [ %% function args
result (,) ] {Append} sendmsg2
/result set
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
size (1).. {sub} sendmsg2
(0).. greaterThanOrEqual
%% if-condition
{ %%ifbody
this [ %% function args
result this [ %% function args
name size (1).. {sub} sendmsg2
] {Indexed} sendmsg2
] {Append} sendmsg2
/result set
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
[ ({) ] result ] {Join} sendmsg2
/result2 set
this [ %% function args
result2 [ (}) ] ] {Join} sendmsg2
/result2 set
this [ %% function args
result2 ] {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
this [ %% function args
[ (IndexedVariables) [ (IndexedVariables(name,size) returns the string ) ( {name[0],name[1],...,name[size-1]} which can be used as inputs to ) ( the function RingD (string name, integer size).) ( cf. RingDonIndexedVariables.) ( Ex. R = RingD(IndexedVariables("a",3)); ) ( h = Poly("h");) ( a = NewArray(3);) ( for (i=0; i<3; i++) {a[i] = Poly(Indexed("a",i));} ;) ] ] ] {HelpAdd} sendmsg2
/RingDonIndexedVariables {
db.DebugStack setstack $In function : RingDonIndexedVariables of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /vList /size /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/myring /tmp /k00_i /argsize /vListD ] pushVariables [ %%local variables
this [ %% function args
Arglist ] {Length} sendmsg2
/argsize set
argsize (1).. eq
%% if-condition
{ %%ifbody
this [ %% function args
(Error (IndexedRingD): ) ] {Println} sendmsg2
null /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
argsize (2).. eq
%% if-condition
{ %%ifbody
this [ %% function args
[ (D) vList ] ] {AddString} sendmsg2
/vListD set
this [ %% function args
this [ %% function args
vList size ] {IndexedVariables} sendmsg2
] {RingD} sendmsg2
/myring set
this [ %% function args
] {SetRingVariables} sendmsg2
this [ %% function args
size ] {NewArray} sendmsg2
/tmp set
(0).. /k00_i set
%%for init.
%%for
{ k00_i size lt
{ } {exit} ifelse
[ {%%increment
/k00_i k00_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
tmp [k00_i ] this [ %% function args
this [ %% function args
vList k00_i ] {Indexed} sendmsg2
] {Poly} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
vList (literal) dc tmp def this [ %% function args
size ] {NewArray} sendmsg2
/tmp set
(0).. /k00_i set
%%for init.
%%for
{ k00_i size lt
{ } {exit} ifelse
[ {%%increment
/k00_i k00_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
tmp [k00_i ] this [ %% function args
this [ %% function args
vListD k00_i ] {Indexed} sendmsg2
] {Poly} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
vListD (literal) dc tmp def SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
(Set the global variables ) ] {Print} sendmsg2
[(parse) vList ] extension pop print [(parse) vListD ] extension pop print this [ %% function args
] {Ln} sendmsg2
}%%end if if body
{ %%if- else part
[(parse) vList ] extension pop [(parse) vListD ] extension pop } ifelse
myring /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
argsize (3).. eq
argsize (4).. eq
or
%% if-condition
{ %%ifbody
argsize (3).. eq
%% if-condition
{ %%ifbody
(0).. /pp set
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
[ (D) vList ] ] {AddString} sendmsg2
/vListD set
this [ %% function args
this [ %% function args
vList size ] {IndexedVariables} sendmsg2
weightMatrix pp ] {RingD} sendmsg2
/myring set
this [ %% function args
] {SetRingVariables} sendmsg2
this [ %% function args
size ] {NewArray} sendmsg2
/tmp set
(0).. /k00_i set
%%for init.
%%for
{ k00_i size lt
{ } {exit} ifelse
[ {%%increment
/k00_i k00_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
tmp [k00_i ] this [ %% function args
this [ %% function args
vList k00_i ] {Indexed} sendmsg2
] {Poly} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
vList (literal) dc tmp def this [ %% function args
size ] {NewArray} sendmsg2
/tmp set
(0).. /k00_i set
%%for init.
%%for
{ k00_i size lt
{ } {exit} ifelse
[ {%%increment
/k00_i k00_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
tmp [k00_i ] this [ %% function args
this [ %% function args
vListD k00_i ] {Indexed} sendmsg2
] {Poly} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
vListD (literal) dc tmp def SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
(Set the global variables ) ] {Print} sendmsg2
[(parse) vList ] extension pop print [(parse) vListD ] extension pop print this [ %% function args
] {Ln} sendmsg2
}%%end if if body
{ %%if- else part
[(parse) vList ] extension pop [(parse) vListD ] extension pop } ifelse
myring /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
(1).. (0).. 2 1 roll {sub} sendmsg
/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
/Ringp {
db.DebugStack setstack $In function : Ringp of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f (ring) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (Ringp) [ (Ringp(f) ( polynomial f ) returns the ring to which the polynomial << f >>) (belongs.) ] ] ] {HelpAdd} sendmsg2
/Coefficients {
db.DebugStack setstack $In function : Coefficients of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /v ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /exp ] pushVariables [ %%local variables
f v coefficients /ans set
ans [(0).. ] Get
/exp set
exp { (universalNumber) dc } map /exp set
[ exp ans [(1).. ] Get
] /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
/IsInteger {
db.DebugStack setstack $In function : IsInteger of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a isUniversalNumber /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (IsInteger) [ (IsInteger(a) returns true if << a >> is an integer (object a).) (It returns false if << a >> is not.) (cf. IsSm1Integer) ] ] ] {HelpAdd} sendmsg2
/IsRational {
db.DebugStack setstack $In function : IsRational of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a isRational /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (IsRational) [ (IsRational(a) returns true if << a >> is a rational (object a).) (It returns false if << a >> is not.) ] ] ] {HelpAdd} sendmsg2
/IsDouble {
db.DebugStack setstack $In function : IsDouble of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a isDouble /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (IsDouble) [ (IsDouble(a) returns true if << a >> is a double (object a).) (It returns false if << a >> is not.) ] ] ] {HelpAdd} sendmsg2
/cs { this [ ] Cleards } def /Init_w {
db.DebugStack setstack $In function : Init_w of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /vars /weight ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/w /top /ans /wtop ] pushVariables [ %%local variables
f this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
this [ %% function args
(0) ] {Poly} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
f init /top set
this [ %% function args
top vars ] {Exponent} sendmsg2
weight {mul} sendmsg2
/w set
w /wtop set
top /ans set
f top {sub} sendmsg2
/f set
%%while
{ true { } {exit} ifelse
f this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
exit }%%end if if body
{ %%if- else part
} ifelse
f init /top set
this [ %% function args
top vars ] {Exponent} sendmsg2
weight {mul} sendmsg2
/w set
w wtop lt
%% if-condition
{ %%ifbody
exit }%%end if if body
{ %%if- else part
} ifelse
ans top {add} sendmsg2
/ans set
f top {sub} sendmsg2
/f set
} loop
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
this [ %% function args
[ (Mapto) [ (Mapto(obj,ring) parses << obj >> as elements of the << ring >>.) ((ring << ring >>, polynomial << obj >> or array of polynomial << obj >>).) (Ex. R = RingD("x,y"); SetRingVariables();) ( f = (x+y)^2; R2 = RingD("x,y,z",[["y",1]]); ) ( f2 = Mapto(f,R2); f2: ) ] ] ] {HelpAdd} sendmsg2
/Mapto {
db.DebugStack setstack $In function : Mapto of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /obj /ring ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /i /n ] pushVariables [ %%local variables
this [ %% function args
obj ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
obj ] {Length} sendmsg2
/n set
this [ %% function args
obj (ToString) ] {Map} sendmsg2
/ans set
(0).. /i set
%%for init.
%%for
{ i n lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
ans [i ] this [ %% function args
ans [i ] Get
ring ] {PolyR} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
}%%end if if body
{ %%if- else part
this [ %% function args
obj ] {ToString} sendmsg2
/ans set
this [ %% function args
ans ring ] {PolyR} sendmsg2
/ans set
} ifelse
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
this [ %% function args
[ (ToDouble) [ (ToDouble(f) translates << f >> into double when it is possible) (object << f >>.) (Example: ToDouble([1,1/2,[5]]): ) ] ] ] {HelpAdd} sendmsg2
/k00_toDouble {
db.DebugStack setstack $In function : k00_toDouble of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
f (double) ] {DC} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/ToDouble {
db.DebugStack setstack $In function : ToDouble of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
f ] {IsArray} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
f (ToDouble) ] {Map} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {IsDouble} sendmsg2
%% if-condition
{ %%ifbody
f /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {k00_toDouble} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/RingPonIndexedVariables {
db.DebugStack setstack $In function : RingPonIndexedVariables of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /vList /size /weightMatrix ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/myring /tmp /k00_i /argsize /vListD ] pushVariables [ %%local variables
this [ %% function args
Arglist ] {Length} sendmsg2
/argsize set
argsize (1).. eq
%% if-condition
{ %%ifbody
this [ %% function args
(Error (RingPonIndexedVariables): ) ] {Println} sendmsg2
null /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
argsize (2).. eq
%% if-condition
{ %%ifbody
this [ %% function args
this [ %% function args
vList size ] {IndexedVariables} sendmsg2
] {RingPoly} sendmsg2
/myring set
this [ %% function args
] {SetRingVariables} sendmsg2
this [ %% function args
size ] {NewArray} sendmsg2
/tmp set
(0).. /k00_i set
%%for init.
%%for
{ k00_i size lt
{ } {exit} ifelse
[ {%%increment
/k00_i k00_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
tmp [k00_i ] this [ %% function args
this [ %% function args
vList k00_i ] {Indexed} sendmsg2
] {Poly} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
vList (literal) dc tmp def SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
(Set the global variables ) ] {Print} sendmsg2
[(parse) vList ] extension pop print this [ %% function args
] {Ln} sendmsg2
}%%end if if body
{ %%if- else part
[(parse) vList ] extension pop } ifelse
myring /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
argsize (3).. eq
%% if-condition
{ %%ifbody
this [ %% function args
this [ %% function args
vList size ] {IndexedVariables} sendmsg2
weightMatrix ] {RingPoly} sendmsg2
/myring set
this [ %% function args
] {SetRingVariables} sendmsg2
this [ %% function args
size ] {NewArray} sendmsg2
/tmp set
(0).. /k00_i set
%%for init.
%%for
{ k00_i size lt
{ } {exit} ifelse
[ {%%increment
/k00_i k00_i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
tmp [k00_i ] this [ %% function args
this [ %% function args
vList k00_i ] {Indexed} sendmsg2
] {Poly} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
vList (literal) dc tmp def SetRingVariables_Verbose %% if-condition
{ %%ifbody
this [ %% function args
(Set the global variables ) ] {Print} sendmsg2
[(parse) vList ] extension pop print this [ %% function args
] {Ln} sendmsg2
}%%end if if body
{ %%if- else part
[(parse) vList ] extension pop } ifelse
myring /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
(1).. (0).. 2 1 roll {sub} sendmsg
/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
[ (RingPonIndexedVariables) [ (RingPonIndexedVariables(name,n) defines and returns the ring of) (polynomials) (Q<h, name[0], ..., name[n-1] >) (where <<name>> is a string and <<n>> is an integer.) (Note that this function defines global variables) (h, name[0], ..., name[n-1].) (Example: RingPonIndexedVariables("x",3).) (RingPonIndexedVariables(name,n,w) defines and returns the ring of) (polynomials with the ordering defined by ) (the weight vector <<w>> (array)) (Example: RingPonIndexedVariables("x",3,[["x[0]",1,"x[2]",3]]).) ] ] ] {HelpAdd} sendmsg2
/Mod {
db.DebugStack setstack $In function : Mod of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /n ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
f ] {IsPolynomial} sendmsg2
%% if-condition
{ %%ifbody
[(mod) f n ] gbext /FunctionValue set }%%end if if body
{ %%if- else part
this [ %% function args
f ] {IsInteger} sendmsg2
%% if-condition
{ %%ifbody
Gmp [ %% function args
f n ] {Mod} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
} ifelse
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (Mod) [ (Mod(f,p) returns f modulo n where << f >> (polynomial) and) ( << p >> (integer). ) ] ] ] {HelpAdd} sendmsg2
/Characteristic {
db.DebugStack setstack $In function : Characteristic of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /ringp ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/r /p ] pushVariables [ %%local variables
[(CurrentRingp)] system_variable /r set
[(CurrentRingp) ringp ] system_variable [(P)] system_variable (universalNumber) dc /p set
[(CurrentRingp) r ] system_variable p /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
[ (Characteristic) [ (Characteristic(ring) returns the characteristic of the << ring >>.) ] ] ] {HelpAdd} sendmsg2
/IsConstant {
db.DebugStack setstack $In function : IsConstant of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
f ] {Length} sendmsg2
(1).. gt
%% if-condition
{ %%ifbody
false /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
[(isConstant) f ] gbext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (IsConstant) [ (IsConstant(f) returns true if the polynomial << f >> is a constant.) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
(Default ring is Z[x,h].) ] {Println} sendmsg2
this [ %% function args
(x) ] {Poly} sendmsg2
/x set
this [ %% function args
(h) ] {Poly} sendmsg2
/h set
/Substitute {
db.DebugStack setstack $In function : Substitute of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /xx /g ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/tmp /coeff /ex /i /n /newex ] pushVariables [ %%local variables
this [ %% function args
f ] {IsInteger} sendmsg2
%% if-condition
{ %%ifbody
f /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {IsPolynomial} sendmsg2
not
%% if-condition
{ %%ifbody
this [ %% function args
(Substitute) (The first argument must be polynomial.) ] {k00_error} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f xx ] {Coefficients} sendmsg2
/tmp set
tmp [(1).. ] Get
/coeff set
tmp [(0).. ] Get
/ex set
this [ %% function args
ex ] {Length} sendmsg2
/n set
this [ %% function args
n ] {NewVector} sendmsg2
/newex set
n (0).. gt
%% if-condition
{ %%ifbody
newex [n (1).. {sub} sendmsg2
] g ex [n (1).. {sub} sendmsg2
] Get
power
Put
}%%end if if body
{ %%if- else part
} ifelse
n (2).. {sub} sendmsg2
/i set
%%for init.
%%for
{ i (0).. greaterThanOrEqual
{ } {exit} ifelse
[ {%%increment
/i i (1).. sub def
} %%end of increment{A}
{%%start of B part{B}
newex [i ] newex [i (1).. {add} sendmsg2
] Get
g ex [i ] Get
ex [i (1).. {add} sendmsg2
] Get
{sub} sendmsg2
power
{mul} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
this [ %% function args
coeff newex {mul} sendmsg2
] {Cancel} 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
this [ %% function args
[ (Substitute) [ (Substitute(f,xx,g) replaces << xx >> in << f >> by << g >>.) (This function takes coeffients of << f >> with respect to << xx >>) (and returns the inner product of the vector of coefficients and the vector) (of which elements are g^(corresponding exponent).) (Note that it may cause an unexpected result in non-commutative rings.) ] ] ] {HelpAdd} sendmsg2
K00_verbose %% if-condition
{ %%ifbody
this [ %% function args
( debug/db.k (db.ccc), 1997, 3/2 (Sun) : checking debug functions of kxx) ] {Println} sendmsg2
this [ %% function args
( Type in test0(). ) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
/pushVariables {localVariables} def /popVariables {restoreVariables} def K00_verbose %% if-condition
{ %%ifbody
this [ %% function args
( Overloaded on pushVariables and popVariables.) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
[(CatchCtrlC) 1] system_variable [(Strict) 1] system_variable K00_verbose %% if-condition
{ %%ifbody
this [ %% function args
( ctrl-C signal is caught in KSexecuteString() and <<Warning>> is regarded as an error.) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
/test0 {
db.DebugStack setstack $In function : test0 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
[(ErrorMessageMode) 2] system_variable [(WarningMessageMode) 2] system_variable this [ %% function args
(15).. ] {fib} sendmsg2
db.where.es /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Where {
db.DebugStack setstack $In function : Where of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
this [ %% function args
(CurrentContext is ...) ] {Println} sendmsg2
[(CurrentContextp)] system_variable {message} primmsg this [ %% function args
(VariableStack trace is....) ] {Println} sendmsg2
db.where this [ %% function args
(DebugStack trace is ....) ] {Println} sendmsg2
db.where.ds this [ %% function args
(To clear VariableStack, DebugStack and ErrorStack, type in Cleards().) ] {Println} sendmsg2
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/Cleards {
db.DebugStack setstack $In function : Cleards of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
this [ %% function args
(Clearing DebugStack and ErrorStack...) ] {Print} sendmsg2
db.clear.ds db.clear.es this [ %% function args
( ) ] {Println} sendmsg2
this [ %% function args
(Restoring variables....) ] {Print} sendmsg2
db.restore [ ] localVariables this [ %% function args
(Done) ] {Println} sendmsg2
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/fib {
db.DebugStack setstack $In function : fib of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /n ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /a /b ] pushVariables [ %%local variables
this [ %% function args
(fib of ) ] {Print} sendmsg2
this [ %% function args
n ] {Println} sendmsg2
n (2).. lt
%% if-condition
{ %%ifbody
(1).. /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
n (1).. {sub} sendmsg2
/a set
n (2).. {sub} sendmsg2
/b set
a (11).. eq
%% if-condition
{ %%ifbody
a [i ] (2).. Put
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
a ] {fib} sendmsg2
this [ %% function args
b ] {fib} sendmsg2
{add} sendmsg2
/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
K00_verbose %% if-condition
{ %%ifbody
this [ %% function args
(debug/asir0.k you need to start k0 with -f option. ) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
/Factor {
db.DebugStack setstack $In function : Factor of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
f factor /FunctionValue set clean-workfiles /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (Factor) [ ( Not Yet. <<need asir, start k0 with -f option.>>) ] ] ] {HelpAdd} sendmsg2
/Cancel {
db.DebugStack setstack $In function : Cancel 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
/tmp /den /num ] pushVariables [ %%local variables
this [ %% function args
f ] {IsRational} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
this [ %% function args
f ] {Denominator} sendmsg2
] {Cancel} sendmsg2
/den set
this [ %% function args
this [ %% function args
f ] {Numerator} sendmsg2
] {Cancel} sendmsg2
/num set
this [ %% function args
den ] {IsInteger} sendmsg2
this [ %% function args
num ] {IsInteger} sendmsg2
and
%% if-condition
{ %%ifbody
this [ %% function args
num den {div} sendmsg2
] {CancelNumber} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
den ] {IsInteger} sendmsg2
%% if-condition
{ %%ifbody
[(divByN) num den ] gbext /tmp set
tmp [(1).. ] Get
this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
this [ %% function args
tmp [(0).. ] Get
] {Cancel} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
f /FunctionValue set {/ExitPoint goto} exec %%return
} ifelse
}%%end if if body
{ %%if- else part
} ifelse
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {IsInteger} sendmsg2
%% if-condition
{ %%ifbody
f /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {IsPolynomial} sendmsg2
%% if-condition
{ %%ifbody
f this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
(0).. /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
this [ %% function args
f ] {Ringp} sendmsg2
] {Characteristic} sendmsg2
(0).. eq not
%% if-condition
{ %%ifbody
f /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {IsConstant} sendmsg2
%% if-condition
{ %%ifbody
this [ %% function args
f (integer) ] {DC} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
f /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
f cancel /FunctionValue set clean-workfiles /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
[ (Cancel) [ ( Not Yet. <<need asir, start k0 with -f option>>) ] ] ] {HelpAdd} sendmsg2
/Primadec {
db.DebugStack setstack $In function : Primadec 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 primadec /FunctionValue set clean-workfiles /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (Primadec) [ ( Not Yet. <<need asir, start k0 with -f option.>>) ] ] ] {HelpAdd} sendmsg2
this [ %% function args
(showln) (0).. ] {Protect} sendmsg2
[ $Object$ PrimitiveObject 0 get newcontext ] /Object set
Object 0 get setcontext
/new0 {
db.DebugStack setstack $In function : new0 of class Object$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
Object /FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/showln {
db.DebugStack setstack $In function : showln of class Object$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
this [ %% function args
this ] {Println} sendmsg2
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/getClass {
db.DebugStack setstack $In function : getClass of class Object$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
this 0 get /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
PrimitiveContextp setcontext /ectag { dup isClass not { pop -1 } { lc } ifelse } def /k00ecTag {
db.DebugStack setstack $In function : k00ecTag of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
a ectag /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/IsObject {
db.DebugStack setstack $In function : IsObject of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
this [ %% function args
a ] {IsArray} sendmsg2
not
%% if-condition
{ %%ifbody
false /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
a ] {Length} sendmsg2
(1).. lt
%% if-condition
{ %%ifbody
false /FunctionValue set {/ExitPoint goto} exec %%return
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
a [(0).. ] Get
] {k00ecTag} sendmsg2
this [ %% function args
Object [(0).. ] Get
] {k00ecTag} sendmsg2
eq
%% 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 argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
this [ %% function args
[ (IsObject) [ (IsObject(a) return true if a is an Object.) ] ] ] {HelpAdd} sendmsg2
[ $Gmp$ Object 0 get newcontext ] /Gmp set
Gmp 0 get setcontext
/BitAnd {
db.DebugStack setstack $In function : BitAnd of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(and) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/BitOr {
db.DebugStack setstack $In function : BitOr of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(ior) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/ModuloPower {
db.DebugStack setstack $In function : ModuloPower of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /base /ex /mmod ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(powm) base ex mmod ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/ProbabilisticPrimeP {
db.DebugStack setstack $In function : ProbabilisticPrimeP of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /p /reps ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(probab_prime_p) p reps ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Sqrt {
db.DebugStack setstack $In function : Sqrt of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(sqrt) a ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Gcd {
db.DebugStack setstack $In function : Gcd of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(gcd) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Div {
db.DebugStack setstack $In function : Div of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(tdiv_qr) a b ] mpzext /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/Mod {
db.DebugStack setstack $In function : Mod of class Gmp$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /a /b ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[(tdiv_qr) a b ] mpzext 1 get /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
PrimitiveContextp setcontext this [ %% function args
[ (Gmp.) [ (Gmp is a class which supports the following methods:) (BitAnd, BitOr, ModuloPower, ProbabilisticPrimeP, Sqrt,) (Gcd, Div, Mod.) (Ex. r = Gmp.Gcd(5,8); ) (These methods call functions of Gnu-MP package.) (The Copyright notice is in kan96xx/gmp.) (Note that there is no method to create an instance.) ] ] ] {HelpAdd} sendmsg2
true /ShimomuraSpecial set
true /OnePath set
false /Vvv set
false /SetRingVariables_Verbose set
/QuietKan {
db.DebugStack setstack $In function : QuietKan of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
[(KanGBmessage) 0] system_variable /ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
} def
%%end of function
/testhg1 {
db.DebugStack setstack $In function : testhg1 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
[ [ (1).. (1).. (1).. (1).. (1).. (1).. ] [ (0).. (0).. (0).. (1).. (1).. (1).. ] [ (0).. (1).. (0).. (0).. (1).. (0).. ] [ (0).. (0).. (1).. (0).. (0).. (1).. ] ] /a set
this [ %% function args
a ] {idhg} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/testhg2 {
db.DebugStack setstack $In function : testhg2 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] ArgNames mapset
[ [ (1).. (1).. (1).. (1).. (1).. ] [ (0).. (2).. (3).. (4).. (3).. ] [ (0).. (1).. (1).. (0).. (2).. ] ] /a set
this [ %% function args
a ] {idhg} sendmsg2
/FunctionValue set {/ExitPoint goto} exec %%return
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/idhg {
db.DebugStack setstack $In function : idhg 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
/a /ans /rd /i /ans2 /ans3 /n /ff /d /zlist ] pushVariables [ %%local variables
this [ %% function args
a ] {toric} sendmsg2
/ans set
ShimomuraSpecial %% if-condition
{ %%ifbody
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(-------- S-special ---------) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ans (Init) ] {Map} sendmsg2
/ans set
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ans (ToString) ] {Map} sendmsg2
/ans set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
ans ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
(z) this [ %% function args
a [(0).. ] Get
] {Length} sendmsg2
(1).. {add} sendmsg2
this [ %% function args
a ] {Length} sendmsg2
{add} sendmsg2
] {RingDonIndexedVariables} sendmsg2
/rd set
this [ %% function args
ans (Poly) ] {Map} sendmsg2
/ans set
this [ %% function args
a [(0).. ] Get
] {Length} sendmsg2
/n set
this [ %% function args
a ] {Length} sendmsg2
/d set
this [ %% function args
this [ %% function args
ans ] {Length} sendmsg2
] {NewArray} sendmsg2
/ans2 set
(0).. %%PSfor initvalue.
(integer) data_conversion
this [ %% function args
ans ] {Length} sendmsg2
(1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
ans2 [i ] this [ %% function args
ans [i ] Get
n ] {ztoDz} sendmsg2
Put
} for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
ans2 ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
a ] {atolin} sendmsg2
/ans3 set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
ans3 ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
this [ %% function args
ans2 ans3 ] {Join} sendmsg2
(ToString) ] {Map} sendmsg2
/ff set
this [ %% function args
ff n d ] {zindicial} sendmsg2
/ans set
[ ] /zlist set
n %%PSfor initvalue.
(integer) data_conversion
n d {add} sendmsg2
(1).. {add} sendmsg2
(1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
zlist this [ %% function args
(z) i ] {Indexed} sendmsg2
] {Append} sendmsg2
/zlist set
} for
[ ans zlist ] /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
/toric0_toMonom {
db.DebugStack setstack $In function : toric0_toMonom of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /aa /i /offset /ring ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/j /ans /m ] pushVariables [ %%local variables
this [ %% function args
aa ] {Length} sendmsg2
/m set
this [ %% function args
(1) ring ] {PolyR} sendmsg2
/ans set
(0).. /j set
%%for init.
%%for
{ j m lt
{ } {exit} ifelse
[ {%%increment
/j j (1).. add def
} %%end of increment{A}
{%%start of B part{B}
ans z [offset j {add} sendmsg2
] Get
aa [j i ] Get
power
{mul} 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
/ExitPoint ]pop popVariables %%pop the local variables
/ExitPoint ]pop popVariables %%pop argValues
db.DebugStack setstack pop stdstack
FunctionValue } def
%%end of function
/toric {
db.DebugStack setstack $In function : toric of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /aa ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/i /j /rz /n /d /ideal /ans /univ /rule /nn /weight /elim ] pushVariables [ %%local variables
this [ %% function args
aa ] {Length} sendmsg2
/d set
this [ %% function args
aa [(0).. ] Get
] {Length} sendmsg2
/n set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
aa ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
[ ] /weight set
[ ] /elim set
n %%PSfor initvalue.
(integer) data_conversion
n d {add} sendmsg2
(1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
weight [ this [ %% function args
(z) i ] {Indexed} sendmsg2
(1).. ] ] {Join} sendmsg2
/weight set
this [ %% function args
elim this [ %% function args
(z) i ] {Indexed} sendmsg2
] {Append} sendmsg2
/elim set
} for
this [ %% function args
[ weight ] [ this [ %% function args
(z) n (1).. {sub} sendmsg2
] {Indexed} sendmsg2
(1).. ] ] {Append} sendmsg2
/weight set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
weight ] {Println} sendmsg2
this [ %% function args
elim ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
(z) n d {add} sendmsg2
weight ] {RingPonIndexedVariables} sendmsg2
/rz set
[ ] /ideal set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
ideal z [i ] Get
this [ %% function args
aa i n rz ] {toric0_toMonom} sendmsg2
{sub} sendmsg2
] {Append} sendmsg2
/ideal set
} for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
( --------- input ideal -------------) ] {Println} sendmsg2
this [ %% function args
( z[) ] {Print} sendmsg2
this [ %% function args
n ] {Print} sendmsg2
this [ %% function args
(] --- z[) ] {Print} sendmsg2
this [ %% function args
n d {add} sendmsg2
(1).. {sub} sendmsg2
] {Print} sendmsg2
this [ %% function args
(] should be eliminated.) ] {Println} sendmsg2
this [ %% function args
ideal ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ideal ] {Groebner} sendmsg2
/ans set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
( -------------- gb is ----------------- ) ] {Println} sendmsg2
this [ %% function args
ans ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ans elim ] {Eliminatev} sendmsg2
/ans set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
( ------------ eliminated -------------- ) ] {Println} sendmsg2
this [ %% function args
ans ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
[ [ h this [ %% function args
(1) rz ] {PolyR} sendmsg2
] ] /rule set
this [ %% function args
ans ] {Length} sendmsg2
/nn set
[ ] /univ set
(0).. %%PSfor initvalue.
(integer) data_conversion
nn (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
univ this [ %% function args
ans [i ] Get
rule ] {Replace} sendmsg2
] {Append} sendmsg2
/univ set
} for
this [ %% function args
univ ] {ReducedBase} sendmsg2
/ans set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
( ----------- removed redundant elements ----------- ) ] {Println} sendmsg2
this [ %% function args
( ---------- generators of the toric ideal are ----- ) ] {Println} sendmsg2
this [ %% function args
ans ] {Println} sendmsg2
this [ %% function args
( ) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
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
/zindicial0 {
db.DebugStack setstack $In function : zindicial0 of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /input /n /m ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/rz /weight /ww /i /rule /zinverse /m /d /ans /elim /tmp ] pushVariables [ %%local variables
OnePath not
%% if-condition
{ %%ifbody
[ ] /ww set
[ ] /elim set
[ [ this [ %% function args
(z) n ] {Indexed} sendmsg2
(1).. ] ] /weight set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(-------- weight ---------: ) ] {Print} sendmsg2
this [ %% function args
weight ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
(z) n (1).. {add} sendmsg2
m {add} sendmsg2
weight ] {RingDonIndexedVariables} sendmsg2
/rz set
this [ %% function args
n (1).. {add} sendmsg2
m {add} sendmsg2
] {NewArray} sendmsg2
/z set
this [ %% function args
n (1).. {add} sendmsg2
m {add} sendmsg2
] {NewArray} sendmsg2
/Dz set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. {add} sendmsg2
m {add} sendmsg2
(1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
z [i ] this [ %% function args
this [ %% function args
(z) i ] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
Put
Dz [i ] this [ %% function args
this [ %% function args
(Dz) i ] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
Put
} for
this [ %% function args
input rz ] {Mapto} sendmsg2
/input set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(------------ input ------------) ] {Println} sendmsg2
this [ %% function args
input ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
this [ %% function args
[ this [ %% function args
(z) n ] {Indexed} sendmsg2
(^(-1)) ] ] {AddString} sendmsg2
rz ] {PolyR} sendmsg2
/zinverse set
[ [ Dz [n (1).. {sub} sendmsg2
] Get
Dz [n (1).. {sub} sendmsg2
] Get
z [n ] Get
{mul} sendmsg2
] [ z [n (1).. {sub} sendmsg2
] Get
z [n (1).. {sub} sendmsg2
] Get
zinverse {mul} sendmsg2
] ] /rule set
this [ %% function args
input rule ] {Replace} sendmsg2
/input set
this [ %% function args
input ] {Length} sendmsg2
/m set
(0).. %%PSfor initvalue.
(integer) data_conversion
m (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
this [ %% function args
input [i ] Get
[ [ z [n ] Get
zinverse ] ] ] {Replace} sendmsg2
z [n ] Get
] {Degree} sendmsg2
(0).. 2 1 roll {sub} sendmsg
/d set
d (0).. lt
%% if-condition
{ %%ifbody
input [i ] z [n ] Get
d (0).. 2 1 roll {sub} sendmsg
power
input [i ] Get
{mul} sendmsg2
Put
}%%end if if body
{ %%if- else part
} ifelse
} for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(------ input : ) ] {Print} sendmsg2
this [ %% function args
input ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
input ] {GroebnerTime} sendmsg2
/ans set
this [ %% function args
ans ] {Length} sendmsg2
/m set
(0).. %%PSfor initvalue.
(integer) data_conversion
m (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
ans [i ] Get
z [n ] Get
] {Coefficients} sendmsg2
/tmp set
ans [i ] tmp [(1).. (0).. ] Get
Put
} for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(--------FW principal parts : ) ] {Print} sendmsg2
this [ %% function args
ans ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ans (ToString) ] {Map} sendmsg2
/input set
}%%end if if body
{ %%if- else part
} ifelse
[ ] /ww set
[ ] /elim set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. {sub} sendmsg2
(1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
ww [ this [ %% function args
(Dz) i ] {Indexed} sendmsg2
(1).. ] ] {Join} sendmsg2
/ww set
i n (1).. {sub} sendmsg2
eq not
%% if-condition
{ %%ifbody
this [ %% function args
elim this [ %% function args
(Dz) i ] {Indexed} sendmsg2
] {Append} sendmsg2
/elim set
}%%end if if body
{ %%if- else part
} ifelse
} for
[ [ this [ %% function args
(z) n ] {Indexed} sendmsg2
(1).. ] ww ] /weight set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(-------- weight ---------: ) ] {Print} sendmsg2
this [ %% function args
weight ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
(z) n (1).. {add} sendmsg2
m {add} sendmsg2
weight ] {RingDonIndexedVariables} sendmsg2
/rz set
this [ %% function args
n (1).. {add} sendmsg2
m {add} sendmsg2
] {NewArray} sendmsg2
/z set
this [ %% function args
n (1).. {add} sendmsg2
m {add} sendmsg2
] {NewArray} sendmsg2
/Dz set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. {add} sendmsg2
m {add} sendmsg2
(1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
z [i ] this [ %% function args
this [ %% function args
(z) i ] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
Put
Dz [i ] this [ %% function args
this [ %% function args
(Dz) i ] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
Put
} for
this [ %% function args
input rz ] {Mapto} sendmsg2
/input set
OnePath %% if-condition
{ %%ifbody
this [ %% function args
this [ %% function args
[ this [ %% function args
(z) n ] {Indexed} sendmsg2
(^(-1)) ] ] {AddString} sendmsg2
rz ] {PolyR} sendmsg2
/zinverse set
[ [ Dz [n (1).. {sub} sendmsg2
] Get
Dz [n (1).. {sub} sendmsg2
] Get
z [n ] Get
{mul} sendmsg2
] [ z [n (1).. {sub} sendmsg2
] Get
z [n (1).. {sub} sendmsg2
] Get
zinverse {mul} sendmsg2
] ] /rule set
this [ %% function args
input rule ] {Replace} sendmsg2
/input set
this [ %% function args
input ] {Length} sendmsg2
/m set
(0).. %%PSfor initvalue.
(integer) data_conversion
m (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
this [ %% function args
input [i ] Get
[ [ z [n ] Get
zinverse ] ] ] {Replace} sendmsg2
z [n ] Get
] {Degree} sendmsg2
(0).. 2 1 roll {sub} sendmsg
/d set
d (0).. lt
%% if-condition
{ %%ifbody
input [i ] z [n ] Get
d (0).. 2 1 roll {sub} sendmsg
power
input [i ] Get
{mul} sendmsg2
Put
}%%end if if body
{ %%if- else part
} ifelse
} for
}%%end if if body
{ %%if- else part
} ifelse
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(------ input : ) ] {Print} sendmsg2
this [ %% function args
input ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
input ] {GroebnerTime} sendmsg2
/ans set
this [ %% function args
ans ] {Length} sendmsg2
/m set
(0).. %%PSfor initvalue.
(integer) data_conversion
m (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
this [ %% function args
ans [i ] Get
z [n ] Get
] {Coefficients} sendmsg2
/tmp set
ans [i ] tmp [(1).. (0).. ] Get
Put
} for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
(--------FW principal parts : ) ] {Print} sendmsg2
this [ %% function args
ans ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ans elim ] {Eliminatev} sendmsg2
/ans set
this [ %% function args
ans ] {Length} sendmsg2
/m set
(0).. /i set
%%for init.
%%for
{ i m lt
{ } {exit} ifelse
[ {%%increment
/i i (1).. add def
} %%end of increment{A}
{%%start of B part{B}
ans [i ] this [ %% function args
ans [i ] Get
[ [ h this [ %% function args
(1) rz ] {PolyR} sendmsg2
] [ this [ %% function args
this [ %% function args
(z) n ] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
this [ %% function args
(1) rz ] {PolyR} sendmsg2
] ] ] {Replace} sendmsg2
Put
} %% end of B part. {B}
2 1 roll] {exec} map pop
} loop %%end of for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
( ) ] {Println} sendmsg2
this [ %% function args
( ) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
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
/zrho {
db.DebugStack setstack $In function : zrho of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /n ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /i /top /w /rz ] pushVariables [ %%local variables
(0).. /ans set
this [ %% function args
f ] {Ringp} sendmsg2
/rz set
%%while
{ true { } {exit} ifelse
f this [ %% function args
(0) ] {Poly} sendmsg2
eq
%% if-condition
{ %%ifbody
exit }%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
f ] {Init} sendmsg2
/top set
f top {sub} sendmsg2
/f set
this [ %% function args
top [ this [ %% function args
this [ %% function args
(Dz) n (1).. {sub} sendmsg2
] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
] ] {Exponent} sendmsg2
/w set
this [ %% function args
top [ [ this [ %% function args
this [ %% function args
(Dz) n (1).. {sub} sendmsg2
] {Indexed} sendmsg2
rz ] {PolyR} sendmsg2
this [ %% function args
(1) rz ] {PolyR} sendmsg2
] ] ] {Replace} sendmsg2
this [ %% function args
z [n ] Get
w [(0).. ] Get
] {zipoch} sendmsg2
{mul} sendmsg2
/top set
ans top {add} sendmsg2
/ans set
} loop
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
/zipoch {
db.DebugStack setstack $In function : zipoch of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /w ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /i ] pushVariables [ %%local variables
(1).. /ans set
(0).. %%PSfor initvalue.
(integer) data_conversion
w (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
ans f i {sub} sendmsg2
{mul} sendmsg2
/ans set
} for
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
/zindicial {
db.DebugStack setstack $In function : zindicial of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /fff /n /mm ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/ans /n /i /m /r /tmp ] pushVariables [ %%local variables
this [ %% function args
fff n mm ] {zindicial0} sendmsg2
/ans set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
ans ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
ans ] {Length} sendmsg2
/m set
[ ] /r set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
this [ %% function args
[ (------ The generic indicial polynomial along z[) this [ %% function args
n (1).. {sub} sendmsg2
] {ToString} sendmsg2
(] = 0 is the minimal degree polynomial of the following) (polynomials.) ] ] {AddString} sendmsg2
] {Println} sendmsg2
this [ %% function args
this [ %% function args
[ (z[) this [ %% function args
n ] {ToString} sendmsg2
(] is equal to s.) ] ] {AddString} sendmsg2
] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
(0).. %%PSfor initvalue.
(integer) data_conversion
m (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
ans [i ] Get
/tmp set
this [ %% function args
tmp [ [ this [ %% function args
this [ %% function args
(z) n (1).. {sub} sendmsg2
] {Indexed} sendmsg2
] {Poly} sendmsg2
this [ %% function args
(1) ] {Poly} sendmsg2
] ] ] {Replace} sendmsg2
/tmp set
this [ %% function args
tmp n ] {zrho} sendmsg2
/tmp set
Vvv %% if-condition
{ %%ifbody
this [ %% function args
i ] {Print} sendmsg2
this [ %% function args
( : ) ] {Print} sendmsg2
this [ %% function args
tmp ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
this [ %% function args
r tmp ] {Append} sendmsg2
/r set
} for
Vvv %% if-condition
{ %%ifbody
this [ %% function args
( ) ] {Println} sendmsg2
}%%end if if body
{ %%if- else part
} ifelse
r /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
/ztoDz {
db.DebugStack setstack $In function : ztoDz of class PrimitiveObject$ stdstack
/Arglist set /Argthis set /FunctionValue [ ] def
[/this /f /n ] /ArgNames set ArgNames pushVariables [ %%function body
[Argthis] Arglist join ArgNames mapset
[ %%start of local variables
/rule /i ] pushVariables [ %%local variables
this [ %% function args
n ] {NewArray} sendmsg2
/rule set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
rule [i ] [ z [i ] Get
Dz [i ] Get
] Put
} for
this [ %% function args
f rule ] {Replace} 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
/atolin {
db.DebugStack setstack $In function : atolin 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
/d /n /eqs /ans /i /j ] pushVariables [ %%local variables
this [ %% function args
a ] {Length} sendmsg2
/d set
this [ %% function args
a [(0).. ] Get
] {Length} sendmsg2
/n set
this [ %% function args
d ] {NewArray} sendmsg2
/eqs set
(0).. %%PSfor initvalue.
(integer) data_conversion
d (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /i set
(0).. /ans set
(0).. %%PSfor initvalue.
(integer) data_conversion
n (1).. sub (integer) data_conversion 1 2 -1 roll
{ %% for body
(universalNumber) data_conversion /j set
ans a [i j ] Get
z [j ] Get
{mul} sendmsg2
Dz [j ] Get
{mul} sendmsg2
{add} sendmsg2
/ans set
} for
ans z [n (1).. {add} sendmsg2
i {add} sendmsg2
] Get
{sub} sendmsg2
/ans set
eqs [i ] ans Put
} for
eqs /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
; ![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ahg2.k.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / debug