При наличии в текущем сеансе Windows нескольких активных Maple-сеансов в целом ряде случаев возникает необходимость их идентификации. Решает эту задачу Kernelsпроцедура, чей вызов Kernels() возвращает последовательность 2-элементных списков, первый элемент который определяет ID процесса и второй – соответствующий ему активный Maple-сеанс, точнее загруженное ядро этого сеанса. При этом, порядок элементов последовательности соответствует порядку загрузки Maple-сеансов в Windows.
| Kernels := proc() local a b c d h t k, , , , , , ; assign(' 'c = "$ArtKr$", ' 't = interface(warnlevel)), assign(' 'a = system cat(( "tlist.exe > ", c))); interface(warnlevel = 0), com_exe2({`tlist.exe`}), interface(warnlevel = t); assign67(b = fopen(c, 'READ'), d = NULL, h = "maple"); do a := readline( )c ; if a = 0 then break else if search(Case(a), h) then k := SLD(Red_n(a, " " 2, ), " " ;) d := d, `if`(search(k[2], "maple"), [came(k[1]), k[2]], NULL) end if end if end do; d, delf( )c end proc > Kernels(); ⇒ [3404, "maplew8.exe"], [2068, "cwmaple.exe"], [2692, "maplew.exe"], [2736, "cwmaple9.exe"], [2464, "wmaple.exe"] |
Вызов процедуры Release() возвращает целое число 6, 7, 8, 9, 9.5, 10 или 11 для семи последних релизов пакета и значение`Other release` в противном случае. Если же вызов процедуры Release(h) использует необязательный h-аргумент (имя), через него возвращается полный путь к главному каталогу пакета, как иллюстрирует следующий фрагмент. В отличие от Release, вызов процедуры Release1() возвращает число 6 для 6-го релиза и 7 для релизов 7 – 11 пакета. Это обусловлено причинами, изложенными ниже.
| Release := proc() local k cd L R, , , ; assign(cd = currentdir( ), L = [libname ]); for k to nops(L) do try currentdir(cat(L k[ ][1 .. searchtext("/lib", L k[ ])], "license")) catch "file or directory does not exist": NULL catch "file or directory, %1, does not exist": NULL end try end do; assign(R = readbytes "license.dat", '( TEXT', ∞)), close "license.dat"( ), |
| `if`(nargs = 1, assign([args][1] = currentdir( )[1 .. -9]), NULL), currentdir(cd); `if` search( ,( R "Maple7With"), ,7 `if` search( ,( R "MapleWith" , 6, `if`() search(R, "Maple8With"), 8, `if` search( ,( R "Maple9With" , 9, `if`() search(R, "Maple9.5With"), 9.5, `if` search( ,( R "Maple10With" , 10, ) `if`(search(R, "Maple11With"), 11, `Other release`))))))) end proc > Release(h), h; ⇒ 10, "C:\Program Files\Maple 10" Release1 := proc() local v f k, , ; assign(f = cat(currentdir( ), "/$Kr_Art$.m")), (proc( )x local v; v := 63; save ,v x end proc )( )f , `if`(nargs = 0 9, , assign(args 1[ ] = [type(mkdir, 'libobj'), _libobj][2])), assign('v' = readbytes(f, 'TEXT', ∞)), fremove(f); `if`(v[4] = "5" 5 `if`, , (v[4] = "4" 4, , [search( ,v "R0" ' ', f ), `if`( member(parse(v[2 .. f − 1]), {k $ (k = 6 .. 10)}), parse( [v 2 .. f − 1]), Release( ))][2])) end proc > Release1(h), h; ⇒ 7, "C:\Program Files\Maple 10/lib" |
Тогда как вызов Release1(h) через h дополнительно возвращает полный путь к главной библиотеке пакета. При этом, процедура идентифицирует и более ранние релизы 4 и 5 пакета. Данная процедура, прежде всего, представляет несомненный интерес в связи с отсутствием полной совместимости (как «сверху-вниз», так и «снизу-вверх») релизов 6, с одной стороны, и релизов 7–11, с другой стороны. Детально этот вопрос рассмотрен в [41].
В ряде случаев возникает задача определения наличия вызовов заданной функции/процедуры N в некоторой процедуре Proc. Точнее, нас будут интересовать форматы таких вызовов. Данная задача решается процедурой extrcalls, представленной ниже.
| extrcalls := proc(P::procedure, N::symbol) local a b c d k p Res, , , , , , ; assign67(a = "" || N || "(", Res = NULL, b = convert(eval(P), 'string')); unassign '( _Lab'), assign(d = length(a), c = Search2(b, {a})); if c = [ ] then error "call of the form <%1> does not exist","" || a || "...)" else for k in c do p := d; _Lab; try parse cat( [( b k .. k + p])) catch : p := p + 1; goto(_Lab) end try ; Res := Res, b[k .. k + p] end do; [Res] end if end proc > Proc:= proc() local a,b,c,d,y,x,v,x1,y1,w,g; a:=56; assign(x=56, y=(a+b)/(c+d)); sin(sqrt(x+y)*(a+b)/(c-d)); writeline(f, "GRSU"); assign(v=42, 'h'=(a+b)^2*(x1+y1)/(c+d)); Close(f); assign('w'=64, 'g'=(a+b)^2*(x1+y1)/(c+d)); sin(a1+b1); a*x*y*sin(x+y) end proc: |
| > extrcalls(Proc, assign), extrcalls(Proc, sin), extrcalls(Proc, writeline), extrcalls(Proc, Close); extrcalls(Proc, cos); ["assign(x = 56,y = (a+b)/(c+d))", "assign(v = 42,('h') = (a+b)^2*(x1+y1)/(c+d))", "assign(('w') = 64, ('g') = (a+b)^2*(x1+y1)/(c+d))"], ["sin(sqrt(y+x)*(a+b)/(c-d))", "sin(a1+b1)", "sin(y+x)"], ["writeline(f,"GRSU")"], ["Close(f)"] Error, (in extrcalls) call of the form <cos(...)> does not exist |
Вызов процедуры extrcalls(Proc, N) возвращает список вызовов функции N, используемых процедурой P. Вызовы возвращаюся в строчном формате, дабы не инициировать реальных вызовов вне тела процедуры. В случае отсутствия искомых вызовов инициируется ошибочная ситуация с диагностикой «call of the form <%1> does not exist». Данная процедура имеет целый ряд полезных применений при разработке приложений.
Как уже отмечалось [103], Maple-язык допускает использование встроенной goto-функции безусловных переходов. Поэтому в ряде случаев возникает задача проверки на наличие в процедуре такого типа вызовов. Вызов процедуры isplabel(P) возвращает значение true, если процедура Р использует вызов функции goto; в противном случае возвращается false-значение. Тогда как вызов процедуры isplabel(P, T) с дополнительным Т-аргументом обеспечивает возврат через него множества имен всех меток, обусловленных goto-вызовами в процедуре Р. При этом, процедура обеспечивает проверку меток процедуры Р на допустимость. В случае обнаружения недопустимости выводится соответствующее сообщение. Для обеспечения корректности использования меток может быть использована процедура Lprot [41,103], обеспечивающая присвоение protected-атрибута всем меткам заданной процедуры. Ниже приводится исходный текст isplabel-процедуры и пример ее конкретного применения для тестирования goto-переходов.
| isplabel := proc(P::procedure) local a b c d k p h t, , , , , , , ; assign(d = { }, a = interface(verboseproc )), interface(verboseproc = 3); assign(b = convert(eval(P), 'string'), p = { }), assign(c = Search2(b, {" goto("}), interface(verboseproc = a)); if c = [ ] then false else if search(b[1 .. c[1]], "unassign(" ' ', t ) then h := {parse(b[t + 8 .. nexts(b t, , ")")[2]])} end if; for k in c do d := {op(d), cat(``, b[k + 6 .. nexts(b, k, ")")[2] − 1])} end do ; true, seq( `if`(type(eval(d k[ ]), 'symbol'), NULL, assign(' 'p = {d k[ ], op(p)})), k = 1 .. nops(d)), `if`(p = { }, NULL, `if`( map(eval, map(eval, h)) = map(eval, d), NULL, WARNING("proc\ edure <%1> contains invalid labels %2; error is possible at the proc\e dure call", P, `if`(type(h, 'symbol'), ,p p minus h)))), `if`(1 < nargs and type(args 2[ ], 'symbol'), assign(args 2[ ] = d), NULL) end if end proc > isplabel(MkDir), isplabel(mwsname, R), R; false, true, {VGS_vanaduspension_14062005} |
Вызов процедуры swmpat(S, m, p, d {, h}) возвращает true-значение тогда и только тогда, когда строка S содержит вхождения подстрок, соответствующих шаблону m с группирующими символами, определенными четвертым d-аргументом.
| swmpat := proc( S::{string symbol, }, m::{string symbol, }, p::list(posint), d::{string symbol, }) local a b c C j k h s s1 m1 d1 v r res, , , , , , , , , , , , , , ν, n, ω, , , ,t ε x y; assign67(c = {args} minus {S insensitive m p d, , , , }, s = convert([7], 'bytes'), y = args); C := (x, y) → `if`(member(insensitive, {args}), Case(x), x); if not search(m d, ) then h := Search2(C(S, args), {C(m, args)}); if h ≠ [ ] then RETURN(true, `if`(c = { }, NULL, `if`( type(c[1], 'assignable1'), assign(c[1] = h), WARNING( "argument %1 should be symbol but has received %2", c[1], whattype eval( [( c 1])))))) else RETURN(false) end if else assign(ν = ((x, n) → cat(x $ (b = 1 .. n))), ω = (t → `if`(t = 0, 0, 1))); ε := proc(x y, ) local k; [seq(`if`(x k[ ] = y k[ ], ,0 1), k = 1 .. nops( )x )] end proc end if; assign(s1 = cat "",( S), m1 = cat "",( m), d1 = cat "",( d)[1], v = [ ], h = "", r = [ ], res = false, a = 0); for k to length(m1) do try if m1[k] ≠ d1 then h := cat(h, m1[k]); v := [op(v), 0] else a := a + 1; h := cat(h, ν(s, p a[ ])); v := [op( )v , 1 $ (j = 1 .. p a[ ])] end if catch "invalid subscript selector": h := cat(h s, ); v := [op( )v , 1]; next end try end do; assign(' 'h = convert(C(h, args), 'list1'), 's1' = convert(C(s1, args), 'list1')), assign(t = nops(h)); for k to nops(s1) − + t 1 do if ε(s1[k .. k + − t 1], h) = v then res := true; r := [op(r), [k, k + t − 1]]; k := k + t + 1 end if end do; res, `if`(c = { }, NULL, `if` type(( c[1], 'assignable1'), assign(c[1] = r), WARNING "argument %1 should be symbol but has received %2" [( , c 1], whattype(eval(c[1]))))) end proc > swmpat(S, "art1986kr", [7, 14], "*", `insensitive`, t), t; ⇒ true, [15, 36] |
Тогда как третий фактический р-аргумент задает список кратностей соответствующих вхождений группирующих символов в m-шаблон. Если вызов процедуры swmpat(S, m, p, d, h) использует пятый необязательный h-аргумент и возвращает true-значение, то через h возвращается вложенный список, чьи 2-элементные подсписки определяют первую и последнюю позиции непересекающихся подстрок S, соответствующих m-шаблону. В случае отсутствия в m-шаблоне группирующих символов через h-аргумент возвращается целочисленный список, чьи элементы определяют первые позиции непересекающихся подстрок S, соответствующих m-шаблону. Детально с процедурой swmpat и ее модификацией swmpat1 можно ознакомиться в [41,103,109].
Вызов Red_n(S, G, N) возвращает результат сведения кратных вхождений в строку/символ S символов/строк, определенных G-аргументом, к кратности не большей, чем N.
| Red_n := proc(S::{string, symbol }, G::{string, symbol, list({string, symbol })}, N::{posint, list(posint)}) local k h, , Λ, , ,z g n; if type(G, {'symbol', 'string'}) then g := G; n := `if`(type(N, 'posint'), N, N[1]) else h := S; for k to nops(G) do try n := N k[ ]; h := procname(h, G k[ ], n) catch "invalid subscript selector": h := procname(h, G k[ ], `if`(type(N, 'list'), ,2 N)) catch "invalid input: %1 expects": h := procname(h, G k[ ], `if`(type(N, 'list'), ,2 N)) end try end do; RETURN(h) end if; `if`(length(g) < 1, ERROR("length of <%1> should be more than 1", g), assign(z = convert([2], 'bytes'))); Λ := proc(S g n, , ) local a b h k p t, , , , , ; `if`(search(S, g), assign(t = cat(convert([1], 'bytes') $ (k = 1 .. n − 1))), RETURN(S, WARNING("substring <%1> does not exist in string <%2>", ,g S))) ; assign(h = "", a = cat "",( S t, ), b = cat "",( g $ (k = 1 .. n)), p = 0); do seq assign ' '( ( h = cat(h, `if`(a[k .. k + − n 1] = b, assign(' 'p = p + 1), a k[ ]))), k = 1 .. length(a) − + n 1); if p = 0 then break else p := ;0 a := cat(h t, ); h := "" end if end do; h end proc ; if length(g) = 1 then h := Λ(S g n g, , , ) else h := Subs_All(z = g, Λ(Subs_All(g = z S, , 2), ,z n g, ), 2) |
| end if; convert(h, whattype(S)) end proc > Red_n(`aaaaaaaa10aaaaaagnaaaa17aaaaaaaahhhaaaartaakr`, `a`, 6); aaaaa10aaaaagnaaaa17aaaaahhhaaaartaakr > Red_n("aaccccbbcccccccckcccckcccccccc", "cccc", 1); ⇒ "aabbkk" |
В частности, при N = {1|2} строка/символ G удаляется из строки/символа S или сохраняется с кратностью 1 соответственно. При этом, тип возвращаемого процедурой Red_n результата соответствует типу S-аргумента. Процедура Red_n производит регистро-зависимый поиск. Если G не входит в S, вызов процедуры Red_n(S, G, N) возвращает первый аргумент S без обработки с выводом соответствующего сообщения. Процедура обрабатывает основные особые и ошибочные ситуации.