First draft of run-time polymorphism proposal

proposals/run-time_polymorphism/Examples/AppendixA/taylor.f90

@@ -0,0 +1,127 @@
+! Fortran implementation of the Taylor series example program based on
+! subclassing given in Appendix A of the proposal "Improved run-time
+! polymorphism for Fortran".
+!
+
+module derivs
+
+   type, abstract :: Deriv
+   contains
+      procedure(pderiv), deferred, nopass ::  deriv1
+   end type Deriv
+
+   abstract interface
+      subroutine pderiv()
+      end subroutine pderiv      
+   end interface
+
+   type, extends(Deriv) :: DerivF
+   contains
+      procedure, nopass :: deriv1 => deriv1f
+   end type DerivF
+
+   type, extends(DerivF) :: HDerivF
+   contains
+      procedure, nopass :: deriv2 => deriv2f
+   end type HDerivF
+
+   type, extends(Deriv) :: DerivG
+   contains
+      procedure, nopass :: deriv1 => deriv1g
+   end type DerivG
+
+   type, extends(DerivG) :: HDerivG
+   contains
+      procedure, nopass :: deriv2 => deriv2g
+   end type HDerivG
+
+contains
+
+   subroutine deriv1f()
+      write(*,*) ' 1st derivative of function F!'
+   end subroutine deriv1f
+
+   subroutine deriv2f()
+      write(*,*) ' 2nd derivative of function F!'
+   end subroutine deriv2f
+
+   subroutine deriv1g()
+      write(*,*) ' 1st derivative of function G!'
+   end subroutine deriv1g
+
+   subroutine deriv2g()
+      write(*,*) ' 2nd derivative of function G!'
+   end subroutine deriv2g
+
+end module derivs
+
+module series
+
+   use derivs, only: Deriv, HDerivF, HDerivG
+
+   type :: Taylor
+      class(Deriv), allocatable :: calc
+   contains
+      procedure :: term1
+      procedure :: evaluate
+   end type Taylor
+
+   type, extends(Taylor) :: HTaylor
+   contains
+      procedure :: term2    => hterm2
+      procedure :: evaluate => hevaluate
+   end type HTaylor
+
+contains
+
+   subroutine term1(self)
+      class(Taylor), intent(in) :: self
+      call self%calc%deriv1()
+   end subroutine term1
+
+   subroutine evaluate(self)
+      class(Taylor), intent(in) :: self
+      write(*,*) 'Evaluating Taylor series using'
+      call self%term1()
+   end subroutine evaluate
+
+   subroutine hterm2(self)
+      class(HTaylor), intent(in) :: self
+      select type ( calc => self%calc )
+      class is ( HDerivF )
+         call calc%deriv2()
+      class is ( HDerivG )
+         call calc%deriv2()
+      class default
+         write(*,*) 'Unknown type!'
+      end select
+   end subroutine hterm2
+
+   subroutine hevaluate(self)
+      class(HTaylor), intent(in) :: self
+      write(*,*) 'Evaluating Taylor series using'
+      call self%term1()
+      call self%term2()
+   end subroutine hevaluate
+
+end module series
+
+program client
+
+   use derivs, only: DerivG, HDerivG, Deriv
+   use series, only: Taylor, HTaylor
+
+   class(Deriv),  allocatable :: derv
+   class(Taylor), allocatable :: teval
+
+   derv  = DerivG()
+   teval = Taylor(derv)   
+   call teval%evaluate()   
+
+   write(*,*)
+
+   derv  = HDerivG()
+   teval = HTaylor(derv)
+   call teval%evaluate()   
+
+end program client

proposals/run-time_polymorphism/Examples/AppendixB/taylor.f90

@@ -0,0 +1,133 @@
+! Fortran implementation of the Taylor series example program based on
+! subtyping given in Appendix B of the proposal "Improved run-time
+! polymorphism for Fortran".
+!
+
+module interfaces
+
+   abstract interface :: IDeriv
+      subroutine deriv1()
+      end subroutine deriv1
+   end interface IDeriv
+
+   abstract interface, extends(IDeriv) :: IHDeriv
+      subroutine deriv2()
+      end subroutine deriv2
+   end interface IHDeriv
+
+end module interfaces
+
+module derivs
+
+   use interfaces, only: IDeriv, IHDeriv
+
+   type, implements(IDeriv) :: DerivF
+   contains
+      procedure, nopass :: deriv1 => deriv1f
+   end type DerivF
+
+   type, implements(IHDeriv) :: HDerivF
+   contains
+      procedure, nopass :: deriv1 => deriv1f
+      procedure, nopass :: deriv2 => deriv2f
+   end type HDerivF
+
+   type, implements(IDeriv) :: DerivG
+   contains
+      procedure, nopass :: deriv1 => deriv1g
+   end type DerivG
+
+   type, implements(IHDeriv) :: HDerivG
+   contains
+      procedure, nopass :: deriv1 => deriv1g
+      procedure, nopass :: deriv2 => deriv2g
+   end type HDerivG
+
+contains
+
+   subroutine deriv1f()
+      write(*,*) " 1st derivative of function F!"
+   end subroutine deriv1f
+
+   subroutine deriv2f()
+      write(*,*) " 2nd derivative of function F!"
+   end subroutine deriv2f
+
+   subroutine deriv1g()
+      write(*,*) " 1st derivative of function G!"
+   end subroutine deriv1g
+
+   subroutine deriv2g()
+      write(*,*) " 2nd derivative of function G!"
+   end subroutine deriv2g
+
+end module derivs
+
+module series
+
+   use interfaces, only: IDeriv, IHDeriv
+
+   type :: Taylor
+      class(IDeriv), allocatable :: calc
+   contains
+      procedure :: term1
+      procedure :: evaluate
+   end type Taylor
+
+   type :: HTaylor
+      class(IHDeriv), allocatable :: calc
+   contains
+      procedure :: term1    => hterm1
+      procedure :: term2    => hterm2
+      procedure :: evaluate => hevaluate
+   end type HTaylor
+
+contains
+
+    subroutine term1(self)
+       class(Taylor), intent(in) :: self
+       call self%calc%deriv1()
+    end subroutine term1
+
+    subroutine evaluate(self)
+       class(Taylor), intent(in) :: self
+       write(*,*) 'Evaluating Taylor series using'
+       call self%term1()
+    end subroutine evaluate
+
+    subroutine hterm1(self)
+       class(HTaylor), intent(in) :: self
+       call self%calc%deriv1()
+    end subroutine hterm1
+
+    subroutine hterm2(self)
+       class(HTaylor), intent(in) :: self
+       call self%calc%deriv2()
+    end subroutine hterm2
+
+    subroutine hevaluate(self)
+       class(HTaylor), intent(in) :: self
+       write(*,*) 'Evaluating Taylor series using'
+       call self%term1()
+       call self%term2()
+    end subroutine hevaluate
+
+end module series
+
+program client
+
+   use derivs, only: DerivG, HDerivG
+   use series, only: Taylor, HTaylor
+
+   type(Taylor),  allocatable :: teval
+   type(HTaylor), allocatable :: hteval
+
+   teval = Taylor( DerivG() )
+   call teval%evaluate()
+
+   write(*,*)
+
+   hteval = HTaylor( HDerivG() )
+   call hteval%evaluate()
+
+end program client

proposals/run-time_polymorphism/Examples/AppendixB/taylor.java

@@ -0,0 +1,88 @@
+// Java implementation of the Taylor series example program based on
+// subtyping given in Appendix B of the proposal "Improved run-time
+// polymorphism for Fortran".
+//
+
+interface IDeriv {
+    void deriv1();
+}
+
+interface IHDeriv extends IDeriv {
+    void deriv2();
+}
+
+class DerivF implements IDeriv {
+    public void deriv1() {
+      	System.out.println(" 1st derivative of function F!");
+    }
+}
+
+class HDerivF implements IHDeriv {
+    public void deriv1() {
+      	System.out.println(" 1st derivative of function F!");
+    }
+    public void deriv2() {
+	System.out.println(" 2nd derivative of function F!");
+    }
+}
+
+class DerivG implements IDeriv {
+    public void deriv1() {
+      	System.out.println(" 1st derivative of function G!");
+    }
+}
+
+class HDerivG implements IHDeriv {
+    public void deriv1() {
+      	System.out.println(" 1st derivative of function G!");
+    }
+    public void deriv2() {
+	System.out.println(" 2nd derivative of function G!");
+    }
+}
+
+class Taylor {
+    IDeriv calc;
+    Taylor(IDeriv calculator) {
+	calc = calculator;
+    }    
+    public void term1() {
+	calc.deriv1();
+    }
+    public void evaluate() {
+	System.out.println("Evaluating Taylor series using");
+	term1();
+    }
+}
+
+class HTaylor {
+    IHDeriv calc;
+    HTaylor(IHDeriv calculator) {
+	calc = calculator;
+    }
+    public void term1() {
+	calc.deriv1();
+    }
+    public void term2() {
+	calc.deriv2();
+    }
+    public void evaluate() {
+	System.out.println("Evaluating Taylor series using");
+	term1();
+	term2();
+    }
+}
+
+class ClientApp {
+
+    public static void main(String[] args) {
+
+	Taylor eval = new Taylor( new DerivG() );
+	eval.evaluate();
+
+	System.out.println("");
+
+	HTaylor heval = new HTaylor( new HDerivG() );
+	heval.evaluate();
+    }
+}