K00_verbose %% if-condition { %%ifbody ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message }%%end if if body { %%if- else part } ifelse [ ] /Helplist set /HelpAdd { db.DebugStack setstack $In function : HelpAdd of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset this [ %% function args Helplist s ] {Append} sendmsg2 /Helplist set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack } def %%end of function /Print { db.DebugStack setstack $In function : Print of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset a messagen /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Println { db.DebugStack setstack $In function : Println of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset a message /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Ln { db.DebugStack setstack $In function : Ln of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] ArgNames mapset ( ) message /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Poly { db.DebugStack setstack $In function : Poly of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f (poly) data_conversion /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /PolyR { db.DebugStack setstack $In function : PolyR of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f /r ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f r ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Degree { db.DebugStack setstack $In function : Degree of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f /v ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f v degree (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Append { db.DebugStack setstack $In function : Append of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f /g ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset this [ %% function args f [ g ] ] {Join} sendmsg2 /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Length { db.DebugStack setstack $In function : Length of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f length (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Transpose { db.DebugStack setstack $In function : Transpose of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /mat ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset mat transpose /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /s.Indexed { (integer) dc /arg2 set /arg1 set arg1 ([) arg2 (dollar) dc (]) 4 cat_n } def /s.Indexed2 { (integer) dc /arg3 set (integer) dc /arg2 set /arg1 set arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n } def /Groebner { db.DebugStack setstack $In function : Groebner of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset F {[[(h). (1).]] replace homogenize} map /arg1 set [arg1] groebner 0 get /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /GroebnerTime { db.DebugStack setstack $In function : GroebnerTime of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset F {[[(h). (1).]] replace homogenize} map /arg1 set { [arg1] groebner 0 get } timer /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /LiftStd { db.DebugStack setstack $In function : LiftStd of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /F ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset F {[[(h). (1).]] replace homogenize} map /arg1 set [arg1 [(needBack)]] groebner /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Reduction { db.DebugStack setstack $In function : Reduction of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f /myset ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /n /indexTable /set2 /i /j /tmp /t_syz /r /rng /vsize /tt ] pushVariables [ %%local variables null /vsize set this [ %% function args this [ %% function args (1) ] {Poly} sendmsg2 ] {GetRing} sendmsg2 /r set this [ %% function args f ] {GetRing} sendmsg2 /rng set this [ %% function args rng ] {Tag} sendmsg2 (0).. eq %% if-condition { %%ifbody this [ %% function args myset ] {GetRing} sendmsg2 /rng set }%%end if if body { %%if- else part } ifelse this [ %% function args rng ] {Tag} sendmsg2 (0).. eq not %% if-condition { %%ifbody this [ %% function args rng ] {SetRing} sendmsg2 }%%end if if body { %%if- else part } ifelse this [ %% function args f ] {IsArray} sendmsg2 %% if-condition { %%ifbody this [ %% function args f ] {Length} sendmsg2 /vsize set [f] fromVectors 0 get /f set }%%end if if body { %%if- else part } ifelse this [ %% function args myset ] {Length} sendmsg2 /n set n (0).. gt %% if-condition { %%ifbody this [ %% function args myset [(0).. ] Get ] {IsArray} sendmsg2 %% if-condition { %%ifbody vsize this [ %% function args myset [(0).. ] Get ] {Length} sendmsg2 eq not %% if-condition { %%ifbody this [ %% function args (Reduction: size mismatch.) ] {Error} sendmsg2 }%%end if if body { %%if- else part } ifelse myset fromVectors /myset set }%%end if if body { %%if- else part } ifelse }%%end if if body { %%if- else part } ifelse this [ %% function args n ] {NewArray} sendmsg2 /indexTable set [ ] /set2 set (0).. /j set (0).. /i set %%for init. %%for { i n lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} this [ %% function args myset [i ] Get ] {Tag} sendmsg2 (0).. eq %% if-condition { %%ifbody indexTable [i ] (1).. (0).. 2 1 roll {sub} sendmsg Put }%%end if if body { %%if- else part myset [i ] Get this [ %% function args (0) ] {Poly} sendmsg2 eq %% if-condition { %%ifbody indexTable [i ] (1).. (0).. 2 1 roll {sub} sendmsg Put }%%end if if body { %%if- else part this [ %% function args set2 myset [i ] Get ] {Append} sendmsg2 /set2 set indexTable [i ] j Put /j j (1).. {add} sendmsg2 def } ifelse } ifelse } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for f set2 (gradedPolySet) dc reduction /tmp set this [ %% function args n ] {NewArray} sendmsg2 /t_syz set (0).. /i set %%for init. %%for { i n lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} indexTable [i ] Get (1).. (0).. 2 1 roll {sub} sendmsg eq not %% if-condition { %%ifbody t_syz [i ] tmp [(2).. indexTable [i ] Get ] Get Put }%%end if if body { %%if- else part t_syz [i ] this [ %% function args (0) ] {Poly} sendmsg2 Put } ifelse } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for this [ %% function args vsize ] {Tag} sendmsg2 (0).. eq not %% if-condition { %%ifbody tmp [(0).. ] Get /tt set [vsize (integer) dc tt] toVectors /tt set tmp [(0).. ] tt Put }%%end if if body { %%if- else part } ifelse this [ %% function args r ] {SetRing} sendmsg2 [ tmp [(0).. ] Get tmp [(1).. ] Get t_syz ] /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /IntegerToSm1Integer { db.DebugStack setstack $In function : IntegerToSm1Integer of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f (integer) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /RingD { db.DebugStack setstack $In function : RingD of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /vList /weightMatrix /pp ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /new0 /tmp /size /n /i /j /newtmp /ringpp /argsize ] pushVariables [ %%local variables this [ %% function args Arglist ] {Length} sendmsg2 /argsize set argsize (1).. eq %% if-condition { %%ifbody [ vList ring_of_differential_operators ( ) elimination_order 0 ] define_ring /tmp set this [ %% function args ] {SetRingVariables} sendmsg2 tmp /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part } ifelse argsize (2).. eq %% if-condition { %%ifbody (0).. /pp set }%%end if if body { %%if- else part } ifelse this [ %% function args pp ] {IntegerToSm1Integer} sendmsg2 /pp set this [ %% function args weightMatrix ] {Length} sendmsg2 /size set this [ %% function args size ] {NewVector} sendmsg2 /new0 set /@@@.indexMode.flag.save @@@.indexMode.flag def 0 @@@.indexMode (0).. %%PSfor initvalue. (integer) data_conversion size (1).. sub (integer) data_conversion 1 2 -1 roll { %% for body (universalNumber) data_conversion /i set weightMatrix [i ] Get /tmp set this [ %% function args tmp ] {Length} sendmsg2 /n set this [ %% function args n ] {NewVector} sendmsg2 /newtmp set (1).. /j set %%for init. %%for { j n lt { } {exit} ifelse [ {%%increment j (2).. {add} sendmsg2 /j set } %%end of increment{A} {%%start of B part{B} newtmp [j (1).. {sub} sendmsg2 ] tmp [j (1).. {sub} sendmsg2 ] Get Put newtmp [j ] this [ %% function args tmp [j ] Get ] {IntegerToSm1Integer} sendmsg2 Put } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for new0 [i ] newtmp Put } for [ vList ring_of_differential_operators new0 weight_vector pp ] define_ring /ringpp set this [ %% function args ] {SetRingVariables} sendmsg2 @@@.indexMode.flag.save @@@.indexMode ringpp /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /getxvar { db.DebugStack setstack $In function : getxvar of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /i ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [(x) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /getdvar { db.DebugStack setstack $In function : getdvar of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /i ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [(D) (var) i ..int ] system_variable /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /getvarn { db.DebugStack setstack $In function : getvarn of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] ArgNames mapset [(N)] system_variable (universalNumber) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function false /SetRingVariables_Verbose set /SetRingVariables { db.DebugStack setstack $In function : SetRingVariables of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] ArgNames mapset SetRingVariables_Verbose %% if-condition { %%ifbody this [ %% function args (SetRingVariables() Setting the global variables : ) ] {Print} sendmsg2 }%%end if if body { %%if- else part } ifelse this [ %% function args (0).. [(N)] system_variable (universalNumber) dc ] {k00setRingVariables} sendmsg2 %% if-condition { %%ifbody define_ring_variables }%%end if if body { %%if- else part } ifelse SetRingVariables_Verbose %% if-condition { %%ifbody this [ %% function args ] {Ln} sendmsg2 }%%end if if body { %%if- else part } ifelse /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /k00AreThereLeftBrace { db.DebugStack setstack $In function : k00AreThereLeftBrace of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /leftBrace /jj /slist ] pushVariables [ %%local variables $[$ (array) dc 0 get (universalNumber) dc /leftBrace set this [ %% function args this [ %% function args s ] {StringToIntegerArray} sendmsg2 leftBrace ] {Position} sendmsg2 /jj set jj (1).. (0).. 2 1 roll {sub} sendmsg eq not %% if-condition { %%ifbody true /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part false /FunctionValue set {/ExitPoint goto} exec %%return } ifelse /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /k00setRingVariables { db.DebugStack setstack $In function : k00setRingVariables of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /p /q ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /v /i ] pushVariables [ %%local variables p /i set %%for init. %%for { i q lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} this [ %% function args i ] {getxvar} sendmsg2 /v set this [ %% function args v ] {k00AreThereLeftBrace} sendmsg2 %% if-condition { %%ifbody false /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part } ifelse this [ %% function args i ] {getdvar} sendmsg2 /v set this [ %% function args v ] {k00AreThereLeftBrace} sendmsg2 %% if-condition { %%ifbody false /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part } ifelse } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for true /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /AddString { db.DebugStack setstack $In function : AddString of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f aload length cat_n /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /IntegerToString { db.DebugStack setstack $In function : IntegerToString of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Replace { db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /AsciiToString { db.DebugStack setstack $In function : AsciiToString of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /c ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset c (integer) dc (string) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /ToString { db.DebugStack setstack $In function : ToString of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /p ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /n /ans /i ] pushVariables [ %%local variables [ ] /ans set this [ %% function args p ] {IsArray} sendmsg2 %% if-condition { %%ifbody this [ %% function args p ] {Length} sendmsg2 /n set this [ %% function args ans ([ ) ] {Append} sendmsg2 /ans set (0).. /i set %%for init. %%for { i n lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} this [ %% function args ans this [ %% function args p [i ] Get ] {ToString} sendmsg2 ] {Append} sendmsg2 /ans set i n (1).. {sub} sendmsg2 eq not %% if-condition { %%ifbody this [ %% function args ans ( , ) ] {Append} sendmsg2 /ans set }%%end if if body { %%if- else part } ifelse } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for this [ %% function args ans ( ] ) ] {Append} sendmsg2 /ans set }%%end if if body { %%if- else part [ p (dollar) dc ] /ans set } ifelse this [ %% function args ans ] {AddString} sendmsg2 /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /IsArray { db.DebugStack setstack $In function : IsArray of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /p ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset p isArray /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Denominator { db.DebugStack setstack $In function : Denominator of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f (denominator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Numerator { db.DebugStack setstack $In function : Numerator of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f (numerator) dc /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Replace { db.DebugStack setstack $In function : Replace of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f /rule ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /ans /n /tmp /i /num /den ] pushVariables [ %%local variables this [ %% function args f ] {IsArray} sendmsg2 %% if-condition { %%ifbody this [ %% function args f ] {Length} sendmsg2 /n set [ ] /ans set (0).. /i set %%for init. %%for { i n lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} this [ %% function args ans this [ %% function args f [i ] Get rule ] {Replace} sendmsg2 ] {Append} sendmsg2 /ans set } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for ans /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part } ifelse f tag RationalFunctionP eq %% if-condition { %%ifbody this [ %% function args f ] {Numerator} sendmsg2 /num set this [ %% function args f ] {Denominator} sendmsg2 /den set num rule replace /num set den rule replace /den set num den {div} sendmsg2 /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part } ifelse f rule replace /FunctionValue set /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /Map { db.DebugStack setstack $In function : Map of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /karg /func ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset karg { [ 2 -1 roll ] this 2 -1 roll [(parse) func ] extension pop } map /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (Map) [ (Map(karg,func) applies the function <> to the <>(string func).) ( Ex. Map([82,83,85],"AsciiToString"):) ] ] ] {HelpAdd} sendmsg2 /Position { db.DebugStack setstack $In function : Position of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /list /elem ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /n /pos /i ] pushVariables [ %%local variables this [ %% function args list ] {Length} sendmsg2 /n set (1).. (0).. 2 1 roll {sub} sendmsg /pos set (0).. /i set %%for init. %%for { i n lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} elem list [i ] Get eq %% if-condition { %%ifbody i /pos set /k00.label0 goto }%%end if if body { %%if- else part } ifelse } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for /k00.label0 pos /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (Position) [ (Position(list,elem) returns the position p of the element <> in) ( the array <>. If <> is not in <>, 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 <> into an array of) (ascii codes of <> (string s).) (cf. AsciiToString.) ] ] ] {HelpAdd} sendmsg2 /StringToAsciiArray { db.DebugStack setstack $In function : StringToAsciiArray of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset this [ %% function args s ] {StringToIntegerArray} sendmsg2 /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (StringToAsciiArray) [ (StringToAsciiArray(s) is StringToIntegerArray(s).) ] ] ] {HelpAdd} sendmsg2 /NewArray { db.DebugStack setstack $In function : NewArray of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /n ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset this [ %% function args n ] {NewVector} sendmsg2 /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (NewArray) [ (NewArray(n) returns an array of size n (integer n).) ] ] ] {HelpAdd} sendmsg2 /GetEnv { db.DebugStack setstack $In function : GetEnv of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [(getenv) s] extension /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (GetEnv) [ (GetEnv(s) returns the value of the environmental variable s (string s).) ] ] ] {HelpAdd} sendmsg2 /Boundp { db.DebugStack setstack $In function : Boundp of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /b ] pushVariables [ %%local variables [(parse) [(/) a ( load tag 0 eq { /FunctionValue 0 def } { /FunctionValue 1 def } ifelse )] cat ] extension /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (Boundp) [ (Boundp(s) checks if the symbol s is bounded to a value or not (string s).) ] ] ] {HelpAdd} sendmsg2 /Rest { db.DebugStack setstack $In function : Rest of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset a rest /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (Rest) [ (Rest(a) returns the rest (cdr) of a (list a).) ] ] ] {HelpAdd} sendmsg2 /GetPathName { db.DebugStack setstack $In function : GetPathName of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /s ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /t /sss ] pushVariables [ %%local variables s /sss set [(stat) s] extension 0 get /t set this [ %% function args t ] {Tag} sendmsg2 (0).. eq %% if-condition { %%ifbody this [ %% function args [ this [ %% function args (LOAD_K_PATH) ] {GetEnv} sendmsg2 (/) s ] ] {AddString} sendmsg2 /s set [(stat) s] extension 0 get /t set this [ %% function args t ] {Tag} sendmsg2 (0).. eq %% if-condition { %%ifbody null /FunctionValue set {/ExitPoint goto} exec %%return }%%end if if body { %%if- else part s /FunctionValue set {/ExitPoint goto} exec %%return } ifelse }%%end if if body { %%if- else part s /FunctionValue set {/ExitPoint goto} exec %%return } ifelse /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (GetPathName) [ (GetPathName(s) checks if the file s exists in the current directory or) (in LOAD_K_PATH. If there exists, it returns the path name (string s).) ] ] ] {HelpAdd} sendmsg2 /Load_sm1 { db.DebugStack setstack $In function : Load_sm1 of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /fnames /flag ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /ppp /n /i /cmd ] pushVariables [ %%local variables this [ %% function args flag ] {Boundp} sendmsg2 %% if-condition { %%ifbody }%%end if if body { %%if- else part this [ %% function args fnames ] {Length} sendmsg2 /n set (0).. /i set %%for init. %%for { i n lt { } {exit} ifelse [ {%%increment /i i (1).. {add} sendmsg2 def } %%end of increment{A} {%%start of B part{B} this [ %% function args fnames [i ] Get ] {GetPathName} sendmsg2 /ppp set this [ %% function args ppp ] {Tag} sendmsg2 (0).. eq not %% if-condition { %%ifbody [(parse) ppp pushfile ] extension this [ %% function args [ (/) flag ( 1 def ) ] ] {AddString} sendmsg2 /cmd set [(parse) cmd ] extension n /i set }%%end if if body { %%if- else part } ifelse } %% end of B part. {B} 2 1 roll] {exec} map pop } loop %%end of for } ifelse /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (Load_sm1) [ (Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....) (If loading is succeeded, the already-loaded flag is set to true.) ((list s, string flag).) ] ] ] {HelpAdd} sendmsg2 /GetRing { db.DebugStack setstack $In function : GetRing of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /f ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset f getRing /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /SetRing { db.DebugStack setstack $In function : SetRing of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /r ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset r ring_def /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function /ReParse { db.DebugStack setstack $In function : ReParse of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset [ %%start of local variables /c ] pushVariables [ %%local variables this [ %% function args a ] {IsArray} sendmsg2 %% if-condition { %%ifbody this [ %% function args a (ReParse) ] {Map} sendmsg2 /c set }%%end if if body { %%if- else part a toString . /c set } ifelse c /FunctionValue set {/ExitPoint goto} exec %%return /ExitPoint ]pop popVariables %%pop the local variables /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack FunctionValue } def %%end of function this [ %% function args [ (ReParse) [ (Reparse(obj): ) (It parses the given object in the current ring.) ] ] ] {HelpAdd} sendmsg2 /Pmat { db.DebugStack setstack $In function : Pmat of class PrimitiveObject$ stdstack /Arglist set /Argthis set /FunctionValue [ ] def [/this /a ] /ArgNames set ArgNames pushVariables [ %%function body [Argthis] Arglist join ArgNames mapset a pmat /ExitPoint ]pop popVariables %%pop argValues db.DebugStack setstack pop stdstack } def %%end of function this [ %% function args [ (Pmat) [ (Pmat(m): ) (Print the array m in a pretty way.) ] ] ] {HelpAdd} sendmsg2