Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
101 changes: 94 additions & 7 deletions src/analysis/call_graph_signatures_mod.f90
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,8 @@ module call_graph_signatures_mod

type :: type_signature_t
integer, allocatable :: param_kinds(:)
character(len=:), allocatable :: param_type_strings(:)
character(len=:), allocatable :: return_type_string
integer :: return_kind = 0
integer :: call_site_node = 0
integer :: line = 0
Expand Down Expand Up @@ -48,34 +50,70 @@ function signature_exists(signatures, new_sig) result(exists)
type(type_signature_t), intent(in) :: new_sig
logical :: exists
integer :: i, j
integer :: n_params
logical :: param_types_match
logical :: return_type_match

exists = .false.
do i = 1, size(signatures)
if (.not. allocated(signatures(i)%param_kinds)) cycle
if (.not. allocated(new_sig%param_kinds)) cycle
if (size(signatures(i)%param_kinds) /= size(new_sig%param_kinds)) cycle
n_params = size(signatures(i)%param_kinds)
if (n_params /= size(new_sig%param_kinds)) cycle

if (.not. all(signatures(i)%param_kinds == new_sig%param_kinds)) cycle
if (signatures(i)%return_kind /= new_sig%return_kind) cycle

param_types_match = .true.
if (allocated(signatures(i)%param_type_strings) .or. &
allocated(new_sig%param_type_strings)) then
if (.not. allocated(signatures(i)%param_type_strings)) cycle
if (.not. allocated(new_sig%param_type_strings)) cycle
if (size(signatures(i)%param_type_strings) /= &
size(new_sig%param_type_strings)) cycle
do j = 1, size(signatures(i)%param_type_strings)
if (trim(signatures(i)%param_type_strings(j)) /= &
trim(new_sig%param_type_strings(j))) then
param_types_match = .false.
exit
end if
end do
end if
if (.not. param_types_match) cycle

return_type_match = .true.
if (allocated(signatures(i)%return_type_string) .or. &
allocated(new_sig%return_type_string)) then
if (.not. allocated(signatures(i)%return_type_string)) cycle
if (.not. allocated(new_sig%return_type_string)) cycle
if (trim(signatures(i)%return_type_string) /= &
trim(new_sig%return_type_string)) cycle
end if

if (all(signatures(i)%param_kinds == new_sig%param_kinds) .and. &
signatures(i)%return_kind == new_sig%return_kind) then
if (return_type_match) then
exists = .true.
return
end if
end do
end function signature_exists

subroutine add_signature(map, proc_name, param_kinds, return_kind, &
call_site_node, line, column)
call_site_node, line, column, param_type_strings, &
return_type_string)
type(signatures_map_t), intent(inout) :: map
character(len=*), intent(in) :: proc_name
integer, intent(in) :: param_kinds(:)
integer, intent(in) :: return_kind
integer, intent(in) :: call_site_node
integer, intent(in) :: line, column
character(len=*), intent(in), optional :: param_type_strings(:)
character(len=*), intent(in), optional :: return_type_string

type(type_signature_t) :: new_sig
type(procedure_signatures_t), allocatable :: temp_procs(:)
type(type_signature_t), allocatable :: temp_sigs(:)
integer :: proc_idx, i
integer :: max_len

allocate (new_sig%param_kinds(size(param_kinds)))
new_sig%param_kinds = param_kinds
Expand All @@ -84,6 +122,27 @@ subroutine add_signature(map, proc_name, param_kinds, return_kind, &
new_sig%line = line
new_sig%column = column

if (present(param_type_strings)) then
max_len = 0
do i = 1, size(param_type_strings)
max_len = max(max_len, len_trim(param_type_strings(i)))
end do
if (max_len < 1) max_len = 1
allocate (character(len=max_len) :: new_sig%param_type_strings( &
size(param_type_strings)))
do i = 1, size(param_type_strings)
new_sig%param_type_strings(i) = trim(param_type_strings(i))
end do
end if

if (present(return_type_string)) then
if (len_trim(return_type_string) > 0) then
allocate (character(len=len_trim(return_type_string)) :: &
new_sig%return_type_string)
new_sig%return_type_string = trim(return_type_string)
end if
end if

proc_idx = 0
do i = 1, map%proc_count
if (map%proc_sigs(i)%procedure_name == proc_name) then
Expand Down Expand Up @@ -140,16 +199,20 @@ subroutine add_signature(map, proc_name, param_kinds, return_kind, &
end subroutine add_signature

subroutine signatures_map_add_signature(this, proc_name, param_kinds, &
return_kind, call_site_node, line, column)
return_kind, call_site_node, line, column, &
param_type_strings, return_type_string)
class(signatures_map_t), intent(inout) :: this
character(len=*), intent(in) :: proc_name
integer, intent(in) :: param_kinds(:)
integer, intent(in) :: return_kind
integer, intent(in) :: call_site_node
integer, intent(in) :: line, column
character(len=*), intent(in), optional :: param_type_strings(:)
character(len=*), intent(in), optional :: return_type_string

call add_signature(this, proc_name, param_kinds, return_kind, &
call_site_node, line, column)
call_site_node, line, column, param_type_strings, &
return_type_string)
end subroutine signatures_map_add_signature

function get_unique_signatures(map, proc_name, unique_sigs) result(count)
Expand Down Expand Up @@ -198,7 +261,8 @@ end function signatures_map_get_signatures
subroutine signatures_map_deep_copy(dst, src)
class(signatures_map_t), intent(out) :: dst
class(signatures_map_t), intent(in) :: src
integer :: i, j
integer :: i, j, k
integer :: max_len

dst%proc_count = src%proc_count
dst%proc_capacity = src%proc_capacity
Expand Down Expand Up @@ -230,6 +294,29 @@ subroutine signatures_map_deep_copy(dst, src)
src%proc_sigs(i)%signatures(j)%line
dst%proc_sigs(i)%signatures(j)%column = &
src%proc_sigs(i)%signatures(j)%column
if (allocated(src%proc_sigs(i)%signatures(j)%param_type_strings)) then
max_len = 0
do k = 1, size(src%proc_sigs(i)%signatures(j)%param_type_strings)
max_len = max(max_len, len_trim( &
src%proc_sigs(i)%signatures(j)%param_type_strings(k)))
end do
if (max_len < 1) max_len = 1
allocate (character(len=max_len) :: &
dst%proc_sigs(i)%signatures(j)%param_type_strings( &
size(src%proc_sigs(i)%signatures(j)%param_type_strings)))
do k = 1, size(src%proc_sigs(i)%signatures(j)%param_type_strings)
dst%proc_sigs(i)%signatures(j)%param_type_strings(k) = &
trim(src%proc_sigs(i)%signatures(j)%param_type_strings(k))
end do
end if
if (allocated(src%proc_sigs(i)%signatures(j)%return_type_string)) then
max_len = len_trim(src%proc_sigs(i)%signatures(j)%return_type_string)
if (max_len < 1) max_len = 1
allocate (character(len=max_len) :: &
dst%proc_sigs(i)%signatures(j)%return_type_string)
dst%proc_sigs(i)%signatures(j)%return_type_string = &
trim(src%proc_sigs(i)%signatures(j)%return_type_string)
end if
end do
end if
end do
Expand Down
3 changes: 0 additions & 3 deletions src/codegen/codegen_declarations_inference.f90
Original file line number Diff line number Diff line change
Expand Up @@ -735,9 +735,6 @@ subroutine process_assignment_target(arena, stmt, state)

if (len_trim(type_buf) == 0) then
type_buf = func_return_type
else if (curr_lower == 'integer' .and. func_lower /= &
'integer') then
type_buf = func_return_type
else if (curr_lower == 'real' .and. func_lower /= 'real') then
type_buf = func_return_type
end if
Expand Down
36 changes: 4 additions & 32 deletions src/semantic/analyzers/semantic_analyzer.f90
Original file line number Diff line number Diff line change
Expand Up @@ -81,8 +81,8 @@ module semantic_analyzer
use semantic_context_types, only: semantic_context_base_t
use semantic_undefined_variable_checker, only: check_undefined_variables_generic
use type_hierarchy, only: type_hierarchy_t, create_type_hierarchy
use call_graph_signatures_mod, only: signatures_map_t, create_signatures_map, &
add_signature
use call_graph_signatures_mod, only: signatures_map_t, create_signatures_map
use semantic_call_signature_collector, only: collect_call_signature
implicit none
private

Expand Down Expand Up @@ -761,7 +761,8 @@ subroutine handle_postvisit(current)
type is (call_or_subscript_node)
node_type = infer_function_call_type(arena, expr, this%scopes, &
get_node_type_with_arena)
call collect_call_signature(this, arena, expr, node_type, node_index)
call collect_call_signature(this%signatures, arena, expr, &
node_type, node_index)
call finalize_node(node_index, node_type)
type is (subroutine_call_node)
node_type = create_mono_type(TVAR, var=create_type_var(0, "error"))
Expand Down Expand Up @@ -1355,34 +1356,5 @@ function semantic_clone_context(this) result(cloned)
allocate (cloned, source=temp_context)
end function semantic_clone_context

subroutine collect_call_signature(ctx, arena, call_node, return_type, &
node_index)
use, intrinsic :: iso_fortran_env, only: error_unit
type(semantic_context_t), intent(inout) :: ctx
type(ast_arena_t), intent(inout) :: arena
type(call_or_subscript_node), intent(in) :: call_node
type(mono_type_t), intent(in) :: return_type
integer, intent(in) :: node_index
integer, allocatable :: param_kinds(:)
integer :: return_kind
integer :: i
type(mono_type_t) :: arg_type

if (.not. allocated(call_node%name)) return
if (.not. allocated(call_node%arg_indices)) return

allocate (param_kinds(size(call_node%arg_indices)))

do i = 1, size(call_node%arg_indices)
arg_type = get_inferred_type_from_arena(ctx, arena, &
call_node%arg_indices(i))
param_kinds(i) = arg_type%get_kind()
end do

return_kind = return_type%get_kind()

call add_signature(ctx%signatures, call_node%name, param_kinds, &
return_kind, node_index, 0, 0)
end subroutine collect_call_signature

end module semantic_analyzer
Loading