Line data Source code
1 : !> Visitor pattern for HSD tree traversal
2 : !>
3 : !> This module provides an abstract visitor type that can be extended
4 : !> to implement custom tree traversal logic without needing to manually
5 : !> iterate over nodes.
6 : !>
7 : !> Example usage:
8 : !> ```fortran
9 : !> type, extends(hsd_visitor) :: my_printer
10 : !> contains
11 : !> procedure :: visit_table => print_table
12 : !> procedure :: visit_value => print_value
13 : !> end type
14 : !>
15 : !> subroutine print_table(self, table, path, depth, stat)
16 : !> class(my_printer), intent(inout) :: self
17 : !> type(hsd_table), intent(in) :: table
18 : !> character(len=*), intent(in) :: path
19 : !> integer, intent(in) :: depth
20 : !> integer, intent(out), optional :: stat
21 : !> print *, "Table: ", path
22 : !> if (present(stat)) stat = 0
23 : !> end subroutine
24 : !> ```
25 : module hsd_visitor
26 : use hsd_types, only: hsd_node, hsd_table, hsd_value
27 : implicit none (type, external)
28 : private
29 :
30 : public :: hsd_visitor_t, hsd_accept
31 :
32 : !> Abstract visitor type for tree traversal
33 : !>
34 : !> Extend this type and implement visit_table and visit_value
35 : !> to define custom behavior when visiting each node type.
36 : type, abstract :: hsd_visitor_t
37 : contains
38 : !> Called when visiting a table node
39 : procedure(visit_table_if), deferred :: visit_table
40 : !> Called when visiting a value node
41 : procedure(visit_value_if), deferred :: visit_value
42 : end type hsd_visitor_t
43 :
44 : abstract interface
45 : !> Visit a table node
46 : !>
47 : !> @param self The visitor instance
48 : !> @param table The table being visited
49 : !> @param path The path to this table from root (e.g., "parent/child")
50 : !> @param depth The depth in the tree (0 = root)
51 : !> @param stat Optional status (non-zero to stop traversal)
52 : subroutine visit_table_if(self, table, path, depth, stat)
53 : import :: hsd_visitor_t, hsd_table
54 : implicit none (type, external)
55 : class(hsd_visitor_t), intent(inout) :: self
56 : type(hsd_table), intent(in), target :: table
57 : character(len=*), intent(in) :: path
58 : integer, intent(in) :: depth
59 : integer, intent(out), optional :: stat
60 : end subroutine visit_table_if
61 :
62 : !> Visit a value node
63 : !>
64 : !> @param self The visitor instance
65 : !> @param val The value being visited
66 : !> @param path The path to this value from root
67 : !> @param depth The depth in the tree
68 : !> @param stat Optional status (non-zero to stop traversal)
69 : subroutine visit_value_if(self, val, path, depth, stat)
70 : import :: hsd_visitor_t, hsd_value
71 : implicit none (type, external)
72 : class(hsd_visitor_t), intent(inout) :: self
73 : type(hsd_value), intent(in) :: val
74 : character(len=*), intent(in) :: path
75 : integer, intent(in) :: depth
76 : integer, intent(out), optional :: stat
77 : end subroutine visit_value_if
78 : end interface
79 :
80 : contains
81 :
82 : !> Accept a visitor and traverse the tree
83 : !>
84 : !> Performs a depth-first traversal of the tree, calling the visitor's
85 : !> visit_table and visit_value methods for each node.
86 : !>
87 : !> @param root The root table to start traversal from
88 : !> @param visitor The visitor instance to call
89 : !> @param stat Optional status (non-zero if traversal stopped early)
90 11 : recursive subroutine hsd_accept(root, visitor, stat)
91 : type(hsd_table), intent(in), target :: root
92 : class(hsd_visitor_t), intent(inout) :: visitor
93 : integer, intent(out), optional :: stat
94 :
95 11 : call accept_table(root, visitor, "", 0, stat)
96 :
97 11 : end subroutine hsd_accept
98 :
99 : !> Internal recursive helper for table traversal
100 27 : recursive subroutine accept_table(table, visitor, path, depth, stat)
101 : type(hsd_table), intent(in), target :: table
102 : class(hsd_visitor_t), intent(inout) :: visitor
103 : character(len=*), intent(in) :: path
104 : integer, intent(in) :: depth
105 : integer, intent(out), optional :: stat
106 :
107 : class(hsd_node), pointer :: child
108 27 : character(len=:), allocatable :: child_path
109 27 : integer :: i, local_stat
110 :
111 : ! Initialize local_stat to success
112 27 : local_stat = 0
113 :
114 : ! Visit this table first
115 27 : call visitor%visit_table(table, path, depth, local_stat)
116 27 : if (local_stat /= 0) then
117 1 : if (present(stat)) stat = local_stat
118 1 : return
119 : end if
120 :
121 : ! Then visit all children
122 54 : do i = 1, table%num_children
123 32 : call table%get_child(i, child)
124 32 : if (.not. associated(child)) cycle
125 :
126 : ! Build child path
127 32 : if (len_trim(path) == 0) then
128 18 : if (allocated(child%name)) then
129 16 : child_path = child%name
130 : else
131 2 : child_path = ""
132 : end if
133 : else
134 14 : if (allocated(child%name)) then
135 14 : child_path = path // "/" // child%name
136 : else
137 0 : child_path = path
138 : end if
139 : end if
140 :
141 22 : select type (child)
142 : type is (hsd_table)
143 16 : call accept_table(child, visitor, child_path, depth + 1, local_stat)
144 32 : if (local_stat /= 0) then
145 2 : if (present(stat)) stat = local_stat
146 4 : return
147 : end if
148 : type is (hsd_value)
149 16 : call visitor%visit_value(child, child_path, depth + 1, local_stat)
150 32 : if (local_stat /= 0) then
151 2 : if (present(stat)) stat = local_stat
152 2 : return
153 : end if
154 : end select
155 : end do
156 :
157 22 : if (present(stat)) stat = 0
158 :
159 54 : end subroutine accept_table
160 :
161 32 : end module hsd_visitor
|
