        /** Subexpression optimization **/

/*K: Code generation; program transformation; efficiency */
/*A: Michael P. Shatz */
/*S: California Institute of Technology */
/*D: 1984 */
/*U: J. Greif Nov 1984 */
 
/*: Subparts[$x]
        produces a list of all subparts of $x that are neither symbols
        or numbers */
 
Subparts[$x]::(Map[Ap[$x,$1],Pos[$y_=(~Symbp[$y]&~Numbp[$y]),$x]];%%/Map[Nc,%%])
/* 
old form
Subparts[$x]::Del[$2_=(Symbp[$2]|Numbp[$2]),Flat[Ar[Dep[$x],Dis[$x,$1]]],2]
*/
 
/*: union[$list]
        deletes duplicate entries in a list $list
        leaving them in the order of first occurence */
 
        union[$list]::(Lcl[%u,%e,%l];%l:$list;%u:{};\
                Loop[,%e:%l[1];%u:Cat[%u,{%e}];%l:Del[%e,%l,2],Len[%l]>0];%u)
 
/*: repeats[$x]
        arranges repeated non-atomic (not symbols or numbers) subparts of
        $x in a list such that any part comes after its subparts */
 
        repeats[$x]::union[Rev[(Lcl[%sub];%sub:Subparts[$x];\
                Del[$1_=(Len[Pos[$1,%sub,,2]]=1),%sub,2])]]
 
/*W: Next lines remove Gen property of $ and redefine Smp property of Make */
 
_$[Gen]:0
_Make[Smp]:{0,Inf}
 
/*: Optim[$x]
        constructs an SMP function $xopt for the expression $x optimizing
        its use of common subexpressions for purposes of subsequent code
        generation. $x should be a symbol whose value is the expression to
        be optimized */
 
_Optim[Smp]:0
 
        Optim[$x]::(Lcl[%ln,%ap,%set,%vars,%rep,%name,%reps,%r,%i,%exp];\
                %set[$j,$y]::(Set[$j,$y]);%ap[$j,$k]::Ap[$j,$k];\
                %r:repeats[$x];%ln:Len[%r];%vars:Ar[%ln,Make[%t,$1]];\
                %reps:{};%exp:$x;\
                For[%i:1,%i<=%ln,Inc[%i],\
                /*-: build an inverted  replacement for each subexpression */\
                %rep:%vars[%i]->%r[%i];%reps:Cat[%reps,{%rep}];\
                /*-: replace subexpression in list thereof and orig. expr */\
                %r:S[%r,Irep[%rep]];\
                %exp:Si[%exp,Irep[%rep]]];\
                /*-: name for constructed function */\
                %name:Make[$x,opt];\
                /*-: Tier the constructed function */\
                Ap[Prset,{%name,Tier}];\
                /*-: list of local variables and assignments for them */\
                %reps:Cat[{Ap[Lcl,%vars]},S[%reps,Rep[$$x]->'Set[$$x]],{%exp}];\
                /*-: convert list to Proc */\
                %reps:S[%reps,List[$$x]->'Proc[$$x]];\
                /*-: convert each symbol in expr to dummy */\
                %rep:Map[$1->Make[$,$1],Rel[Cont[$x]]];\
                /*-: define the optimized function */\
                %set[%ap[%name,S[Rel[Cont[$x]],%rep]],S[%reps,%rep]];)
 
/*B:  Optimizes all subexpressions, including those with function calls that
may produce side effects. */
 
/*F:  Should provide controls to prevent certain optimizations, such as
those with side effects.  Should provide capabilities for optimizing several
expressions with common subexpressions. */ 
 
/*E:
SMP 1.4.11   (Mar 26 1985)
 
Dsp["/u/smp/ALL/IMPLEM/changes"] for news (as of Sep 21 09:57 )
 
#I[1]::  <XOpt
 
#I[2]::  a:b+c+Sin[g (b+c)]^(f+Sin[g])+Log[b+c]+Sin[g]Log[b+c]
 
                                                                f + Sin[g]
#O[2]:   b + c + Log[b + c] + Log[b + c] Sin[g] + Sin[g (b + c)]
 
#I[3]::  Optim[a]
 
#I[4]::  aopt
 
#O[4]:   {[[$b,$c,$f,$g]]: ' Lcl[%t1,%t2,%t3] ; %t1 : $b + $c ; %t2 : Sin[$g] ;
 
                          %t3 : Log[%t1] ;
 
                                                           $f + %t2
                          %t1 + %t3 + %t2 %t3 + Sin[$g %t1]        }
 
#I[5]::  Prog[aopt,] /* C-code version */
 
#define E (2.71828182845904530e+00)
double aopt() ;
double sin() ;
double log() ;
double pow() ;
 
/*
    aopt[$b,$c,$f,$g] : (' Lcl[%t1,%t2,%t3] ; %t1 : $b + $c ; %t2 : \
            Sin[$g] ; %t3 : Log[%t1] ; %t1 + %t3 + %t2*%t3 + Sin[$g*%t1]\
                 ^($f + %t2))
*/
double aopt(d_b,d_c,d_f,d_g)
double d_b ;
double d_c ;
double d_f ;
double d_g ;
{
        double t_1 ;
        double t_2 ;
        double t_3 ;
 
        t_1 = d_b + d_c ;
        t_2 = sin(d_g) ;
        t_3 = log(t_1) / log(E) ;
        return(t_1 + t_3 + t_2 * t_3 + pow(sin(d_g * t_1),d_f + t_2)) ;
}
 
 
 
#O[5]:   {' aopt}
 
#I[6]::    Prog[aopt,,,2]  /* Fortran version */
 
*
*     aopt[$b,$c,$f,$g] : (' Lcl[%t1,%t2,%t3] ; %t1 : $b + $c ; %t2 : Sin[$g]\
*                   ; %t3 : Log[%t1] ; %t1 + %t3 + %t2*%t3 + Sin[$g*%t1]\
*                      ^($f + %t2))
*
      DOUBLE PRECISION FUNCTION AOPT(QDB,QDC,QDF,QDG)
      DOUBLE PRECISION QDB
      DOUBLE PRECISION QDC
      DOUBLE PRECISION QDF
      DOUBLE PRECISION QDG
 
      COMMON/MBLCK0/E
      DOUBLE PRECISION E
      DOUBLE PRECISION T1
      DOUBLE PRECISION T2
      DOUBLE PRECISION T3
 
      T1 = QDB + QDC
      T2 = DSIN(QDG)
      T3 = DLOG(T1) / DLOG(E)
      AOPT = T1 + T3 + T2 * T3 + DSIN(QDG * T1) ** (QDF + T2)
      RETURN
      END
 
 
 
 
 
      BLOCK DATA
      COMMON/MBLCK0/E
      DOUBLE PRECISION E
      DATA E/2.71828182845904530D+00/
      END
 
#O[6]:   {' aopt}
 
*/
 
