===================================================================
RCS file: /home/cvs/OpenXM/src/k097/slib.sm1,v
retrieving revision 1.5
retrieving revision 1.10
diff -u -p -r1.5 -r1.10
--- OpenXM/src/k097/slib.sm1	2000/12/28 00:08:13	1.5
+++ OpenXM/src/k097/slib.sm1	2003/11/20 09:20:36	1.10
@@ -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
@@ -100,26 +220,6 @@ FunctionValue } def
 FunctionValue } def
 %%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 {
  db.DebugStack setstack $In function : Transpose of class PrimitiveObject$  stdstack 
  /Arglist set /Argthis set /FunctionValue [ ] def
@@ -182,9 +282,170 @@ FunctionValue } def
 /Reduction {
  db.DebugStack setstack $In function : Reduction of class PrimitiveObject$  stdstack 
  /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
- 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 
 FunctionValue } def
 %%end of function
@@ -209,6 +470,13 @@ FunctionValue } def
 this [ %% function args 
 Arglist ] {Length} sendmsg2 
 /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
  %% if-condition
   { %%ifbody
@@ -235,9 +503,11 @@ weightMatrix ] {Length} sendmsg2 
 this [ %% function args 
 size ] {NewVector} sendmsg2 
 /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 
-size  (1).. sub  (integer) data_conversion  1  2 -1 roll 
+ 2 -1 roll 
+ (1).. sub  (integer) data_conversion  1  2 -1 roll 
 { %% for body
  (universalNumber) data_conversion /i  set 
 weightMatrix [i  ]  Get
@@ -353,7 +623,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 
@@ -619,8 +889,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
@@ -660,35 +928,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
@@ -702,8 +951,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
@@ -714,8 +961,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
@@ -731,8 +976,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
@@ -743,8 +986,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
@@ -783,8 +1024,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
@@ -836,8 +1075,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
@@ -856,5 +1093,55 @@ FunctionValue } def
   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
+
+/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