[BACK]Return to slib.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / k097

Diff for /OpenXM/src/k097/slib.sm1 between version 1.5 and 1.8

version 1.5, 2000/12/28 00:08:13 version 1.8, 2001/01/08 05:26:49
Line 7  K00_verbose  %% if-condition
Line 7  K00_verbose  %% if-condition
 /HelpAdd {  /HelpAdd {
  db.DebugStack setstack $In function : HelpAdd of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : HelpAdd of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
  [/this /s  ] /ArgNames set ArgNames pushVariables [ %%function body   [/this /s /category  ] /ArgNames set ArgNames pushVariables [ %%function body
  [Argthis] Arglist join ArgNames mapset   [Argthis] Arglist join ArgNames mapset
   [ %%start of local variables
   /n ] pushVariables [ %%local variables
 this [ %% function args  this [ %% function args
   Arglist ] {Length} sendmsg2
   /n  set
   n (1)..  lessThanOrEqual
    %% if-condition
     { %%ifbody
   null /category  set
     }%%end if if body
     { %%if- else part
     } ifelse
   true  %% if-condition
     { %%ifbody
   n (1)..  eq
   n (2)..  eq
    or
    not
    %% if-condition
     { %%ifbody
   this [ %% function args
   s ] {Println} sendmsg2
   this [ %% function args
   (HelpAdd: wrong argument length.) ] {Error} sendmsg2
     }%%end if if body
     { %%if- else part
     } ifelse
   this [ %% function args
   category ] {Tag} sendmsg2
   (0)..  eq
   this [ %% function args
   category ] {Tag} sendmsg2
   (5)..  eq
    or
    not
    %% if-condition
     { %%ifbody
   this [ %% function args
   category ] {Println} sendmsg2
   this [ %% function args
   (HelpAdd: wrong category.) ] {Error} sendmsg2
     }%%end if if body
     { %%if- else part
     } ifelse
   this [ %% function args
   s ] {Tag} sendmsg2
   (6)..  eq
    not
    %% if-condition
     { %%ifbody
   this [ %% function args
   s ] {Println} sendmsg2
   this [ %% function args
   (HelpAdd: s must be an array.) ] {Error} sendmsg2
     }%%end if if body
     { %%if- else part
     } ifelse
   this [ %% function args
   s [(0)..  ]  Get
   ] {Tag} sendmsg2
   (5)..  eq
    not
    %% if-condition
     { %%ifbody
   this [ %% function args
   s ] {Println} sendmsg2
   this [ %% function args
   (HelpAdd: s[0] must be a string.) ] {Error} sendmsg2
     }%%end if if body
     { %%if- else part
     } ifelse
   this [ %% function args
   s [(1)..  ]  Get
   ] {Tag} sendmsg2
   (5)..  eq
   this [ %% function args
   s [(1)..  ]  Get
   ] {Tag} sendmsg2
   (6)..  eq
    or
    not
    %% if-condition
     { %%ifbody
   this [ %% function args
   s ] {Println} sendmsg2
   this [ %% function args
   (HelpAdd: s[1] must be a string or an array.) ] {Error} sendmsg2
     }%%end if if body
     { %%if- else part
     } ifelse
     }%%end if if body
     { %%if- else part
     } ifelse
   [ category s   ] /s  set
   this [ %% function args
 Helplist s ] {Append} sendmsg2  Helplist s ] {Append} sendmsg2
 /Helplist  set  /Helplist  set
   /ExitPoint ]pop popVariables %%pop the local variables
 /ExitPoint ]pop popVariables %%pop argValues  /ExitPoint ]pop popVariables %%pop argValues
  db.DebugStack setstack pop stdstack   db.DebugStack setstack pop stdstack
 } def  } def
 %%end of function  %%end of function
   
   /Tag {
    db.DebugStack setstack $In function : Tag of class PrimitiveObject$  stdstack
    /Arglist set /Argthis set /FunctionValue [ ] def
    [/this /f  ] /ArgNames set ArgNames pushVariables [ %%function body
    [Argthis] Arglist join ArgNames mapset
   [ %%start of local variables
   /ans ] pushVariables [ %%local variables
    f   etag (universalNumber) dc  /ans  set
   ans  /FunctionValue set  {/ExitPoint goto} exec %%return
   /ExitPoint ]pop popVariables %%pop the local variables
   /ExitPoint ]pop popVariables %%pop argValues
    db.DebugStack setstack pop stdstack
   FunctionValue } def
   %%end of function
   
   /Error {
    db.DebugStack setstack $In function : Error of class PrimitiveObject$  stdstack
    /Arglist set /Argthis set /FunctionValue [ ] def
    [/this /s  ] /ArgNames set ArgNames pushVariables [ %%function body
    [Argthis] Arglist join ArgNames mapset
     s error  /ExitPoint ]pop popVariables %%pop argValues
    db.DebugStack setstack pop stdstack
   FunctionValue } def
   %%end of function
   
 /Print {  /Print {
  db.DebugStack setstack $In function : Print of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Print of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 100  FunctionValue } def
Line 220  FunctionValue } def
 FunctionValue } def  FunctionValue } def
 %%end of function  %%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 {  /Transpose {
  db.DebugStack setstack $In function : Transpose of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Transpose of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 182  FunctionValue } def
Line 282  FunctionValue } def
 /Reduction {  /Reduction {
  db.DebugStack setstack $In function : Reduction of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Reduction of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
  [/this /f /G  ] /ArgNames set ArgNames pushVariables [ %%function body   [/this /f /myset  ] /ArgNames set ArgNames pushVariables [ %%function body
  [Argthis] Arglist join ArgNames mapset   [Argthis] Arglist join ArgNames mapset
  f  G   reduction /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues  [ %%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   db.DebugStack setstack pop stdstack
 FunctionValue } def  FunctionValue } def
 %%end of function  %%end of function
Line 353  FunctionValue } def
Line 614  FunctionValue } def
   $[$ (array) dc 0 get (universalNumber) dc  /leftBrace  set    $[$ (array) dc 0 get (universalNumber) dc  /leftBrace  set
 this [ %% function args  this [ %% function args
 this [ %% function args  this [ %% function args
 s ] {StringToIntegerArray} sendmsg2  s ] {StringToAsciiArray} sendmsg2
 leftBrace ] {Position} sendmsg2  leftBrace ] {Position} sendmsg2
 /jj  set  /jj  set
 jj (1)..  (0)..  2 1 roll {sub} sendmsg  jj (1)..  (0)..  2 1 roll {sub} sendmsg
Line 619  FunctionValue } def
Line 880  FunctionValue } def
 FunctionValue } def  FunctionValue } def
 %%end of function  %%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 {  /Position {
  db.DebugStack setstack $In function : Position of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Position of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 660  i /pos  set
Line 919  i /pos  set
 FunctionValue } def  FunctionValue } def
 %%end of function  %%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 {  /StringToAsciiArray {
  db.DebugStack setstack $In function : StringToAsciiArray of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : StringToAsciiArray of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
  [/this /s  ] /ArgNames set ArgNames pushVariables [ %%function body   [/this /s  ] /ArgNames set ArgNames pushVariables [ %%function body
  [Argthis] Arglist join ArgNames mapset   [Argthis] Arglist join ArgNames mapset
 this [ %% function args   s   (array) dc { (universalNumber) dc } map /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
 s ] {StringToIntegerArray} sendmsg2  
  /FunctionValue set  {/ExitPoint goto} exec %%return  
 /ExitPoint ]pop popVariables %%pop argValues  
  db.DebugStack setstack pop stdstack   db.DebugStack setstack pop stdstack
 FunctionValue } def  FunctionValue } def
 %%end of function  %%end of function
   
 this [ %% function args  
 [ (StringToAsciiArray) [ (StringToAsciiArray(s) is StringToIntegerArray(s).)   ]   ] ] {HelpAdd} sendmsg2  
 /NewArray {  /NewArray {
  db.DebugStack setstack $In function : NewArray of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : NewArray of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 702  n ] {NewVector} sendmsg2 
Line 942  n ] {NewVector} sendmsg2 
 FunctionValue } def  FunctionValue } def
 %%end of function  %%end of function
   
 this [ %% function args  
 [ (NewArray) [ (NewArray(n) returns an array of size n (integer n).)   ]   ] ] {HelpAdd} sendmsg2  
 /GetEnv {  /GetEnv {
  db.DebugStack setstack $In function : GetEnv of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : GetEnv of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 714  this [ %% function args 
Line 952  this [ %% function args 
 FunctionValue } def  FunctionValue } def
 %%end of function  %%end of function
   
 this [ %% function args  
 [ (GetEnv) [ (GetEnv(s) returns the value of the environmental variable s (string s).)   ]   ] ] {HelpAdd} sendmsg2  
 /Boundp {  /Boundp {
  db.DebugStack setstack $In function : Boundp of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Boundp of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 731  this [ %% function args 
Line 967  this [ %% function args 
 FunctionValue } def  FunctionValue } def
 %%end of function  %%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 {  /Rest {
  db.DebugStack setstack $In function : Rest of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Rest of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 743  this [ %% function args 
Line 977  this [ %% function args 
 FunctionValue } def  FunctionValue } def
 %%end of function  %%end of function
   
 this [ %% function args  
 [ (Rest) [ (Rest(a) returns the rest (cdr) of  a (list a).)   ]   ] ] {HelpAdd} sendmsg2  
 /GetPathName {  /GetPathName {
  db.DebugStack setstack $In function : GetPathName of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : GetPathName of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 783  s  /FunctionValue set  {/ExitPoint goto} exec %%return
Line 1015  s  /FunctionValue set  {/ExitPoint goto} exec %%return
 FunctionValue } def  FunctionValue } def
 %%end of function  %%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 {  /Load_sm1 {
  db.DebugStack setstack $In function : Load_sm1 of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Load_sm1 of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 836  ppp ] {Tag} sendmsg2 
Line 1066  ppp ] {Tag} sendmsg2 
 FunctionValue } def  FunctionValue } def
 %%end of function  %%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 {  /GetRing {
  db.DebugStack setstack $In function : GetRing of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : GetRing of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 856  FunctionValue } def
Line 1084  FunctionValue } def
   r ring_def  /ExitPoint ]pop popVariables %%pop argValues    r ring_def  /ExitPoint ]pop popVariables %%pop argValues
  db.DebugStack setstack pop stdstack   db.DebugStack setstack pop stdstack
 FunctionValue } def  FunctionValue } def
   %%end of function
   
   /ReParse {
    db.DebugStack setstack $In function : ReParse of class PrimitiveObject$  stdstack
    /Arglist set /Argthis set /FunctionValue [ ] def
    [/this /a  ] /ArgNames set ArgNames pushVariables [ %%function body
    [Argthis] Arglist join ArgNames mapset
   [ %%start of local variables
   /c ] pushVariables [ %%local variables
   this [ %% function args
   a ] {IsArray} sendmsg2
    %% if-condition
     { %%ifbody
   this [ %% function args
   a (ReParse) ] {Map} sendmsg2
   /c  set
     }%%end if if body
     { %%if- else part
    a   toString . /c set   } ifelse
   c  /FunctionValue set  {/ExitPoint goto} exec %%return
   /ExitPoint ]pop popVariables %%pop the local variables
   /ExitPoint ]pop popVariables %%pop argValues
    db.DebugStack setstack pop stdstack
   FunctionValue } def
   %%end of function
   
   /Pmat {
    db.DebugStack setstack $In function : Pmat of class PrimitiveObject$  stdstack
    /Arglist set /Argthis set /FunctionValue [ ] def
    [/this /a  ] /ArgNames set ArgNames pushVariables [ %%function body
    [Argthis] Arglist join ArgNames mapset
     a pmat  /ExitPoint ]pop popVariables %%pop argValues
    db.DebugStack setstack pop stdstack
   } def
 %%end of function  %%end of function
   
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.8
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>