Artifact 3cc80a4b2a373a7dd876193290d623c908c0eb4471c382bb1e2c54215f9a0ef5:
- Executable file
r37/packages/scope/codad1.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 40129) [annotate] [blame] [check-ins using] [more...]
- Executable file
r38/packages/scope/codad1.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 40129) [annotate] [blame] [check-ins using]
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;