[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.7 and 1.8

version 1.7, 2001/01/05 11:14:25 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 494  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 760  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 801  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 843  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 855  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 872  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 884  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 924  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 977  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 1023  c  /FunctionValue set  {/ExitPoint goto} exec %%return
Line 1110  c  /FunctionValue set  {/ExitPoint goto} exec %%return
 FunctionValue } def  FunctionValue } def
 %%end of function  %%end of function
   
 this [ %% function args  
 [ (ReParse) [ (Reparse(obj): ) (It parses the given object in the current ring.)   ]   ] ] {HelpAdd} sendmsg2  
 /Pmat {  /Pmat {
  db.DebugStack setstack $In function : Pmat of class PrimitiveObject$  stdstack   db.DebugStack setstack $In function : Pmat of class PrimitiveObject$  stdstack
  /Arglist set /Argthis set /FunctionValue [ ] def   /Arglist set /Argthis set /FunctionValue [ ] def
Line 1035  this [ %% function args 
Line 1120  this [ %% function args 
 } def  } def
 %%end of function  %%end of function
   
 this [ %% function args  
 [ (Pmat) [ (Pmat(m): ) (Print the array m in a pretty way.)   ]   ] ] {HelpAdd} sendmsg2  
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>