module codad1; % Description of some procedures.
% ------------------------------------------------------------------- ;
% Copyright : J.A. van Hulzen, Twente University, Dept. of Computer ;
% Science, P.O.Box 217, 7500 AE Enschede, the Netherlands.;
% Authors : J.A. van Hulzen, B.J.A. Hulshof, W.N. Borst. ;
% ------------------------------------------------------------------- ;
symbolic$
% ------------------------------------------------------------------- ;
% The module CODAD1 contains the description of the procedures ;
% IMPROVELAYOUT (part 1), TCHSCHEME (part 2) and CODFAC (part 3), ;
% which are used in the procedure OPTIMIZELOOP (see the module CODCTL);
% to complete the effect of an application of EXTBRSEA (see the module;
% CODOPT). Application of each of these routines is completed by re- ;
% turning a Boolean value, which is used to decide if further optimi- ;
% zation is still profitable. ;
% The Smacro's Find!+Var and Find!*Var form service facilities, needed;
% at different places in this module. These Smacro's define an applic-;
% ation of the procedure GetCind. ;
% ------------------------------------------------------------------- ;
% ------------------------------------------------------------------- ;
% Global identifiers needed in this module are: ;
% ------------------------------------------------------------------- ;
global '(rowmin rowmax kvarlst codbexl!*);
% ------------------------------------------------------------------- ;
% The meaning of these globals is given in the module CODMAT. ;
% ------------------------------------------------------------------- ;
symbolic procedure getcind(var,varlst,op,fa,iv);
% ------------------------------------------------------------------- ;
% The purpose of the procedure GetCind is to create a column in CODMAT;
% which will be associated with the variable Var if this variable does;
% not yet belong to the set Varlst,i.e.does not yet play a role in the;
% corresponding PLUS- or TIMES setting (known by the value of Op).Once;
% the column exists (either created or already available), its Zstrt ;
% is modified by inserting the Z-element (Fa,IV) in it. Finally the ;
% corresponding Z-element for the father-row, i.e. (Y,IV) is returned.;
% ------------------------------------------------------------------- ;
begin scalar y,z;
if null(y:=get(var,varlst))
then
<<y:=rowmin:=rowmin-1;
put(var,varlst,y);
setrow(y,op,var,nil,nil)
>>;
setzstrt(y,inszzzn(z:=mkzel(fa,iv),zstrt y));
return mkzel(y,val z)
end;
symbolic smacro procedure find!+var(var,fa,iv);
getcind(var,'varlst!+,'plus,fa,iv);
symbolic smacro procedure find!*var(var,fa,iv);
getcind(var,'varlst!*,'times,fa,iv);
% ------------------------------------------------------------------- ;
% PART 1 : LAYOUT IMPROVEMENT ;
% ------------------------------------------------------------------- ;
symbolic procedure improvelayout;
% ------------------------------------------------------------------- ;
% During optimization, and thus during common subexpression generation;
% it might happen that a (sub)expression is reduced to a single varia-;
% ble, leading to output containing the assignment statements : ;
% b:=b-thing; ;
% ...... ;
% a:=b; ;
% This redundancy can be removed by replacing all occurrences of b by ;
% a, by replacing b:=b-thing by a:=b=thing and by removing a:=b. Here ;
% we assume a,b to be only cse-names. ;
% ------------------------------------------------------------------- ;
begin scalar var,b;
for x:=0:rowmax do
if not (numberp(var:=farvar x)
or
pairp(var)
or
(member(x,codbexl!*)
and
(get(var,'nex) or
not(flagp(var, 'newsym)) or
get(var,'alias)
% or not(get(var,'alias)) % JB 10/3/94
% finds no cse in p.e. cos(e^s6),sin(e^s6)
)))
and testononeel(var,x) then b:=t;
% ----------------------------------------------------------------- ;
% If B=T redundancy was removed from CODMAT, but not necessarily ;
% from Kvarlst, the list of pairs of kernels and names associated ;
% with them. ImproveKvarlst is applied to achieve this. ;
% ----------------------------------------------------------------- ;
if b then improvekvarlst();
return b
end;
symbolic procedure testononeel(var,x);
% ------------------------------------------------------------------- ;
% Row X,having Var as its assigned variable, and defining some expres-;
% sion, through its Zstrt, Chrow and ExpCof, is analysed. ;
% If this row defines a redundant assignment statement the above indi-;
% cated actions are performed. ;
% ------------------------------------------------------------------- ;
begin
scalar scol,srow,el,signiv,signec,zz,ordrx,negcof,trow,
oldvar,b,el1,scof,bop!+,lhs;
if (zz:=zstrt x) and null(cdr zz) and null(chrow x) and
!:onep(dm!-abs(signiv:=ival(el:=car zz))) and
!:onep(signec:=expcof(x))
% !:onep(dm!-abs(signec:=expcof(x)))
% This could mean a:=b^(-1), which is rather tricky to update
% when b is used in other plusrows. JB. 7-5-93.
then
<< % ------------------------------------------------------------- ;
% Row(X) defines a Zstreet, consisting of one Z-element. The ;
% variable-name, associated with this element is stored in the ;
% FarVar-field of the column, whose index is in the Yind-part of;
% this Z-element,i.e. Oldvar:=FarVar(SCol),the b mentioned above;
% The IVal-value of this element, an exponent or a coefficient, ;
% is 1 or -1 and the ExpCof-value, a coefficient or an exponent,;
% is also 1 or -1. Realistic possibilities are of course only ;
% 1*Oldvar^1 or -1*Oldvar^1 (i.e. 1*b^1 or -1*b^1). ;
% ------------------------------------------------------------- ;
scol:=yind el;
oldvar:=farvar(scol);
if srow:=get(oldvar,'rowindex)
then b:=t
else
if assoc(oldvar,kvarlst) and
!:onep(signiv) and !:onep(signec) and
not member(oldvar,codbexl!*)
then b:=t;
% ------------------------------------------------------------- ;
% So B=T if either Oldvar has its own defining row, whose index ;
% is stored as value of the indicator Rowindex, i.e. if Oldvar ;
% defines a cse, or if Oldvar is the name of a kernel, stored in;
% Kvarlst, as cdr-part of the pair having Oldvar as its car-part;
% ------------------------------------------------------------- ;
if b
then
<< % ------------------------------------------------------- ;
% We start replacing all occurrences of Oldvar by Var, in ;
% both the PLUS- and the TIMES-part of CODMAT, by applying;
% the function TShrinkCol. In addition all eventually exis;
% ting occurences of Oldvar in Kvarlst have to replaced as;
% well by Var(,the a mentioned above). ;
% ------------------------------------------------------- ;
setzstrt(scol,delyzz(x,zstrt scol));
tshrinkcol(oldvar,var,'varlst!+);
tshrinkcol(oldvar,var,'varlst!*);
if ((opval(x) eq 'plus) and !:onep(dm!-minus signiv))
or
((opval(x) eq 'times) and !:onep(dm!-minus signec))
then << var:=list('minus,var);
kvarlst:=subst(var,oldvar,kvarlst);
preprefixlist:=subst(var,oldvar,preprefixlist);
var:=cadr var;
negcof:=-1
>>
else << kvarlst:=subst(var,oldvar,kvarlst);
preprefixlist:=subst(var,oldvar,preprefixlist);
negcof:=1
>>;
if (lhs:=get(oldvar,'inlhs))
then
<< put(lhs,'nex,subst(var,oldvar,get(lhs,'nex)));
remprop(oldvar,'inlhs)>>;
if (lhs:=get(oldvar,'inalias))
then
<< updatealiases(oldvar,var);
%put(lhs,'alias,subst(var,oldvar,get(lhs,'alias)));
remprop(oldvar,'inalias)>>;
if srow
then
<< % --------------------------------------------------- ;
% Oldvar is the name of a cse, defined through the row;
% index Srow. So this cse-definition has to be assign-;
% ed to Var as new value and the Srow itself has to be;
% made redundant. The Ordr-field of Var has to be chan;
% ged to be able to remain guaranteeing a correct out-;
% put sequence. ;
% --------------------------------------------------- ;
ordrx:=ordr(x);
bop!+:=opval(srow) eq 'plus;
if bop!+ then scof:=expcof srow
else scof:=dm!-times(negcof,expcof(srow));
setrow(x,opval srow,var,list(chrow srow,scof),
zstrt srow);
setordr(x,append(ordr srow,remordr(srow,ordrx)));
if !:onep(dm!-minus signiv)
then
<<foreach z in zstrt(scol) do
setival(z,dm!-minus ival(z));
foreach ch in chrow(x) do
setexpcof(ch,dm!-minus expcof(ch));
if trow:=get(var,'varlst!*) then
foreach el in zstrt(trow) do
setexpcof(xind el, dm!-minus expcof(xind el));
>>;
foreach ch in chrow(srow) do setfarvar(ch,x);
clearrow(srow);
setordr(srow,nil);
codbexl!*:=subst(x,srow,codbexl!*);
foreach z in zstrt(x) do
<<if bop!+ then setival(z,dm!-times(signiv,ival(z)));
setzstrt(yind z,inszzz(mkzel(x,val z),
delyzz(srow,zstrt yind z)))
>>;
for sindex:=0:rowmax
do setordr(sindex,subst(x,srow,ordr sindex));
testononeel(var,x)
>>
else
<< % --------------------------------------------------- ;
% Oldvar is the system-generated name of a kernel. ;
% The internal administration is modified, as to pro- ;
% vide Var with its new role. ;
% As a side-effect the index X of the kernel defining ;
% row is replaced in CodBexl!* by the name Var, if oc-;
% curring of course, i.e. if this function definition ;
% was given at toplevel on input. ;
% This information is used in ImproveKvarlst. ;
% --------------------------------------------------- ;
codbexl!*:=subst(var,x,codbexl!*);
ordrx:=remordr(oldvar,ordr x);
clearrow(x);
setordr(x,nil);
for sindex:=0:rowmax do
setordr(sindex,
updordr(ordr sindex,var,oldvar,ordrx,x));
improvekvarlst()
>>;
>>
>>;
return b;
end$
symbolic procedure remordr(x,olst);
% ------------------------------------------------------------------- ;
% Olst is the value of the Ordr-field of a row of CODMAT. Olst defines;
% in which order the cse's, occurring in the (sub)expression, whose ;
% description starts in this row, have to be printed ahead of this ;
% (sub)expression. It is a list of kernelnames and/or indices of rows ;
% where cse-descriptions start. ;
% RemOrdr returns Olst after removal of X, if occcurring. ;
% ------------------------------------------------------------------- ;
if null(olst)
then olst
else
if car(olst)=x
then remordr(x,cdr olst)
else car(olst).remordr(x,cdr olst);
symbolic procedure updordr(olst,var,oldvar,ordrx,x);
% ------------------------------------------------------------------- ;
% Olst is described in RemOrdr. OrdrX is the Olst of row X after remo-;
% val Oldvar from it. Row X defines Var:=Oldvar. Oldvar, a kernelname,;
% is replaced by Var in Olst. If X is occurring in Olst OrdrX have to ;
% be inserted in Olst. The thus modified version of Olst is returned. ;
% ------------------------------------------------------------------- ;
if null(olst)
then olst
else
if car(olst) eq oldvar
then var.updordr(cdr olst,var,oldvar,ordrx,x)
else
if car(olst)=x
then append(var.ordrx,updordr(cdr olst,var,oldvar,ordrx,x))
else car(olst).updordr(cdr olst,var,oldvar,ordrx,x);
symbolic procedure improvekvarlst;
% ------------------------------------------------------------------- ;
% Kvarlst, a list of pairs (name . function definition) is improved,if;
% necessary. This is only required if in the list CodBexl!* occuring ;
% names are not yet used in Kvarlst. Hence adequate rewriting of ;
% b:=sin(x) ;
% ........ ;
% a:=b ;
% into ;
% a:=sin(x) is needed,i.e. replacement of (b . sin(x)) by (a . sin(x));
% in Kvarlst. ;
% ------------------------------------------------------------------- ;
begin scalar invkvl,newkvl,x,y,kv,lkvl,cd,cd1;
newkvl:=kvarlst;
repeat
<<lkvl:=kvarlst:=newkvl;
invkvl:=newkvl:=nil;
while lkvl do
<<kv:=car(lkvl);
lkvl:=cdr(lkvl);
cd1:=member(car kv,codbexl!*);
x:=assoc(cdr kv,invkvl);
if x
then cd:=(cd1 and member(cdr x,codbexl!*));
if x and not cd
then
<<kv:=car(kv);
x:=cdr(x);
if cd1
then <<y:=x;
x:=kv;
kv:=y>>;
tshrinkcol(kv,x,'varlst!+);
tshrinkcol(kv,x,'varlst!*);
for rindx:=0:rowmax do
setordr(rindx,subst(x,kv,ordr rindx));
newkvl:=subst(x,kv,newkvl);
invkvl:=subst(x,kv,invkvl);
lkvl:=subst(x,kv,lkvl)
>>
else
<<invkvl:=(cdr(kv).car(kv)).invkvl;
newkvl:=kv.newkvl
>>
>>
>>
until length(kvarlst)=length(newkvl);
end;
symbolic procedure tshrinkcol(oldvar,var,varlst);
% ------------------------------------------------------------------- ;
% All occurrences of Oldvar have to be replaced by Var. This is done ;
% by replacing the PLUS and TIMES column-indices of Oldvar by the cor-;
% responding indices of Var. Y1 and Y2 get the value of the Oldvar- ;
% index and the Var-index, respectively. As a side-effect, all additi-;
% onal information, stored in the property-list of Oldvar is removed. ;
% ------------------------------------------------------------------- ;
begin scalar y1,y2;
if get(oldvar,'inalias)
then updatealiases(oldvar, var);
if y1:=get(oldvar,varlst)
then
<<if y2:=get(var,varlst)
then
<<foreach z in zstrt(y1) do
<<setzstrt(y2,inszzzn(z,zstrt y2));
setzstrt(xind z,inszzzr(mkzel(y2,val z),
delyzz(y1,zstrt xind z)))
>>;
clearrow(y1)
>>
else
<<setfarvar(y1,var);
put(var,varlst,y1)
>>;
remprop(oldvar,varlst)
>>;
remprop(oldvar,'npcdvar);
remprop(oldvar,'nvarlst);
end;
symbolic procedure updatealiases(old, new);
% ----------------------------------------------------------------- ;
% Variable old is going to be replaced by new.
% We hav eto ensure that the alias-linking remains
% consistent. This means that the following has to
% be updated:
% Occurrence-info of index-alias:
% new.inalias <- old.inalias
% The aliased vars have to be informed that the alias
% is performed by a new variable:
% alias <- new|old
% original.finalalias <- new|old
% where A|B means : replace B by A.
% ----------------------------------------------------------------- ;
begin scalar original;
put(new,'inalias,get(old,'inalias));
flag(list new,'aliasnewsym);
foreach el in get(old,'inalias) do
<<put(el,'alias,subst(new,old,(original:=get(el,'alias))));
if atom original
then put(original,'finalalias,
subst(new, old, get(original,'finalalias)))
else put(car original,'finalalias,
subst(new,old,get(car original,'finalalias)))
>>;
end$
% ------------------------------------------------------------------- ;
% PART 2 : INFORMATION MIGRATION ;
% ------------------------------------------------------------------- ;
symbolic procedure tchscheme;
% ------------------------------------------------------------------- ;
% A product(sum) -reduced to a single element- can eventually be remo-;
% ved from the TIMES(PLUS)-part of CODMAT. If certain conditions are ;
% fulfilled (defined by the function TransferRow) it is transferred to;
% the Zstreet of its father PLUS(TIMES)-row and its index is removed ;
% from the ChRow of its father. ;
% T is returned if atleast one such a migration event takes place. ;
% NIL is returned otherwise. ;
% ------------------------------------------------------------------- ;
begin scalar zz,b;
for x:=0:rowmax do
if not(farvar(x)=-1)
and (zz:=zstrt x) and null(cdr zz) and transferrow(x,ival car zz)
then <<chscheme(x,car zz); b:=t>>;
return b;
end;
symbolic procedure chscheme(x,z);
% ------------------------------------------------------------------- ;
% The Z-element Z, the only element the Zstreet of row(X) has, has to ;
% be transferred from the PLUS(TIMES)-part to the TIMES(PLUS)-part of ;
% CODMAT. ;
% ------------------------------------------------------------------- ;
begin scalar fa,opv,cof,exp;
setzstrt(yind z,delyzz(x,zstrt yind z));
setzstrt(x,nil);
if opval(x) eq 'plus
then <<exp:=1; cof:=ival z>>
else <<exp:=ival z; cof:=1>>;
l1: fa:=farvar(x);
opv:=opval(x);
if opv eq 'plus
then
<<cof:=dm!-expt(cof,expcof(x));
exp:=dm!-times(expcof(x),exp);
chdel(fa,x);
clearrow(x);
if null(zstrt fa) and transferrow(fa,exp)
then <<x:=fa; goto l1>>
>>
else
<< if opv eq 'times
then
<<cof:=dm!-times(cof,expcof(x));
chdel(fa,x);
clearrow(x);
if null(zstrt fa) and transferrow(fa,cof)
then <<x:=fa; goto l1>>
>>
>>;
updfa(fa,exp,cof,z)
end;
symbolic procedure updfa(fa,exp,cof,z);
% ------------------------------------------------------------------- ;
% FA is the index of the father-row of the Z-element Z,which has to ;
% be incorporated in the Zstreet of this row. Its exponent is Exp and ;
% its coefficient is Cof, both computed in its calling function ;
% ChScheme. ;
% ------------------------------------------------------------------- ;
if opval(fa) eq 'plus
then setzstrt(fa,inszzzr(find!+var(farvar yind z,fa,cof),zstrt fa))
else
<<setzstrt(fa,inszzzr(find!*var(farvar yind z,fa,exp),zstrt fa));
setexpcof(fa,dm!-times(cof,expcof(fa)))
>>;
symbolic procedure transferrow(x,iv);
% ------------------------------------------------------------------- ;
% IV is the Ivalue of the Z-element, oreming the Zstreet of row X. ;
% This element can possibly be transferred. ;
% T is returned if this element can be transferred. NIL is returned ;
% otherwise. ;
% ------------------------------------------------------------------- ;
if opval(x) eq 'plus
then transferrow1(x) and opval(farvar x) eq 'times
else transferrow1(x) and transferrow2(x,iv);
symbolic procedure transferrow1(x);
% ------------------------------------------------------------------- ;
% T is returned if row(X) defines a primitive expression (no children);
% which is part of a larger expression, i.e. row(X) defines a child- ;
% expression. ;
% ------------------------------------------------------------------- ;
null(chrow x) and numberp(farvar x);
symbolic procedure transferrow2(x,iv);
% ------------------------------------------------------------------- ;
% Row(X) defines a product of the form ExpCof(X)*(a variable) ^ IV, ;
% which is part of a sum. ;
% X is temporarily removed from the list of its fathers children when ;
% computing B, the return-value. ;
% B=T if the father-row defines a sum and if either the exponent IV=1 ;
% or if the father-Zstreet is empty (no primitive terms) and the fa- ;
% ther itself can be transferred, i.e. if ExpCof(X)*(a variable) ^ (IV;
% *ExpCof(Fa)) can be incorporated in the Zstreet of the grandfather- ;
% row (,which again defines a product). ;
% ------------------------------------------------------------------- ;
begin scalar fa,b;
fa:=farvar(x);
chdel(fa,x);
b:=opval(fa) eq 'plus and (iv=1 or (null(zstrt fa) and
transferrow(fa,iv*expcof(fa))));
setchrow(fa,x.chrow(fa));
return b;
end;
% ------------------------------------------------------------------- ;
% PART 3 : APPLICATION OF THE DISTRIBUTIVE LAW. ;
% ------------------------------------------------------------------- ;
% An expression of the form a*b + a*c + d is distributed over 3 rows ;
% of CODMAT : One to store the sum structure, i.e. to store the pp of ;
% the sum, being d, in a Zstrt and 2 others to store the composite ;
% terms a*b and a*c as monomials. The indices of the latter rows are ;
% also stored in the list Chrow, associated with the sum-row. ;
% In addition 4 columns are introduced. One to store the 2 occurrences;
% of a and 3 others to store the information about b,c and d. The a,b ;
% and c column belong to the set of TIMES-columns, i.e. a,b and c are ;
% elements of the list Varlst!* (see the module CODMAT). Similarly the;
% d belongs to Varlst!+. If this sum is remodelled to obtain a*(b + c);
% + d changes have to be made in the CODMAT-structure: ;
% Now 2 sum-rows are needed and only 1 product-row. Hence the Chrow- ;
% information of the original sum-row has to be changed and the 2 pro-;
% duct-rows have to be removed and replaced by one new row, defining ;
% the Zstrt for a and the Chrow to find the description of b + c back.;
% In addition the column-information for all 4 columns has to be reset;
% This is a simple example. In general more complicated situations can;
% be expected. An expression like a*b + a*sin(c) + d requires 4 rows, ;
% for instance . A CODFAC-application always follows a ExtBrsea-execu-;
% tion. This implies that potential common factors, defined through *-;
% col's always have an exponent-value = 1. A common factor like a^3 is;
% always replaced by a cse (via an appl. of Expand- and Shrinkprod), ;
% before the procedure CODFAC is applied. Hence atmost 1 exponent in a;
% column is not equal 1. ;
% ------------------------------------------------------------------- ;
symbolic procedure codfac;
% ------------------------------------------------------------------- ;
% An application of the procedure CodFac results in an exhaustive all-;
% level application of the distributive law on the present structure ;
% of the set of input-expressions, as reflected by the present version;
% of CODMAT. ;
% If any application of the distributive law proves to be possible the;
% value T is returned.This is an indication for the calling routine ;
% OptimizeLoop that an additional application of ExtBrsea might be ;
% profitable. ;
% If such an application is not possible the value Nil is returned. ;
% ------------------------------------------------------------------- ;
begin scalar b,lxx;
for y:=rowmin:(-1) do
% ---------------------------------------------------------------- ;
% The Zstrts of all *-columns, which are usable (because their Far-;
% Var-field contains a Var-name), are examined by applying the pro-;
% cedure SameFar. If this application leads to a non empty list LXX;
% with information, needed to be able to apply the distributive law;
% the local variable B is set T, possibly the value to be returned.;
% B gets the initial value Nil, by declaration. ;
% ---------------------------------------------------------------- ;
if not (farvar(y)=-1 or farvar(y)=-2) and
opval(y) eq 'times and (lxx:=samefar y)
then
<<b:=t;
foreach el in lxx do commonfac(y,el)
>>;
return b
end;
symbolic procedure samefar(y);
% ------------------------------------------------------------------- ;
% Y is the index of a TIMES-column. The procedure SameFar is designed ;
% to allow to find and return a list Flst consisting of pairs, formed ;
% by a father-index and a sub-Zstrt of the Zstrt(Y), consisting of Z's;
% such that Farvar(Xind Z) = Car Flst, i.e. the Xind(Z)-rows define ;
% (composite) productterms of the same sum, which contain the variable;
% corresponding with column Y as factor in their primitive part. ;
% ------------------------------------------------------------------- ;
begin scalar flst,s,far;
foreach z in zstrt(y) do
if numberp(far:=farvar xind z) and opval(far) eq 'plus
then
if s:=assoc(far,flst)
then rplacd(s,inszzz(z,cdr(s)))
else flst:=(far.inszzz(z,s)).flst;
return
foreach el in flst conc
if cddr(el)
then list(el)
else nil
end;
symbolic procedure commonfac(y,xx);
% ------------------------------------------------------------------- ;
% Y is the index of a TIMES-column and XX an element of LXX, made with;
% SameFar(Y), i.e. a pair consisting of the index Far of a father-sum ;
% row and a sub-Zstrt,consisting of Z-elements, defining factors in ;
% productterms of this father-sum. ;
% These factors are defined by Z-elements (Y.exponent). Atmost one of ;
% these exponents is greater than 1. ;
% The purpose of CommonFac is to factor out this element,i.e. to remo-;
% ve a Z-element (Y.1) from the Zstrts of the children and also its ;
% corresponding occurrences from ZZ3 = Zstrt(Y), to combine the remai-;
% ning sum-information in a new PLUS-row, with index Nsum, and to cre-;
% ate a TIMES-row, with index Nprod, defining the product of the sum, ;
% given by the row Nsum, and the variable corresponding with column Y.;
% ZZ2 and CH2 are used to (re)structure information, by allowing to ;
% combine the remaining portions of the child-rows.The father (with ;
% index Far) is defined by a Zstrt (its primitive part) and by CH1 = ;
% Chrow (its composite part). ZZ4 and CH4 are used to identify the ;
% Zstrts of the children after removal of a (Y.1)-element and the ;
% Chrow's,respectively.If exponent>1 in (Y.exponent) the Zstrt has to ;
% be modified to obtain ZZ4, instead of a simple removal of (Y.1) from;
% from Zstrt X. ;
% Alternatives for the structure of the such a child-row are : ;
% -1- A combination of a non-empty Zstrt and a non-empty list Chrow ;
% of children. ;
% -2- An empty Zstrt, but a non-empty Chrow. ;
% -3- A non-empty Zstrt, but an empty Chrow. ;
% Special attention is required when in case -3- the Zstrt consists of;
% only 1 Z-element besides the element shared with column Y. ;
% In case -2- similar care have to be taken when Chrow consists of 1 ;
% row index only. ;
% Remark : Since the overall intention is optimization, i.e. reduction;
% of the arithmetic complexity of a set of expressions, viewed as ru- ;
% les to perform arithmetic operations, expression parts like a*b + a ;
% are not changed into a*(b + 1). Hence a forth alternative, being an ;
% empty Zstrt and an empty Chrow is irrelevant. ;
% ------------------------------------------------------------------- ;
begin scalar far,ch1,ch2,ch4,chindex,zel,zeli,zz2,zz3,zz4,
nsum,nprod,opv,y1,cof,x,ivalx;
far:=car(xx);
ch1:=chrow(far);
zz3:=zstrt(y);
nprod:=rowmax+1;
nsum:=rowmax:=rowmax+2;
% ----------------------------------------------------------------- ;
% After some initial settings all children,accessible via the Z-el.s;
% collected in Cdr(XX) are examined using a FOREACH_loop. ;
% ----------------------------------------------------------------- ;
foreach item in cdr(xx) do
<<x:=xind item;
if (ivalx:=ival item)=1
then zz4:=delyzz(y,zstrt x)
else zz4:=inszzzr(zeli:=mkzel(y,ivalx-1),delyzz(y,zstrt x));
ch4:=chrow(x);
cof:=expcof(x);
% --------------------------------------------------------------- ;
% (Y.1) is removed from the child's Zstrt, defining a monomial, ;
% without the coefficient, stored in Cof. ;
% --------------------------------------------------------------- ;
if null(zz4) and (null(cdr ch4) and car(ch4))
then
<<% ------------------------------------------------------------- ;
% This is the special case of possibility -2-. ZZ4 is empty and ;
% CH4 contains only 1 index. ;
% ------------------------------------------------------------- ;
if (opv:=opval(ch4:=car ch4)) eq 'plus and expcof(ch4)=1
then
<<% ----------------------------------------------------------- ;
% The child with row-index CH4 has the form (..+..+..)^1 = ..+;
% ..+.. . Its definition has to be moved to the row Nsum. ;
% The different terms can be either primitive or composite and;
% have all to be multiplied by Cof. Both Zstrt(CH4) - the pri-;
% mitives - and Chrow(CH4) - the composites - have to be exa- ;
% mined. ;
% ----------------------------------------------------------- ;
foreach z in zstrt(ch4) do
<<% --------------------------------------------------------- ;
% A new Zstrt ZZ2 is made with the primitive elements of the;
% the different Zstrt(CH4)'s. InsZZZr guarantees summation ;
% of the Ival's if the Xind's are equal (see module CODMAT).;
% ZZ2 is build using the FOREACH X loop. The Zstrt's of the ;
% columns, which share an element with ZZ2,are also updated:;
% The CH4-indexed elements are removed and the Nsum-indexed ;
% elements are inserted. ;
% --------------------------------------------------------- ;
zel:=mkzel(xind z,dm!-times(ival(z),cof));
zz2:=inszzzr(zel,zz2);
setzstrt(yind z,inszzz(mkzel(nsum,ival zel),
delyzz(ch4,zstrt yind z)))
>>;
foreach ch in chrow(ch4) do
<<% --------------------------------------------------------- ;
% The row CH defines a child directly if Cof = 1. In all ;
% other cases a multiplication with Cof has to be performed.;
% Either by changing the ExpCof field if the child is a pro-;
% duct or by introducing a new TIMES-row. ;
% --------------------------------------------------------- ;
chindex:=ch;
if not(!:onep cof)
then
if opval(ch) eq 'times
then
<< setexpcof(ch,dm!-times(cof,expcof(ch)));
setfarvar(ch,nsum)
>>
else
<< chindex:=rowmax:=rowmax+1;
setrow(chindex,'times,nsum,(ch).cof,nil)
>>
else setfarvar(ch,nsum);
ch2:=chindex.ch2
>>;
% ----------------------------------------------------------- ;
% The row CH4 is not longer needed in CODMAT, because its ;
% content is distributed over other rows. ;
% ----------------------------------------------------------- ;
clearrow(ch4);
>>
else
<<% ----------------------------------------------------------- ;
% This is still the special case -2-. (CH4) contains 1 child ;
% index. The leading operator of this child is not PLUS. So ;
% CH4 is simply added to the list of children indices CH2 and ;
% the father index of row CH4 is changed into Nsum. ;
% ----------------------------------------------------------- ;
setfarvar(ch4,nsum);
ch2:=ch4.ch2
>>;
% ------------------------------------------------------------- ;
% The row X is not longer needed in CODMAT, because its content ;
% is distributed over other rows. ;
% ------------------------------------------------------------- ;
clearrow(x)
>>
else
if null(ch4) and (null(cdr zz4) and car(zz4))
then
<<% ----------------------------------------------------------- ;
% This is the special case of possibility -3-: A Zstrt ZZ4 ;
% consisting of only one Z-element. ;
% This Z-element defines just a variable if IVal(Car ZZ4) =1. ;
% It is a power of a variable in case IVal-value > 1 holds. ;
% In the latter situation Nsum ought to become the new father ;
% index of the row with index Xind Car ZZ4.In the former case ;
% the single variable is added to the Zstrt ZZ2, before row X ;
% can be cleared. ;
% ----------------------------------------------------------- ;
if not(!:onep ival(car(zz4)))
then
<< setfarvar(x,nsum);
setzstrt(x,zz4);
ch2:=x.ch2
>>
else
<< zz2:=inszzzr(find!+var(farvar(y1:=yind car zz4),nsum,
cof),zz2);
setzstrt(y1,delyzz(x,zstrt y1));
clearrow(x)
>>
>>
else
<<% ----------------------------------------------------------- ;
% Now the general form of one of the 3 alternatives holds. ;
% Row index X is added to the list of children indices CH2 ;
% and the new father index for row X becomes Nsum. The Zstrt ;
% of X is also reset. It becomes ZZ4, i.e. the previous Zstrt ;
% after removal of (Y.1). ;
% ----------------------------------------------------------- ;
ch2:=x.ch2;
setfarvar(x,nsum);
setzstrt(x,zz4)
>>;
% --------------------------------------------------------------- ;
% The previous "life" of X is skipped by removing its impact from ;
% the "history book" CODMAT. ;
% --------------------------------------------------------------- ;
ch1:=delete(x,ch1);
zz3:=delyzz(x,zz3);
if ivalx>2 then zz3:=inszzz(mkzel(x,val(zeli)),zz3)
>>;
% ----------------------------------------------------------------- ;
% Some final bookkeeping is needed : ;
% -1- (Y.1) was deleted from the ZZ4's. Its new role, factor in the ;
% product,defined via the row Nprod, has still to be establish- ;
% ed by inserting this information in Y's Zstrt. ;
% ----------------------------------------------------------------- ;
setzstrt(y,(zel:=mkzel(nprod,1)).zz3);
% ----------------------------------------------------------------- ;
% -2- The list of indices of children of the row with index Far ;
% ought to be extended with Nprod. ;
% ----------------------------------------------------------------- ;
setchrow(far,nprod.ch1);
% ----------------------------------------------------------------- ;
% -3- Finally the new rows Nprod and Nsum have to be filled. How- ;
% ever the :=: assignment-option might cause - otherwise non- ;
% existing - problems, because simplification is skipped before ;
% parsing input and storing the relevant information in CODMAT. ;
% An input expression of the form x*(a + t) + x*(a - t) can thus be ;
% transformed - by an application of CODFAC - into the form ;
% x*(2*a + 0). Its Zstrt can contain an element (index . 0), like ;
% the Zstrt associated with t. The latter is due to the coefficient ;
% addition, implied by insert-operations, like InsZZZ or InsZZZr. ;
% Hence a test is made to discover if a Z-element Zel exists, such ;
% that IVal(Zel)=0. If so, its occurrence is removed from both ZZ2 ;
% and the Zstrt of the t-column. ;
% If now Null(CH2) and Null(Cdr ZZ2) holds the PLUS-row Nsum is ;
% superfluous. Only 2*a*x has to be stored in Nprod. The row Nsum ;
% is removed when it is easily detectable, because this index is ;
% not used anymore and anywhere, when the above limitations are ;
% valid. ;
% ----------------------------------------------------------------- ;
foreach z in zz2 do if zeropp(ival(z))
then << zz2:=delyzz(y1:=xind z,zz2);
setzstrt(y1,delyzz(nsum,zstrt y1))
>>;
% ----------------------------------------------------------------- ;
% Expressions like x(a-w)+x(a+w) lead to printable, but not yet to ;
% completely satisfactory prefixlist-representations. This problem ;
% is solved in the module CODPRI in the function ConstrExp. ;
% ----------------------------------------------------------------- ;
setrow(nprod,'times,far,list list nsum,list mkzel(y,val zel));
setrow(nsum,'plus,nprod,list ch2,zz2)
end;
endmodule;
end;