This world is not a tree, just like a net.
So, tree need inherit(extends), but net need trait.
I like trait of Rust.
Deepseek tell me how to simulate the trait of Rust.
! 文件名: area_mod.f90 (类似 trait 定义)
module area_mod
implicit none
private
! 1. 定义“基础类型”，它包含一个过程指针 - 类似要实现 trait 的类型需要提供的方法
type, public :: area_t
private
procedure(area_interface), pointer, nopass :: area_calc => null()
! nopass 表示不自动传递对象自身作为参数，我们会在调用时显式传递
contains
procedure :: set_area_procedure ! “实现” trait 的方法
procedure :: calculate_area ! 调用 trait 方法的统一接口
end type area_t
! 2. 定义抽象接口 (Abstract Interface) - 类似 trait 中的方法签名
abstract interface
real function area_interface(cls)
import :: area_t
class(area_t), intent(in) :: cls
end function area_interface
end interface
contains
! 让派生类型“实现”行为的方法
subroutine set_area_procedure(self, proc_ptr)
class(area_t), intent(inout) :: self
procedure(area_interface) :: proc_ptr
self%area_calc => proc_ptr
end subroutine set_area_procedure
! 统一的外部调用接口 (类似通过 trait 对象调用方法)
real function calculate_area(self)
class(area_t), intent(in) :: self
if (associated(self%area_calc)) then
calculate_area = self%area_calc(self) ! 调用绑定的具体实现
else
calculate_area = 0.0
print *, "Warning: set area procedure failed"
end if
end function calculate_area
end module area_mod
! 文件名: circle_mod.f90 (一个具体实现)
module circle_mod
use area_mod, only: area_t
implicit none
private
type, public, extends(area_t) :: circle_t
private
real :: radius
contains
procedure :: init => init_circle
! 注意：这里不直接绑定 area_calc，我们将在 init 里做
end type circle_t
contains
subroutine init_circle(self, radius)
class(circle_t), intent(inout) :: self
real, intent(in) :: radius
self%radius = radius
! 关键步骤：将类型特定的函数绑定到基础类型的过程指针上
call self%set_area_procedure(area_of_circle)
end subroutine init_circle
! 具体的实现函数，签名必须匹配 area_interface
real function area_of_circle(cls)
class(area_t), intent(in) :: cls
select type (cls)
type is (circle_t)
area_of_circle = 3.1415926 * cls%radius**2
class default
area_of_circle = 0.0
print *, "Error: args of area_of_circle is not circle_t"
end select
end function area_of_circle
end module circle_mod
! 文件名: rectangle_mod.f90 (一个具体实现)
module rectangle_mod
use area_mod, only: area_t
implicit none
private
type, public, extends(area_t) :: rectangle_t
private
real :: length, width
contains
procedure :: init => init_rectangle
! 注意：这里不直接绑定 area_calc，我们将在 init 里做
end type rectangle_t
contains
subroutine init_rectangle(self, length, width)
class(rectangle_t), intent(inout) :: self
real, intent(in) :: length, width
self%length = length; self%width = width
! 关键步骤：将类型特定的函数绑定到基础类型的过程指针上
call self%set_area_procedure(area_of_rectangle)
end subroutine init_rectangle
! 具体的实现函数，签名必须匹配 area_interface
real function area_of_rectangle(cls)
class(area_t), intent(in) :: cls
select type (cls)
type is (rectangle_t)
area_of_rectangle = cls%length * cls%width
class default
area_of_rectangle = 0.0
print *, "Error: args of area_of_rectangle is not rectangle_t"
end select
end function area_of_rectangle
end module rectangle_mod
! 文件名: main.f90
program main
use area_mod, only: area_t
use circle_mod, only: circle_t
use rectangle_mod, only: rectangle_t
implicit none
class(area_t), allocatable :: shape ! 可以指向任何“实现了该 trait”的类型
! 演示动态分配 (类似 Box<dyn Trait>)
allocate(circle_t :: shape) ! 用 circle_t 初始化
select type (shape)
type is (circle_t)
call shape%init(1.0)
end select
print *, "Circle area: ", shape%calculate_area()
deallocate(shape)
! 演示动态分配 (类似 Box<dyn Trait>)
allocate(rectangle_t :: shape) ! 用 rectangle_t 初始化
select type (shape)
type is (rectangle_t)
call shape%init(2.0, 3.0)
end select
print *, "Rectangle area: ", shape%calculate_area()
deallocate(shape)
end program main