=================================================================== RCS file: /home/cvs/OpenXM/src/k097/slib.sm1,v retrieving revision 1.6 retrieving revision 1.10 diff -u -p -r1.6 -r1.10 --- OpenXM/src/k097/slib.sm1 2001/01/04 12:29:31 1.6 +++ 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 @@ -370,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 @@ -396,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 @@ -514,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 @@ -780,8 +889,6 @@ FunctionValue } def FunctionValue } def %%end of function -this [ %% function args -[ (Map) [ (Map(karg,func) applies the function <> to the <>(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 @@ -821,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 <> in) ( the array <>. If <> is not in <>, 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 <> into an array of) (ascii codes of <> (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 @@ -863,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 @@ -875,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 @@ -892,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 @@ -904,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 @@ -944,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 @@ -997,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 @@ -1017,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