Interactive Code Generation

Contents of file graeffe.red:

OPERATOR A$                                               
Q := FOR I := 0 STEP 2 UNTIL n   SUM (A(I+1)*X^(n-I))$
R := FOR I := 1 STEP 2 UNTIL n-1 SUM (A(I+1)*X^(n-I))$    
P := Q^2 - R^2$                                           
LET X^2 = Y$                                              
B := COEFF(P,Y)$                                             
END$

Now a numerical subprogram can be generated with assignment statements for the coefficients of (now stored in list B in REDUCE). Since these coefficients are given in terms of the coefficients of (i.e., operator A in REDUCE), the subprogram will need two parameters: A and B, each of which must be arrays of size n+1.

The following REDUCE session will create subroutine GRAEFF for a polynomial of degree n=10 and write it to file graeffe.f:

1: n := 10$ 

2: IN "graeffe.red"$

3: GENTRANLANG!* := 'FORTRAN$ 

4: ON DOUBLE$

5: GENTRAN 
5: ( 
5:      PROCEDURE GRAEFF(A,B); 
5:      BEGIN 
5:      DECLARE 
5:      << 
5:          GRAEFF : SUBROUTINE; 
5:          A(11),B(11) : REAL
5:      >>; 
5:      LITERAL 
5:       "C",CR!*, 
5:       "C",TAB!*,"GRAEFFE ROOT-SQUARING METHOD TO FIND",CR!*,
5:       "C",TAB!*,"ROOTS OF A POLYNOMIAL",CR!*, 
5:       "C",CR!*; 
5:      B(1) :=: PART (B,1);
5:      B(2) :=: PART (B,2);
5:      B(3) :=: PART (B,3);
5:      B(4) :=: PART (B,4);
5:      B(5) :=: PART (B,5);
5:      B(6) :=: PART (B,6);
5:      B(7) :=: PART (B,7);
5:      B(8) :=: PART (B,8);
5:      B(9) :=: PART (B,9);
5:      B(10) :=: PART (B,10);
5:      B(11) :=: PART (B,11)
5:      END 
5: ) 
5: OUT "graeffe.f"$

Contents of file graeffe.f:

      SUBROUTINE GRAEFF(A,B)
      DOUBLE PRECISION A(11),B(11)
C
C     GRAEFFE ROOT-SQUARING METHOD TO FIND
C     ROOTS OF A POLYNOMIAL
C
      B(1)=A(11)**2
      B(2)=2.0D0*A(11)*A(9)-A(10)**2
      B(3)=2.0D0*A(11)*A(7)-(2.0D0*A(10)*A(8))+A(9)**2
      B(4)=2.0D0*A(11)*A(5)-(2.0D0*A(10)*A(6))+2.0D0*A(9)*A(7
     . )-A(8)**2
      B(5)=2.0D0*A(11)*A(3)-(2.0D0*A(10)*A(4))+2.0D0*A(9)*A(5
     . )-(2.0D0*A(8)*A(6))+A(7)**2
      B(6)=2.0D0*A(11)*A(1)-(2.0D0*A(10)*A(2))+2.0D0*A(9)*A(3
     . )-(2.0D0*A(8)*A(4))+2.0D0*A(7)*A(5)-A(6)**2
      B(7)=2.0D0*A(9)*A(1)-(2.0D0*A(8)*A(2))+2.0D0*A(7)*A(3)-
     . (2.0D0*A(6)*A(4))+A(5)**2
      B(8)=2.0D0*A(7)*A(1)-(2.0D0*A(6)*A(2))+2.0D0*A(5)*A(3)-
     . A(4)**2
      B(9)=2.0D0*A(5)*A(1)-(2.0D0*A(4)*A(2))+A(3)**2
      B(10)=2.0D0*A(3)*A(1)-A(2)**2
      B(11)=A(1)**2
      RETURN
      END