)
文章目录
- ✅ 核心思想
- 📌 示例：注册名字 → 对象映射
- 🧪 使用示例
- 🔍 说明与扩展建议
- ✅ 总结
在 Fortran（特别是 Fortran 2003 及以后支持面向对象特性的版本）中，虽然没有像 C++ 或 Python 那样原生的“注册模式”（Registry Pattern）语法糖，但可以借助派生类型（derived types）、指针（pointers）或可分配变量（allocatable components）来实现类似功能：将一个对象“注册”到另一个对象中，并支持查询和变更。
Design patterns
https://github.com/farhanjk/FortranPatterns
下面是一个典型的实现思路和示例代码：
✅ 核心思想
- 使用一个容器类型（如
Registry）来保存一组被注册的对象（通过指针或 allocatable 组件）。 - 提供
register、lookup、update等过程（即方法）。 - 利用 Fortran 的类型绑定过程（type-bound procedures）实现面向对象风格。
📌 示例：注册名字 → 对象映射
module registry_mod implicit none private public :: Item, Registry type :: Item integer :: value = 0 contains procedure :: set_value procedure :: get_value end type Item type :: Registry private type(Item), pointer :: items(:) => null() character(len=:), allocatable :: keys(:) integer :: n = 0 integer, parameter :: initial_capacity = 10 contains procedure :: register_item procedure :: lookup_item procedure :: update_item final :: finalize_registry end type Registry contains subroutine set_value(this, val) class(Item), intent(inout) :: this integer, intent(in) :: val this%value = val end subroutine set_value function get_value(this) result(val) class(Item), intent(in) :: this integer :: val val = this%value end function get_value subroutine register_item(this, key, item) class(Registry), intent(inout) :: this character(len=*), intent(in) :: key type(Item), intent(in) :: item integer :: i ! 检查是否已存在 do i = 1, this%n if (this%keys(i) == key) then error stop 'Key already exists: ' // trim(key) end if end do ! 扩容 if (.not. associated(this%items)) then allocate(this%items(this%initial_capacity)) allocate(this%keys(this%initial_capacity), source='') else if (this%n >= size(this%items)) then call resize(this) end if this%n = this%n + 1 this%keys(this%n) = key this%items(this%n) = item end subroutine register_item function lookup_item(this, key) result(item_ptr) class(Registry), intent(in) :: this character(len=*), intent(in) :: key type(Item), pointer :: item_ptr integer :: i item_ptr => null() do i = 1, this%n if (this%keys(i) == key) then item_ptr => this%items(i) return end if end do end function lookup_item subroutine update_item(this, key, new_item) class(Registry), intent(inout) :: this character(len=*), intent(in) :: key type(Item), intent(in) :: new_item integer :: i do i = 1, this%n if (this%keys(i) == key) then this%items(i) = new_item return end if end do error stop 'Key not found for update: ' // trim(key) end subroutine update_item subroutine resize(this) class(Registry), intent(inout) :: this type(Item), allocatable :: temp_items(:) character(len=:), allocatable :: temp_keys(:) integer :: old_size, new_size old_size = size(this%items) new_size = old_size * 2 allocate(temp_items(new_size)) temp_items(1:old_size) = this%items deallocate(this%items) this%items => temp_items allocate(temp_keys(new_size), source='') temp_keys(1:old_size) = this%keys deallocate(this%keys) this%keys = temp_keys end subroutine resize subroutine finalize_registry(this) type(Registry), intent(inout) :: this if (associated(this%items)) deallocate(this%items) if (allocated(this%keys)) deallocate(this%keys) end subroutine finalize_registry end module registry_mod🧪 使用示例
program test_registry use registry_mod implicit none type(Registry) :: reg type(Item), pointer :: p => null() type(Item) :: tmp ! 注册 call tmp%set_value(42) call reg%register_item('answer', tmp) ! 查询 p => reg%lookup_item('answer') if (associated(p)) then print *, 'Found value:', p%get_value() end if ! 更新 call tmp%set_value(100) call reg%update_item('answer', tmp) p => reg%lookup_item('answer') if (associated(p)) then print *, 'Updated value:', p%get_value() end if end program test_registry🔍 说明与扩展建议
- 键值对：当前使用
character作为 key，也可替换为整数 ID 或其他类型。 - 指针 vs allocatable：这里
items用指针数组便于返回引用；若只存副本，可用allocatable。 - 线程安全：Fortran 本身不提供线程安全机制，如需多线程需加锁（例如通过 OpenMP critical）。
- 泛型支持：Fortran 不支持模板，若需注册不同类型，可考虑：
- 使用
class(*)+select type（但复杂） - 为每种类型写专用 Registry
- 或使用预处理器（如 fypp）生成代码
- 使用
✅ 总结
Fortran 2003+ 完全可以实现注册模式，核心是：
- 用派生类型封装注册表
- 用指针/数组存储对象
- 提供注册、查找、更新接口
- 利用 finalizer 自动清理资源
