===================================================================
RCS file: /home/cvs/OpenXM/src/k097/slib.sm1,v
retrieving revision 1.2
retrieving revision 1.7
diff -u -p -r1.2 -r1.7
--- OpenXM/src/k097/slib.sm1	2000/12/10 02:25:31	1.2
+++ OpenXM/src/k097/slib.sm1	2001/01/05 11:14:25	1.7
@@ -100,26 +100,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 +162,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
@@ -213,7 +354,9 @@ argsize (1)..  eq
  %% if-condition
   { %%ifbody
  [  vList  ring_of_differential_operators ( ) elimination_order 0 ] define_ring
-         /tmp set  tmp  /FunctionValue set  {/ExitPoint goto} exec %%return
+         /tmp set  this [ %% function args 
+] {SetRingVariables} sendmsg2 
+tmp  /FunctionValue set  {/ExitPoint goto} exec %%return
   }%%end if if body
   { %%if- else part
   } ifelse
@@ -270,6 +413,8 @@ tmp [j  ]  Get
 new0 [i  ] newtmp  Put
   } for 
  [  vList  ring_of_differential_operators   new0   weight_vector  pp   ] define_ring /ringpp  set
+this [ %% function args 
+] {SetRingVariables} sendmsg2 
   @@@.indexMode.flag.save @@@.indexMode  ringpp  /FunctionValue set  {/ExitPoint goto} exec %%return
 /ExitPoint ]pop popVariables %%pop the local variables
 /ExitPoint ]pop popVariables %%pop argValues
@@ -307,7 +452,7 @@ FunctionValue } def
 FunctionValue } def
 %%end of function
 
-true /SetRingVariables_Verbose  set
+false /SetRingVariables_Verbose  set
 /SetRingVariables {
  db.DebugStack setstack $In function : SetRingVariables of class PrimitiveObject$  stdstack 
  /Arglist set /Argthis set /FunctionValue [ ] def
@@ -321,13 +466,12 @@ this [ %% function args 
   { %%if- else part
   } ifelse
 this [ %% function args 
-(0)..  [(CC)] system_variable (universalNumber) dc  ] {k00setRingVariables} sendmsg2 
-this [ %% function args 
- [(C)] system_variable (universalNumber) dc   [(LL)] system_variable (universalNumber) dc  ] {k00setRingVariables} sendmsg2 
-this [ %% function args 
- [(L)] system_variable (universalNumber) dc   [(MM)] system_variable (universalNumber) dc  ] {k00setRingVariables} sendmsg2 
-this [ %% function args 
- [(M)] system_variable (universalNumber) dc   [(NN)] system_variable (universalNumber) dc  ] {k00setRingVariables} sendmsg2 
+(0)..  [(N)] system_variable (universalNumber) dc  ] {k00setRingVariables} sendmsg2 
+ %% if-condition
+  { %%ifbody
+  define_ring_variables    }%%end if if body
+  { %%if- else part
+  } ifelse
 SetRingVariables_Verbose  %% if-condition
   { %%ifbody
 this [ %% function args 
@@ -371,64 +515,49 @@ FunctionValue } def
 /k00setRingVariables {
  db.DebugStack setstack $In function : k00setRingVariables of class PrimitiveObject$  stdstack 
  /Arglist set /Argthis set /FunctionValue [ ] def
- [/this /tmp002_p /tmp002_q  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [/this /p /q  ] /ArgNames set ArgNames pushVariables [ %%function body
  [Argthis] Arglist join ArgNames mapset
 [ %%start of local variables
-/tmp002_i /tmp002_v /tmp002_str ] pushVariables [ %%local variables
-tmp002_p %%PSfor initvalue.
- (integer) data_conversion 
-tmp002_q  (1).. sub  (integer) data_conversion  1  2 -1 roll 
-{ %% for body
- (universalNumber) data_conversion /tmp002_i  set 
+/v /i ] pushVariables [ %%local variables
+p /i  set
+%%for init.
+%%for
+{ i q  lt
+ {  } {exit} ifelse
+[ {%%increment
+/i i (1).. {add} sendmsg2 def
+} %%end of increment{A}
+{%%start of B part{B}
 this [ %% function args 
-tmp002_i ] {getxvar} sendmsg2 
-/tmp002_v  set
+i ] {getxvar} sendmsg2 
+/v  set
 this [ %% function args 
-tmp002_v ] {k00AreThereLeftBrace} sendmsg2 
+v ] {k00AreThereLeftBrace} sendmsg2 
  %% if-condition
   { %%ifbody
+false  /FunctionValue set  {/ExitPoint goto} exec %%return
   }%%end if if body
   { %%if- else part
-SetRingVariables_Verbose  %% if-condition
-  { %%ifbody
-this [ %% function args 
-tmp002_v ] {Print} sendmsg2 
-this [ %% function args 
-( ) ] {Print} sendmsg2 
-  }%%end if if body
-  { %%if- else part
   } ifelse
 this [ %% function args 
-[ (/) tmp002_v ( $) tmp002_v ($ (poly) data_conversion def )   ] ] {AddString} sendmsg2 
-/str  set
- [(parse)   str   ] extension    } ifelse
+i ] {getdvar} sendmsg2 
+/v  set
 this [ %% function args 
-tmp002_i ] {getdvar} sendmsg2 
-/tmp002_v  set
-this [ %% function args 
-tmp002_v ] {k00AreThereLeftBrace} sendmsg2 
+v ] {k00AreThereLeftBrace} sendmsg2 
  %% if-condition
   { %%ifbody
+false  /FunctionValue set  {/ExitPoint goto} exec %%return
   }%%end if if body
   { %%if- else part
-SetRingVariables_Verbose  %% if-condition
-  { %%ifbody
-this [ %% function args 
-tmp002_v ] {Print} sendmsg2 
-this [ %% function args 
-( ) ] {Print} sendmsg2 
-  }%%end if if body
-  { %%if- else part
   } ifelse
-this [ %% function args 
-[ (/) tmp002_v ( $) tmp002_v ($ (poly) data_conversion def )   ] ] {AddString} sendmsg2 
-/str  set
- [(parse)   str   ] extension    } ifelse
-  } for 
+} %% end of B part. {B}
+ 2 1 roll] {exec} map pop
+} loop %%end of for
+true  /FunctionValue set  {/ExitPoint goto} exec %%return
 /ExitPoint ]pop popVariables %%pop the local variables
 /ExitPoint ]pop popVariables %%pop argValues
  db.DebugStack setstack pop stdstack 
-} def
+FunctionValue } def
 %%end of function
 
 /AddString {
@@ -728,3 +857,183 @@ FunctionValue } def
 
 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
+ [/this /a  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [Argthis] Arglist join ArgNames mapset
+[ %%start of local variables
+/b ] pushVariables [ %%local variables
+ [(parse) [(/)   a   ( load tag 0 eq 
+                          { /FunctionValue 0 def }
+                          { /FunctionValue 1 def } ifelse )] cat ] extension /ExitPoint ]pop popVariables %%pop the local variables
+/ExitPoint ]pop popVariables %%pop argValues
+ db.DebugStack setstack pop stdstack 
+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
+ [/this /a  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [Argthis] Arglist join ArgNames mapset
+ a   rest /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
+ db.DebugStack setstack pop stdstack 
+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
+ [/this /s  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [Argthis] Arglist join ArgNames mapset
+[ %%start of local variables
+/t /sss ] pushVariables [ %%local variables
+s /sss  set
+  [(stat) s] extension 0 get /t set  this [ %% function args 
+t ] {Tag} sendmsg2 
+(0)..  eq
+ %% if-condition
+  { %%ifbody
+this [ %% function args 
+[ this [ %% function args 
+(LOAD_K_PATH) ] {GetEnv} sendmsg2 
+(/) s   ] ] {AddString} sendmsg2 
+/s  set
+  [(stat) s] extension 0 get /t set  this [ %% function args 
+t ] {Tag} sendmsg2 
+(0)..  eq
+ %% if-condition
+  { %%ifbody
+null  /FunctionValue set  {/ExitPoint goto} exec %%return
+  }%%end if if body
+  { %%if- else part
+s  /FunctionValue set  {/ExitPoint goto} exec %%return
+  } ifelse
+  }%%end if if body
+  { %%if- else part
+s  /FunctionValue set  {/ExitPoint goto} exec %%return
+  } ifelse
+/ExitPoint ]pop popVariables %%pop the local variables
+/ExitPoint ]pop popVariables %%pop argValues
+ db.DebugStack setstack pop stdstack 
+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
+ [/this /fnames /flag  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [Argthis] Arglist join ArgNames mapset
+[ %%start of local variables
+/ppp /n /i /cmd ] pushVariables [ %%local variables
+this [ %% function args 
+flag ] {Boundp} sendmsg2 
+ %% if-condition
+  { %%ifbody
+  }%%end if if body
+  { %%if- else part
+this [ %% function args 
+fnames ] {Length} sendmsg2 
+/n  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 
+fnames [i  ]  Get
+] {GetPathName} sendmsg2 
+/ppp  set
+this [ %% function args 
+ppp ] {Tag} sendmsg2 
+(0)..  eq not
+ %% if-condition
+  { %%ifbody
+  [(parse) ppp pushfile ] extension  this [ %% function args 
+[ (/) flag ( 1 def )   ] ] {AddString} sendmsg2 
+/cmd  set
+  [(parse) cmd ] extension  n /i  set
+  }%%end if if body
+  { %%if- else part
+  } ifelse
+} %% end of B part. {B}
+ 2 1 roll] {exec} map pop
+} loop %%end of for
+  } ifelse
+/ExitPoint ]pop popVariables %%pop the local variables
+/ExitPoint ]pop popVariables %%pop argValues
+ db.DebugStack setstack pop stdstack 
+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
+ [/this /f  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [Argthis] Arglist join ArgNames mapset
+  f getRing /FunctionValue set  /ExitPoint ]pop popVariables %%pop argValues
+ db.DebugStack setstack pop stdstack 
+FunctionValue } def
+%%end of function
+
+/SetRing {
+ db.DebugStack setstack $In function : SetRing of class PrimitiveObject$  stdstack 
+ /Arglist set /Argthis set /FunctionValue [ ] def
+ [/this /r  ] /ArgNames set ArgNames pushVariables [ %%function body
+ [Argthis] Arglist join ArgNames mapset
+  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
+
+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
+ [/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
+
+this [ %% function args 
+[ (Pmat) [ (Pmat(m): ) (Print the array m in a pretty way.)   ]   ] ] {HelpAdd} sendmsg2