Annotation of OpenXM/src/k097/slib.k, Revision 1.5
1.5 ! takayama 1: /* $OpenXM: OpenXM/src/k097/slib.k,v 1.4 2000/12/10 03:12:19 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 ");
1.5 ! takayama 97: SetRingVariables();
1.1 maekawa 98: return(tmp);
99: } else ;
100: if (argsize == 2) {
101: pp = 0;
102: }
103: pp = IntegerToSm1Integer(pp);
104: size = Length(weightMatrix);
105: new0 = NewVector(size);
106: sm1(" /@@@.indexMode.flag.save @@@.indexMode.flag def ");
107: sm1(" 0 @@@.indexMode ");
108: PSfor (i=0; i<size; i++) {
109: tmp = weightMatrix[i];
110: n = Length(tmp);
111: newtmp = NewVector(n);
112: for (j=1; j<n; j = j+2) {
113: newtmp[j-1] = tmp[j-1];
114: newtmp[j] = IntegerToSm1Integer( tmp[j] );
115: }
116: new0[i] = newtmp;
117: }
118: ringpp =
119: sm1("[", vList,
120: "ring_of_differential_operators ", new0, " weight_vector",pp, " ] define_ring");
1.5 ! takayama 121: SetRingVariables();
1.1 maekawa 122: sm1(" @@@.indexMode.flag.save @@@.indexMode ");
123: return( ringpp );
124: }
125:
126: /* RingD("x,y",[["x",2,"y",1]]);
127: RingD("x,y");
128: */
129:
130:
131:
132: /* from lib/setvariables.ccc : to generate sm1-package setvariables.sm1 */
133: /* 1997, 3/6 */
134: /* sm1(" 0 @@@.indexMode "); C-like notation of matrix. a[0], ... */
135:
136: def getxvar(i) {
137: sm1( "[(x) (var) ", i , " ..int ] system_variable /FunctionValue set ");
138: }
139:
140: def getdvar(i) {
141: sm1( "[(D) (var) ", i , " ..int ] system_variable /FunctionValue set ");
142: }
143:
144: def getvarn() {
145: sm1( "[(N)] system_variable (universalNumber) dc /FunctionValue set ");
146: }
147:
1.5 ! takayama 148: SetRingVariables_Verbose = false;
1.1 maekawa 149: def SetRingVariables() {
150: /* Don't use local variables in this function,
151: because we set global variables in this function.
152: cf. SSWork/yacc/memo.txt, 1997,3/6 */
153: if (SetRingVariables_Verbose ) {
154: Print("SetRingVariables() Setting the global variables : ");
155: }
1.5 ! takayama 156: if (k00setRingVariables(0,sm1( "[(N)] system_variable (universalNumber) dc "))) {
! 157: sm1(" define_ring_variables ");
! 158: }
1.1 maekawa 159: if (SetRingVariables_Verbose) {Ln();}
160: }
161:
162: def k00AreThereLeftBrace(s) {
163: local leftBrace, jj, slist;
164: leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc ");
165: jj = Position(StringToIntegerArray(s),leftBrace);
166: if (jj != -1) return(true); else return(false);
167: }
168:
1.5 ! takayama 169: def k00setRingVariables(p,q) {
! 170: local v,i;
! 171: for (i = p; i< q; i++) {
! 172: v = getxvar(i);
! 173: if (k00AreThereLeftBrace(v)) {
! 174: return(false);
1.1 maekawa 175: }
1.5 ! takayama 176: v = getdvar(i);
! 177: if (k00AreThereLeftBrace(v)) {
! 178: return(false);
1.1 maekawa 179: }
180: }
1.5 ! takayama 181: return(true);
1.1 maekawa 182: }
183: /* ---------------------------------- */
184:
185: def AddString(f) {
186: sm1(f," aload length cat_n /FunctionValue set ");
187: }
188:
189: def IntegerToString(f) {
190: sm1(f," (string) dc /FunctionValue set ");
191: }
192:
193: def Replace(f,rule) {
194: sm1(f,rule," replace /FunctionValue set ");
195: }
196:
197: def AsciiToString(c) {
198: sm1(c," (integer) dc (string) dc /FunctionValue set ");
199: }
200:
201:
202: /* From lib/tostr.ccc */
203: def ToString(p) {
204: local n,ans,i;
205: ans = [ ];
206: if (IsArray(p)) {
207: n = Length(p);
208: ans = Append(ans,"[ ");
209: for (i=0; i<n; i++) {
210: ans = Append(ans,ToString(p[i]));
211: if (i != n-1) {
212: ans = Append(ans," , ");
213: }
214: }
215: ans = Append(ans," ] ");
216: } else {
217: ans = [ sm1(p," (dollar) dc ") ];
218: /* Println(ans); */
219: }
220: return(AddString(ans));
221: }
222:
223: def IsArray(p) {
224: sm1(p," isArray /FunctionValue set ");
225: }
226:
227:
228: /* Println(tostr2([1,[2,3,4]])); */
229:
230:
231: def Denominator(f) {
232: sm1(f," (denominator) dc /FunctionValue set ");
233: }
234:
235: def Numerator(f) {
236: sm1(f," (numerator) dc /FunctionValue set ");
237: }
238:
239:
240: def Replace(f,rule) {
241: local ans,n,tmp,i,num,den;
242: if (IsArray(f)) {
243: n = Length(f);
244: ans = [ ];
245: for (i=0; i<n; i++) {
246: ans = Append(ans, Replace(f[i],rule));
247: }
248: return(ans);
249: }
250:
251: if (sm1(f," tag RationalFunctionP eq ")) {
252: num = Numerator(f);
253: den = Denominator(f);
254: num = sm1(num,rule, " replace ");
255: den = sm1(den,rule, " replace ");
256: return( num/den );
257: }
258:
259: sm1( f, rule , " replace /FunctionValue set ");
260: }
261:
262:
263:
264: /* 1997, 3/7 */
265: def Map(karg,func) {
266: sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set");
267: }
268: HelpAdd(["Map",
269: ["Map(karg,func) applies the function <<func>> to the <<karg>>(string func).",
270: " Ex. Map([82,83,85],\"AsciiToString\"):"]]);
271: /* test Map
272: def foo1(i) { return(i*2); }
273: def foo() {
274: Println(Map([82,83,84],"foo1"));
275: }
276: */
277:
278: def Position(list,elem) {
279: local n,pos,i;
280: n = Length(list);
281: pos = -1;
282: for (i=0; i<n; i++) {
283: if (elem == list[i]) {
284: pos = i;
285: sm1(" /k00.label0 goto ");
286: }
287: }
288: sm1(" /k00.label0 ");
289: return(pos);
290: }
291: HelpAdd(["Position",
292: ["Position(list,elem) returns the position p of the element <<elem>> in",
293: " the array <<list>>. If <<elem>> is not in <<list>>, it return -1",
294: " (array list).",
295: "Ex. Position([1,34,2],34): "]]);
296:
297: def StringToIntegerArray(s) {
298: sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set ");
299: }
300: HelpAdd(["StringToIntegerArray",
301: ["StringToIntegerArray(s) decomposes the string <<s>> into an array of",
302: "ascii codes of <<s>> (string s).",
303: "cf. AsciiToString."]]);
304: def StringToAsciiArray(s) { return(StringToIntegerArray(s)); }
305: HelpAdd(["StringToAsciiArray",
306: ["StringToAsciiArray(s) is StringToIntegerArray(s)."]]);
307:
308:
309: def NewArray(n) {
310: return(NewVector(n));
311: }
312: HelpAdd(["NewArray",
313: ["NewArray(n) returns an array of size n (integer n)."]]);
314:
1.3 takayama 315: def GetEnv(s) {
316: sm1(" [(getenv) s] extension /FunctionValue set ");
317: }
318: HelpAdd(["GetEnv",
319: ["GetEnv(s) returns the value of the environmental variable s (string s)."]]);
1.4 takayama 320: def Boundp(a) {
321: local b;
322: sm1("[(parse) [(/) ",a," ( load tag 0 eq
323: { /FunctionValue 0 def }
324: { /FunctionValue 1 def } ifelse )] cat ] extension");
325: }
326: HelpAdd(["Boundp",
327: ["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]);
328: def Rest(a) {
329: sm1(a," rest /FunctionValue set ");
330: }
331: HelpAdd(["Rest",
332: ["Rest(a) returns the rest (cdr) of a (list a)."]]);
333: def GetPathName(s) {
334: local t,sss;
335: sss = s;
336: sm1(" [(stat) s] extension 0 get /t set ");
337: if (Tag(t) == 0) {
338: s=AddString([GetEnv("LOAD_K_PATH"),"/",s]);
339: sm1(" [(stat) s] extension 0 get /t set ");
340: if (Tag(t) == 0) {
341: return(null);
342: }else{
343: return(s);
344: }
345: }else{
346: return(s);
347: }
348: }
349: HelpAdd(["GetPathName",
350: ["GetPathName(s) checks if the file s exists in the current directory or",
351: "in LOAD_K_PATH. If there exists, it returns the path name (string s)."]]);
352:
1.5 ! takayama 353: def Load_sm1(fnames,flag) {
! 354: local ppp,n,i,cmd;
! 355: if (Boundp(flag)) {
! 356: }else{
! 357: n = Length(fnames);
! 358: for (i=0; i<n; i++) {
! 359: ppp = GetPathName(fnames[i]);
! 360: if (Tag(ppp) != 0) {
! 361: sm1(" [(parse) ppp pushfile ] extension ");
! 362: cmd = AddString(["/",flag," 1 def "]);
! 363: sm1(" [(parse) cmd ] extension ");
! 364: i=n; /* break; */
! 365: }
! 366: }
! 367: }
! 368: }
! 369:
! 370: HelpAdd(["Load_sm1",
! 371: ["Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....",
! 372: "If loading is succeeded, the already-loaded flag is set to true.",
! 373: "(list s, string flag)."]]);
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