[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.6 and 1.11

version 1.6, 2001/01/04 12:29:31 version 1.11, 2004/09/10 13:20:23
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 62  FunctionValue } def
Line 182  FunctionValue } def
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
  [/this /f /r  ] /ArgNames set ArgNames pushVariables [ %%function body   [/this /f /r  ] /ArgNames set ArgNames pushVariables [ %%function body
  [Argthis] Arglist join ArgNames mapset   [Argthis] Arglist join ArgNames mapset
  f  r   ,, /FunctionValue set /ExitPoint ]pop popVariables %%pop argValues   f  r   __ /FunctionValue set /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 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 370  FunctionValue } def
Line 470  FunctionValue } def
 this [ %% function args  this [ %% function args
 Arglist ] {Length} sendmsg2  Arglist ] {Length} sendmsg2
 /argsize  set  /argsize  set
   this [ %% function args
   vList ] {IsArray} sendmsg2
    %% if-condition
     { %%ifbody
     vList {toString} map from_records /vList set    }%%end if if body
     { %%if- else part
     } ifelse
 argsize (1)..  eq  argsize (1)..  eq
  %% if-condition   %% if-condition
   { %%ifbody    { %%ifbody
Line 396  weightMatrix ] {Length} sendmsg2 
Line 503  weightMatrix ] {Length} sendmsg2 
 this [ %% function args  this [ %% function args
 size ] {NewVector} sendmsg2  size ] {NewVector} sendmsg2
 /new0  set  /new0  set
   /@@@.indexMode.flag.save @@@.indexMode.flag def    0 @@@.indexMode  (0).. %%PSfor initvalue.    /@@@.indexMode.flag.save @@@.indexMode.flag def    0 @@@.indexMode  (0).. size  2 -1 roll
   %%PSfor initvalue.
  (integer) data_conversion   (integer) data_conversion
 size  (1).. sub  (integer) data_conversion  1  2 -1 roll   2 -1 roll
    (1).. sub  (integer) data_conversion  1  2 -1 roll
 { %% for body  { %% for body
  (universalNumber) data_conversion /i  set   (universalNumber) data_conversion /i  set
 weightMatrix [i  ]  Get  weightMatrix [i  ]  Get
Line 514  FunctionValue } def
Line 623  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 780  FunctionValue } def
Line 889  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 821  i /pos  set
Line 928  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 863  n ] {NewVector} sendmsg2 
Line 951  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 875  this [ %% function args 
Line 961  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 892  this [ %% function args 
Line 976  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 904  this [ %% function args 
Line 986  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 944  s  /FunctionValue set  {/ExitPoint goto} exec %%return
Line 1024  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 997  ppp ] {Tag} sendmsg2 
Line 1075  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 1017  FunctionValue } def
Line 1093  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
   
   /QuoteMode {
    db.DebugStack setstack $In function : QuoteMode of class PrimitiveObject$  stdstack
    /Arglist set /Argthis set /FunctionValue [ ] def
    [/this /a  ] /ArgNames set ArgNames pushVariables [ %%function body
    [Argthis] Arglist join ArgNames mapset
   a (0)..  eq
    %% if-condition
     { %%ifbody
    [(QuoteMode) 0] system_variable    }%%end if if body
     { %%if- else part
    [(QuoteMode) 1] system_variable    } ifelse
   /ExitPoint ]pop popVariables %%pop argValues
    db.DebugStack setstack pop stdstack
   } def
 %%end of function  %%end of function
   
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.11
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>