===================================================================
RCS file: /home/cvs/OpenXM/src/k097/slib.sm1,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- OpenXM/src/k097/slib.sm1	2001/01/05 11:14:25	1.7
+++ OpenXM/src/k097/slib.sm1	2001/01/08 05:26:49	1.8
@@ -7,16 +7,136 @@ K00_verbose  %% if-condition
 /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
+ [/this /s /category  ] /ArgNames set ArgNames pushVariables [ %%function body
  [Argthis] Arglist join ArgNames mapset
+[ %%start of local variables
+/n ] pushVariables [ %%local variables
 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  set
+/ExitPoint ]pop popVariables %%pop the local variables
 /ExitPoint ]pop popVariables %%pop argValues
  db.DebugStack setstack pop stdstack 
 } def
 %%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 {
  db.DebugStack setstack $In function : Print of class PrimitiveObject$  stdstack 
  /Arglist set /Argthis set /FunctionValue [ ] def
@@ -494,7 +614,7 @@ FunctionValue } def
   $[$ (array) dc 0 get (universalNumber) dc  /leftBrace  set
 this [ %% function args 
 this [ %% function args 
-s ] {StringToIntegerArray} sendmsg2 
+s ] {StringToAsciiArray} sendmsg2 
 leftBrace ] {Position} sendmsg2 
 /jj  set
 jj (1)..  (0)..  2 1 roll {sub} sendmsg 
@@ -760,8 +880,6 @@ FunctionValue } def
 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
@@ -801,35 +919,16 @@ i /pos  set
 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
+ 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 
-[ (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
@@ -843,8 +942,6 @@ n ] {NewVector} sendmsg2 
 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
@@ -855,8 +952,6 @@ this [ %% function args 
 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
@@ -872,8 +967,6 @@ this [ %% function args 
 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
@@ -884,8 +977,6 @@ this [ %% function args 
 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
@@ -924,8 +1015,6 @@ s  /FunctionValue set  {/ExitPoint goto} exec %%return
 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
@@ -977,8 +1066,6 @@ ppp ] {Tag} sendmsg2 
 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
@@ -1023,8 +1110,6 @@ c  /FunctionValue set  {/ExitPoint goto} exec %%return
 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
@@ -1035,5 +1120,3 @@ this [ %% function args 
 } def
 %%end of function
 
-this [ %% function args 
-[ (Pmat) [ (Pmat(m): ) (Print the array m in a pretty way.)   ]   ] ] {HelpAdd} sendmsg2