=================================================================== RCS file: /home/cvs/OpenXM/src/k097/slib.k,v retrieving revision 1.7 retrieving revision 1.12 diff -u -p -r1.7 -r1.12 --- OpenXM/src/k097/slib.k 2001/01/04 12:29:31 1.7 +++ OpenXM/src/k097/slib.k 2004/09/10 13:20:23 1.12 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/k097/slib.k,v 1.6 2000/12/28 00:08:13 takayama Exp $ */ +/* $OpenXM: OpenXM/src/k097/slib.k,v 1.11 2003/11/20 09:20:36 takayama Exp $ */ /* slib.sm1, standard library. */ /* April 26-- , 1996 */ /* Don't use function names that is already used as a postscipt macro names*/ @@ -8,11 +8,62 @@ if (K00_verbose) sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message "); + +/* + Each Helplist[i] has the format + [ category, [ key, explanations, ( args ,) (refs ,) (short descriptions)]] + category : null or string + key : string + explanations : string or array of string (Ex. and << >> are key words) + args : null or list of strings + refs : null or list of strings + short descriptions : string +*/ Helplist = [ ]; -def void HelpAdd(s) { +def void HelpAdd(s,category) { + local n; + n = Length(Arglist); + if (n <= 1) { + category = null; + } + if (true) { + /* Assert the args */ + /* You can use functions only defined before using HelpAdd */ + if (!(n == 1 || n == 2)) { + Println(s); + Error("HelpAdd: wrong argument length."); + } + if (!(Tag(category) == 0 || Tag(category) == 5)) { + Println(category); + Error("HelpAdd: wrong category."); + } + if (!(Tag(s) == 6)) { + Println(s); + Error("HelpAdd: s must be an array."); + } + if (! (Tag(s[0]) == 5)) { + Println(s); + Error("HelpAdd: s[0] must be a string."); + } + if (! (Tag(s[1]) == 5 || Tag(s[1]) == 6)) { + Println(s); + Error("HelpAdd: s[1] must be a string or an array."); + } + /* End of assert */ + } + s = [category,s]; Helplist = Append(Helplist,s); } +def Tag(f) { + local ans; + ans = sm1(f," etag (universalNumber) dc "); + return(ans); +} +def Error(s) { + sm1(" s error "); +} + def Print(a) { /* print object without new line */ sm1(a," messagen"); } @@ -27,7 +78,7 @@ def Poly(f) { sm1(f," (poly) data_conversion /FunctionValue set"); } def PolyR(f,r) { /* parse the polynomial in R */ - sm1(f,r," ,, /FunctionValue set"); + sm1(f,r," __ /FunctionValue set"); } def Degree(f,v) { sm1(f,v," degree (universalNumber) dc /FunctionValue set"); @@ -37,13 +88,6 @@ def Append(f,g) { return(Join(f,[g])); } def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); } -def Indexed(name,i) { - sm1(name,i," s.Indexed /FunctionValue set "); -} -/* Indexed2("a",2,3) ---> "a[2,3]" */ -def Indexed2(name,i,j) { - sm1(name,i,j," s.Indexed2 /FunctionValue set "); -} def Transpose(mat) { sm1(mat," transpose /FunctionValue set "); } @@ -149,6 +193,9 @@ def IntegerToSm1Integer(f) { def RingD(vList,weightMatrix,pp) { local new0,tmp,size,n,i,j,newtmp,ringpp,argsize; argsize = Length(Arglist); + if (IsArray(vList)) { + sm1(" vList {toString} map from_records /vList set "); + } if (argsize == 1) { sm1("[", vList, "ring_of_differential_operators ( ) elimination_order 0 ] define_ring @@ -221,7 +268,7 @@ def SetRingVariables() { def k00AreThereLeftBrace(s) { local leftBrace, jj, slist; leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc "); - jj = Position(StringToIntegerArray(s),leftBrace); + jj = Position(StringToAsciiArray(s),leftBrace); if (jj != -1) return(true); else return(false); } @@ -324,9 +371,6 @@ def Replace(f,rule) { def Map(karg,func) { sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set"); } -HelpAdd(["Map", - ["Map(karg,func) applies the function <> to the <>(string func).", - " Ex. Map([82,83,85],\"AsciiToString\"):"]]); /* test Map def foo1(i) { return(i*2); } def foo() { @@ -347,48 +391,27 @@ def Position(list,elem) { sm1(" /k00.label0 "); return(pos); } -HelpAdd(["Position", - ["Position(list,elem) returns the position p of the element <> in", - " the array <>. If <> is not in <>, it return -1", - " (array list).", - "Ex. Position([1,34,2],34): "]]); -def StringToIntegerArray(s) { +def StringToAsciiArray(s) { sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set "); } -HelpAdd(["StringToIntegerArray", - ["StringToIntegerArray(s) decomposes the string <> into an array of", - "ascii codes of <> (string s).", - "cf. AsciiToString."]]); -def StringToAsciiArray(s) { return(StringToIntegerArray(s)); } -HelpAdd(["StringToAsciiArray", - ["StringToAsciiArray(s) is StringToIntegerArray(s)."]]); - def NewArray(n) { return(NewVector(n)); } -HelpAdd(["NewArray", -["NewArray(n) returns an array of size n (integer n)."]]); def GetEnv(s) { sm1(" [(getenv) s] extension /FunctionValue set "); } -HelpAdd(["GetEnv", -["GetEnv(s) returns the value of the environmental variable s (string s)."]]); def Boundp(a) { local b; sm1("[(parse) [(/) ",a," ( load tag 0 eq { /FunctionValue 0 def } { /FunctionValue 1 def } ifelse )] cat ] extension"); } -HelpAdd(["Boundp", -["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]); def Rest(a) { sm1(a," rest /FunctionValue set "); } -HelpAdd(["Rest", -["Rest(a) returns the rest (cdr) of a (list a)."]]); def GetPathName(s) { local t,sss; sss = s; @@ -405,9 +428,6 @@ def GetPathName(s) { return(s); } } -HelpAdd(["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)."]]); def Load_sm1(fnames,flag) { local ppp,n,i,cmd; @@ -426,10 +446,6 @@ def Load_sm1(fnames,flag) { } } -HelpAdd(["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)."]]); def GetRing(f) { sm1(" f getRing /FunctionValue set "); @@ -437,4 +453,26 @@ def GetRing(f) { def SetRing(r) { sm1(" r ring_def "); -} +} + +def ReParse(a) { + local c; + if (IsArray(a)) { + c = Map(a,"ReParse"); + }else{ + sm1(a," toString . /c set"); + } + return(c); +} + +def void Pmat(a) { + sm1(" a pmat "); +} + +def void QuoteMode(a) { + if ( a == 0) { + sm1("[(QuoteMode) 0] system_variable "); + }else{ + sm1("[(QuoteMode) 1] system_variable "); + } +} \ No newline at end of file