Skip to content

fix: polish: refactor functions exceeding 50-line soft limit in codeg (fixes #1948) #1949

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Oct 26, 2025
Merged

fix: polish: refactor functions exceeding 50-line soft limit in codeg (fixes #1948) #1949

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
114 changes: 75 additions & 39 deletions src/codegen/codegen_character_normalization.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,16 +11,81 @@ module codegen_character_normalization

contains

pure subroutine try_extract_length_from_star(trimmed_str, open_paren, has_length, &
length_spec)
character(len=*), intent(in) :: trimmed_str
integer, intent(in) :: open_paren
logical, intent(inout) :: has_length
character(len=:), allocatable, intent(inout) :: length_spec
integer :: star_pos
integer :: trimmed_len
character(len=:), allocatable :: candidate

if (has_length) return

star_pos = index(trimmed_str, "*")
if (star_pos <= 0) return
if (open_paren /= 0) then
if (star_pos > open_paren) return
end if

trimmed_len = len_trim(trimmed_str)
if (star_pos >= trimmed_len) return

candidate = trim(trimmed_str(star_pos + 1:trimmed_len))
if (len_trim(candidate) == 0) return

length_spec = candidate
has_length = .true.
end subroutine try_extract_length_from_star

pure subroutine try_extract_length_from_parentheses(trimmed_str, open_paren, &
has_length, length_spec)
character(len=*), intent(in) :: trimmed_str
integer, intent(in) :: open_paren
logical, intent(inout) :: has_length
character(len=:), allocatable, intent(inout) :: length_spec
integer :: close_paren
integer :: depth
integer :: last_char
integer :: idx
character(len=:), allocatable :: candidate

if (has_length) return
if (open_paren <= 0) return

depth = 0
close_paren = 0
last_char = len_trim(trimmed_str)

do idx = open_paren + 1, last_char
select case (trimmed_str(idx:idx))
case ("(")
depth = depth + 1
case (")")
if (depth == 0) then
close_paren = idx
exit
else
depth = depth - 1
end if
end select
end do

if (close_paren <= open_paren + 1) return

candidate = trim(trimmed_str(open_paren + 1:close_paren - 1))
if (len_trim(candidate) == 0) return

length_spec = candidate
has_length = .true.
end subroutine try_extract_length_from_parentheses

subroutine extract_character_length(type_str, has_length, length_spec)
character(len=*), intent(in) :: type_str
logical, intent(out) :: has_length
character(len=:), allocatable, intent(out) :: length_spec
integer :: star_pos
integer :: open_paren
integer :: close_paren
integer :: depth
integer :: i
integer :: last_char
character(len=:), allocatable :: trimmed_str

has_length = .false.
Expand All @@ -29,41 +94,12 @@ subroutine extract_character_length(type_str, has_length, length_spec)
trimmed_str = trim(type_str)
open_paren = index(trimmed_str, "(")

star_pos = index(trimmed_str, "*")
if (star_pos > 0) then
if (open_paren == 0 .or. star_pos < open_paren) then
if (star_pos < len_trim(trimmed_str)) then
length_spec = trim(trimmed_str(star_pos + 1:))
if (len_trim(length_spec) > 0) then
has_length = .true.
return
end if
end if
end if
end if
call try_extract_length_from_star(trimmed_str, open_paren, has_length, &
length_spec)
if (has_length) return

if (open_paren > 0) then
depth = 0
close_paren = 0
last_char = len_trim(trimmed_str)
do i = open_paren + 1, last_char
select case (trimmed_str(i:i))
case ("(")
depth = depth + 1
case (")")
if (depth == 0) then
close_paren = i
exit
else
depth = depth - 1
end if
end select
end do
if (close_paren > open_paren + 1) then
length_spec = trim(trimmed_str(open_paren + 1:close_paren - 1))
if (len_trim(length_spec) > 0) has_length = .true.
end if
end if
call try_extract_length_from_parentheses(trimmed_str, open_paren, &
has_length, length_spec)
end subroutine extract_character_length

subroutine preprocess_character_type(raw_type, trimmed, has_length, length_spec, &
Expand Down
192 changes: 130 additions & 62 deletions src/codegen/codegen_declaration_grouping.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,58 +18,119 @@ module codegen_declaration_grouping

contains

function can_group_declarations(node1, node2) result(can_group)
pure logical function declarations_share_basic_flags(node1, node2) result(match)
type(declaration_node), intent(in) :: node1
type(declaration_node), intent(in) :: node2
logical :: can_group
logical :: types_match

if (node1%initializer_index > 0 .or. node2%initializer_index > 0) then
can_group = .false.
if (node1%initializer_index > 0) then
match = .false.
return
end if
if (node2%initializer_index > 0) then
match = .false.
return
end if

if (node1%is_array .or. node2%is_array) then
can_group = .false.
match = .false.
return
end if

if (node1%is_allocatable .neqv. node2%is_allocatable) then
can_group = .false.
match = .false.
return
end if
if (node1%is_pointer .neqv. node2%is_pointer) then
can_group = .false.
match = .false.
return
end if
if (node1%is_target .neqv. node2%is_target) then
can_group = .false.
match = .false.
return
end if
if (node1%is_external .neqv. node2%is_external) then
can_group = .false.
match = .false.
return
end if
if (node1%is_parameter .neqv. node2%is_parameter) then
can_group = .false.
match = .false.
return
end if

match = .true.
end function declarations_share_basic_flags

pure logical function declarations_have_matching_types(node1, node2) result(match)
type(declaration_node), intent(in) :: node1
type(declaration_node), intent(in) :: node2
logical :: both_have_names

both_have_names = len_trim(node1%type_name) > 0 .and. &
len_trim(node2%type_name) > 0
if (both_have_names) then
match = trim(node1%type_name) == trim(node2%type_name)
return
end if

if (len_trim(node1%type_name) > 0 .and. len_trim(node2%type_name) > 0) then
types_match = trim(node1%type_name) == trim(node2%type_name)
else if (node1%inferred_type%kind > 0 .and. node2%inferred_type%kind > 0) then
types_match = node1%inferred_type%kind == node2%inferred_type%kind
if (node1%inferred_type%kind > 0 .and. node2%inferred_type%kind > 0) then
match = node1%inferred_type%kind == node2%inferred_type%kind
else
types_match = .false.
match = .false.
end if
end function declarations_have_matching_types

pure logical function declarations_match_attributes(node1, node2) result(match)
type(declaration_node), intent(in) :: node1
type(declaration_node), intent(in) :: node2
logical :: intents_match

if (node1%kind_value /= node2%kind_value) then
match = .false.
return
end if
if (node1%has_kind .neqv. node2%has_kind) then
match = .false.
return
end if

can_group = types_match .and. &
(node1%kind_value == node2%kind_value) .and. &
(node1%has_kind .eqv. node2%has_kind) .and. &
((node1%has_intent .and. node2%has_intent .and. &
trim(node1%intent) == trim(node2%intent)) .or. &
(.not. node1%has_intent .and. .not. node2%has_intent)) .and. &
(node1%is_optional .eqv. node2%is_optional)
if (node1%has_intent .and. node2%has_intent) then
intents_match = trim(node1%intent) == trim(node2%intent)
else
intents_match = (.not. node1%has_intent) .and. (.not. node2%has_intent)
end if
if (.not. intents_match) then
match = .false.
return
end if

if (node1%is_optional .neqv. node2%is_optional) then
match = .false.
return
end if
if (node1%is_target .neqv. node2%is_target) then
match = .false.
return
end if

match = .true.
end function declarations_match_attributes

function can_group_declarations(node1, node2) result(can_group)
type(declaration_node), intent(in) :: node1
type(declaration_node), intent(in) :: node2
logical :: can_group
logical :: types_match

if (.not. declarations_share_basic_flags(node1, node2)) then
can_group = .false.
return
end if

types_match = declarations_have_matching_types(node1, node2)
if (.not. types_match) then
can_group = .false.
return
end if

can_group = declarations_match_attributes(node1, node2)
end function can_group_declarations

function can_group_parameters(node1, node2) result(can_group)
Expand All @@ -87,61 +148,68 @@ function can_group_parameters(node1, node2) result(can_group)
(node1%is_target .eqv. node2%is_target)
end function can_group_parameters

subroutine resolve_parameter_metadata(node, param_map, intent_text, &
optional_flag, &
target_flag)
type(declaration_node), intent(in) :: node
type(parameter_info_t), intent(in) :: param_map(:)
character(len=:), allocatable, intent(out) :: intent_text
logical, intent(out) :: optional_flag
logical, intent(out) :: target_flag
integer :: idx

idx = find_parameter_info(param_map, node%var_name)
if (idx > 0) then
intent_text = param_map(idx)%intent_str
optional_flag = param_map(idx)%is_optional
target_flag = param_map(idx)%is_target
return
end if

if (node%has_intent) then
intent_text = node%intent
else
intent_text = ""
end if
optional_flag = node%is_optional
target_flag = node%is_target
end subroutine resolve_parameter_metadata

function can_group_declarations_with_params(node1, node2, param_map) &
result(can_group)
type(declaration_node), intent(in) :: node1
type(declaration_node), intent(in) :: node2
type(parameter_info_t), intent(in) :: param_map(:)
logical :: can_group
integer :: idx1
integer :: idx2
character(len=:), allocatable :: intent1
character(len=:), allocatable :: intent2
logical :: optional1
logical :: optional2
logical :: target1
logical :: target2

if (node1%initializer_index > 0 .or. node2%initializer_index > 0) then
if (.not. declarations_share_basic_flags(node1, node2)) then
can_group = .false.
return
end if

if (trim(node1%type_name) /= trim(node2%type_name)) then
can_group = .false.
return
end if
if (node1%kind_value /= node2%kind_value) then
can_group = .false.
return
end if
if (node1%has_kind .neqv. node2%has_kind) then
can_group = .false.
return
end if

idx1 = find_parameter_info(param_map, node1%var_name)
idx2 = find_parameter_info(param_map, node2%var_name)
call resolve_parameter_metadata(node1, param_map, intent1, optional1, target1)
call resolve_parameter_metadata(node2, param_map, intent2, optional2, target2)

if (idx1 > 0) then
intent1 = param_map(idx1)%intent_str
optional1 = param_map(idx1)%is_optional
target1 = param_map(idx1)%is_target
else
if (node1%has_intent) then
intent1 = node1%intent
else
intent1 = ""
end if
optional1 = node1%is_optional
target1 = node1%is_target
end if

if (idx2 > 0) then
intent2 = param_map(idx2)%intent_str
optional2 = param_map(idx2)%is_optional
target2 = param_map(idx2)%is_target
else
if (node2%has_intent) then
intent2 = node2%intent
else
intent2 = ""
end if
optional2 = node2%is_optional
target2 = node2%is_target
end if

can_group = trim(node1%type_name) == trim(node2%type_name) .and. &
node1%kind_value == node2%kind_value .and. &
node1%has_kind .eqv. node2%has_kind .and. &
trim(intent1) == trim(intent2) .and. &
can_group = trim(intent1) == trim(intent2) .and. &
optional1 .eqv. optional2 .and. &
target1 .eqv. target2
end function can_group_declarations_with_params
Expand Down
Loading