Annotation of OpenXM/src/k097/slib.k, Revision 1.4
1.4 ! takayama 1: /* $OpenXM: OpenXM/src/k097/slib.k,v 1.3 2000/12/10 02:21:46 takayama Exp $ */
1.1 maekawa 2: /* slib.sm1, standard library. */
3: /* April 26-- , 1996 */
4: /* Don't use function names that is already used as a postscipt macro names*/
5: /* You may encounter operand stack overflow. */
6: /* sm1("(incmac.sm1) run (slib.sm1) run ");
7: */
8: if (K00_verbose)
9: sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message ");
10:
11: Helplist = [ ];
12: def void HelpAdd(s) {
13: Helplist = Append(Helplist,s);
14: }
15:
16: def Print(a) { /* print object without new line */
17: sm1(a," messagen");
18: }
19: def Println(a) { /* print object with new line */
20: sm1(a," message");
21: }
22: def Ln() { sm1(" ( ) message"); } /* newline */
23: /* Warning!! When use sm1 as f = sm1(...), Never set /FunctionValue.
24: Example: f = sm1(" 1 1 add /FunctionValue set ") causes error.
25: */
26: def Poly(f) {
27: sm1(f," (poly) data_conversion /FunctionValue set");
28: }
29: def PolyR(f,r) { /* parse the polynomial in R */
30: sm1(f,r," ,, /FunctionValue set");
31: }
32: def Degree(f,v) {
33: sm1(f,v," degree (universalNumber) dc /FunctionValue set");
34: }
35:
36: def Append(f,g) { return(Join(f,[g])); }
37:
38: def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); }
39:
40: def Indexed(name,i) {
41: sm1(name,i," s.Indexed /FunctionValue set ");
42: }
43: /* Indexed2("a",2,3) ---> "a[2,3]" */
44: def Indexed2(name,i,j) {
45: sm1(name,i,j," s.Indexed2 /FunctionValue set ");
46: }
47: def Transpose(mat) {
48: sm1(mat," transpose /FunctionValue set ");
49: }
50:
51: sm1("
52: /s.Indexed {
53: (integer) dc /arg2 set
54: /arg1 set
55: arg1 ([) arg2 (dollar) dc (]) 4 cat_n
56: } def
57:
58: /s.Indexed2 {
59: (integer) dc /arg3 set
60: (integer) dc /arg2 set
61: /arg1 set
62: arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
63: } def
64: ");
65:
66: def Groebner(F) { /* Print("Input is "); Println(F); */
67: sm1(F," {[[(h). (1).]] replace homogenize} map /arg1 set
68: [arg1] groebner 0 get
69: /FunctionValue set "); }
70:
71: def GroebnerTime(F) { /* Print("Input is "); Println(F); */
72: sm1(F," {[[(h). (1).]] replace homogenize} map /arg1 set
73: { [arg1] groebner 0 get } timer
74: /FunctionValue set "); }
75:
76: def LiftStd(F) { /* Print("Input is "); Println(F); */
77: sm1(F," {[[(h). (1).]] replace homogenize} map /arg1 set
78: [arg1 [(needBack)]] groebner
79: /FunctionValue set "); }
80:
81: def Reduction(f,G) {
82: sm1(f,G," reduction /FunctionValue set ");
83: }
84:
85:
86:
87: def IntegerToSm1Integer(f) {
88: sm1(f, " (integer) dc /FunctionValue set ");
89: }
90: def RingD(vList,weightMatrix,pp) {
91: local new0,tmp,size,n,i,j,newtmp,ringpp,argsize;
92: argsize = Length(Arglist);
93: if (argsize == 1) {
94: sm1("[", vList,
95: "ring_of_differential_operators ( ) elimination_order 0 ] define_ring
96: /tmp set ");
97: return(tmp);
98: } else ;
99: if (argsize == 2) {
100: pp = 0;
101: }
102: pp = IntegerToSm1Integer(pp);
103: size = Length(weightMatrix);
104: new0 = NewVector(size);
105: sm1(" /@@@.indexMode.flag.save @@@.indexMode.flag def ");
106: sm1(" 0 @@@.indexMode ");
107: PSfor (i=0; i<size; i++) {
108: tmp = weightMatrix[i];
109: n = Length(tmp);
110: newtmp = NewVector(n);
111: for (j=1; j<n; j = j+2) {
112: newtmp[j-1] = tmp[j-1];
113: newtmp[j] = IntegerToSm1Integer( tmp[j] );
114: }
115: new0[i] = newtmp;
116: }
117: ringpp =
118: sm1("[", vList,
119: "ring_of_differential_operators ", new0, " weight_vector",pp, " ] define_ring");
120: /* setRingVariables(); It doesn't work. It's a mystery. */
121: sm1(" @@@.indexMode.flag.save @@@.indexMode ");
122: return( ringpp );
123: }
124:
125: /* RingD("x,y",[["x",2,"y",1]]);
126: RingD("x,y");
127: */
128:
129:
130:
131: /* from lib/setvariables.ccc : to generate sm1-package setvariables.sm1 */
132: /* 1997, 3/6 */
133: /* sm1(" 0 @@@.indexMode "); C-like notation of matrix. a[0], ... */
134:
135: def getxvar(i) {
136: sm1( "[(x) (var) ", i , " ..int ] system_variable /FunctionValue set ");
137: }
138:
139: def getdvar(i) {
140: sm1( "[(D) (var) ", i , " ..int ] system_variable /FunctionValue set ");
141: }
142:
143: def getvarn() {
144: sm1( "[(N)] system_variable (universalNumber) dc /FunctionValue set ");
145: }
146:
147: SetRingVariables_Verbose = true;
148: def SetRingVariables() {
149: /* Don't use local variables in this function,
150: because we set global variables in this function.
151: cf. SSWork/yacc/memo.txt, 1997,3/6 */
152: if (SetRingVariables_Verbose ) {
153: Print("SetRingVariables() Setting the global variables : ");
154: }
155: k00setRingVariables(0,sm1( "[(CC)] system_variable (universalNumber) dc "));
156: k00setRingVariables(sm1( "[(C)] system_variable (universalNumber) dc "),
157: sm1( "[(LL)] system_variable (universalNumber) dc "));
158: k00setRingVariables(sm1( "[(L)] system_variable (universalNumber) dc "),
159: sm1( "[(MM)] system_variable (universalNumber) dc "));
160: k00setRingVariables(sm1( "[(M)] system_variable (universalNumber) dc "),
161: sm1( "[(NN)] system_variable (universalNumber) dc "));
162: if (SetRingVariables_Verbose) {Ln();}
163: }
164:
165: def k00AreThereLeftBrace(s) {
166: local leftBrace, jj, slist;
167: leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc ");
168: jj = Position(StringToIntegerArray(s),leftBrace);
169: if (jj != -1) return(true); else return(false);
170: }
171:
172: def void k00setRingVariables(tmp002_p,tmp002_q) {
173: /* tmp002_ must not be used as variables names. */
174: local tmp002_i,tmp002_v,tmp002_str;
175: PSfor (tmp002_i=tmp002_p;tmp002_i<tmp002_q;tmp002_i++) {
176: tmp002_v = getxvar(tmp002_i);
177: if (k00AreThereLeftBrace(tmp002_v)) { ; }
178: else {
179: if (SetRingVariables_Verbose) {Print(tmp002_v); Print(" ");}
180: str = AddString(["/",tmp002_v," $",tmp002_v,"$ (poly) data_conversion def "]);
181: sm1("[(parse) ",str," ] extension ");
182: }
183: tmp002_v = getdvar(tmp002_i);
184: if (k00AreThereLeftBrace(tmp002_v)) { ; }
185: else {
186: if (SetRingVariables_Verbose) {Print(tmp002_v); Print(" ");}
187: str = AddString(["/",tmp002_v," $",tmp002_v,"$ (poly) data_conversion def "]);
188: sm1("[(parse) ",str," ] extension ");
189: }
190: }
191: }
192: /* ---------------------------------- */
193:
194: def AddString(f) {
195: sm1(f," aload length cat_n /FunctionValue set ");
196: }
197:
198: def IntegerToString(f) {
199: sm1(f," (string) dc /FunctionValue set ");
200: }
201:
202: def Replace(f,rule) {
203: sm1(f,rule," replace /FunctionValue set ");
204: }
205:
206: def AsciiToString(c) {
207: sm1(c," (integer) dc (string) dc /FunctionValue set ");
208: }
209:
210:
211: /* From lib/tostr.ccc */
212: def ToString(p) {
213: local n,ans,i;
214: ans = [ ];
215: if (IsArray(p)) {
216: n = Length(p);
217: ans = Append(ans,"[ ");
218: for (i=0; i<n; i++) {
219: ans = Append(ans,ToString(p[i]));
220: if (i != n-1) {
221: ans = Append(ans," , ");
222: }
223: }
224: ans = Append(ans," ] ");
225: } else {
226: ans = [ sm1(p," (dollar) dc ") ];
227: /* Println(ans); */
228: }
229: return(AddString(ans));
230: }
231:
232: def IsArray(p) {
233: sm1(p," isArray /FunctionValue set ");
234: }
235:
236:
237: /* Println(tostr2([1,[2,3,4]])); */
238:
239:
240: def Denominator(f) {
241: sm1(f," (denominator) dc /FunctionValue set ");
242: }
243:
244: def Numerator(f) {
245: sm1(f," (numerator) dc /FunctionValue set ");
246: }
247:
248:
249: def Replace(f,rule) {
250: local ans,n,tmp,i,num,den;
251: if (IsArray(f)) {
252: n = Length(f);
253: ans = [ ];
254: for (i=0; i<n; i++) {
255: ans = Append(ans, Replace(f[i],rule));
256: }
257: return(ans);
258: }
259:
260: if (sm1(f," tag RationalFunctionP eq ")) {
261: num = Numerator(f);
262: den = Denominator(f);
263: num = sm1(num,rule, " replace ");
264: den = sm1(den,rule, " replace ");
265: return( num/den );
266: }
267:
268: sm1( f, rule , " replace /FunctionValue set ");
269: }
270:
271:
272:
273: /* 1997, 3/7 */
274: def Map(karg,func) {
275: sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set");
276: }
277: HelpAdd(["Map",
278: ["Map(karg,func) applies the function <<func>> to the <<karg>>(string func).",
279: " Ex. Map([82,83,85],\"AsciiToString\"):"]]);
280: /* test Map
281: def foo1(i) { return(i*2); }
282: def foo() {
283: Println(Map([82,83,84],"foo1"));
284: }
285: */
286:
287: def Position(list,elem) {
288: local n,pos,i;
289: n = Length(list);
290: pos = -1;
291: for (i=0; i<n; i++) {
292: if (elem == list[i]) {
293: pos = i;
294: sm1(" /k00.label0 goto ");
295: }
296: }
297: sm1(" /k00.label0 ");
298: return(pos);
299: }
300: HelpAdd(["Position",
301: ["Position(list,elem) returns the position p of the element <<elem>> in",
302: " the array <<list>>. If <<elem>> is not in <<list>>, it return -1",
303: " (array list).",
304: "Ex. Position([1,34,2],34): "]]);
305:
306: def StringToIntegerArray(s) {
307: sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set ");
308: }
309: HelpAdd(["StringToIntegerArray",
310: ["StringToIntegerArray(s) decomposes the string <<s>> into an array of",
311: "ascii codes of <<s>> (string s).",
312: "cf. AsciiToString."]]);
313: def StringToAsciiArray(s) { return(StringToIntegerArray(s)); }
314: HelpAdd(["StringToAsciiArray",
315: ["StringToAsciiArray(s) is StringToIntegerArray(s)."]]);
316:
317:
318: def NewArray(n) {
319: return(NewVector(n));
320: }
321: HelpAdd(["NewArray",
322: ["NewArray(n) returns an array of size n (integer n)."]]);
323:
1.3 takayama 324: def GetEnv(s) {
325: sm1(" [(getenv) s] extension /FunctionValue set ");
326: }
327: HelpAdd(["GetEnv",
328: ["GetEnv(s) returns the value of the environmental variable s (string s)."]]);
1.4 ! takayama 329: def Boundp(a) {
! 330: local b;
! 331: sm1("[(parse) [(/) ",a," ( load tag 0 eq
! 332: { /FunctionValue 0 def }
! 333: { /FunctionValue 1 def } ifelse )] cat ] extension");
! 334: }
! 335: HelpAdd(["Boundp",
! 336: ["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]);
! 337: def Rest(a) {
! 338: sm1(a," rest /FunctionValue set ");
! 339: }
! 340: HelpAdd(["Rest",
! 341: ["Rest(a) returns the rest (cdr) of a (list a)."]]);
! 342: def GetPathName(s) {
! 343: local t,sss;
! 344: sss = s;
! 345: sm1(" [(stat) s] extension 0 get /t set ");
! 346: if (Tag(t) == 0) {
! 347: s=AddString([GetEnv("LOAD_K_PATH"),"/",s]);
! 348: sm1(" [(stat) s] extension 0 get /t set ");
! 349: if (Tag(t) == 0) {
! 350: return(null);
! 351: }else{
! 352: return(s);
! 353: }
! 354: }else{
! 355: return(s);
! 356: }
! 357: }
! 358: HelpAdd(["GetPathName",
! 359: ["GetPathName(s) checks if the file s exists in the current directory or",
! 360: "in LOAD_K_PATH. If there exists, it returns the path name (string s)."]]);
! 361:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to slib.k CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097