subroutinewrite_formprivate

subroutine write_form(list, name, ids, b)
    type(entity_list_t), intent(in) :: list !! the entities
    character(len=*), intent(in) :: name    !! the generic
    integer, intent(in) :: ids(:)           !! the specific procedures of the form
    type(buffer_t), intent(inout) :: b      !! the HTML
    type(string_t), allocatable :: types(:, :), labels(:, :), result_types(:), result_labels(:), rows(:)
    integer, allocatable :: ranks(:, :), result_ranks(:), row_of(:), columns(:), offset(:)
    logical, allocatable :: in_table(:), varies(:), tied(:)
    character(len=:), allocatable :: key, relative
    logical :: has_result, elemental, new
    integer :: n, m, a, j, r, c, primary, num_rows, column

    n = size(ids)
    m = size(list%box(ids(1))%e%more%arg_ids)
    allocate (types(m, n), labels(m, n), ranks(m, n), result_types(n), result_labels(n), result_ranks(n))
    allocate (rows(n), row_of(n), in_table(m), varies(m), tied(m), offset(m))
    has_result = .true.
    elemental = .true.
    do j = 1, n
        associate (e => list%box(ids(j))%e)
            do a = 1, m
                call describe(list, e%more%arg_ids(a), types(a, j)%s, ranks(a, j))
            end do
            has_result = has_result .and. e%kind == E_FUNCTION .and. e%result > 0
            elemental = elemental .and. is_elemental(e)
        end associate
    end do
    if (has_result) then
        do j = 1, n
            call describe(list, list%box(ids(j))%e%result, result_types(j)%s, result_ranks(j))
        end do
    end if

    ! the first argument of varying rank gives the columns
    primary = 0
    do a = 1, m
        varies(a) = any(ranks(a, :) /= ranks(a, 1))
        if (varies(a) .and. primary == 0) primary = a
    end do
    relative = ''
    if (primary > 0) relative = 'rank('//list%box(list%box(ids(1))%e%more%arg_ids(primary))%e%name//')'
    do a = 1, m
        tied(a) = .false.
        if (primary > 0 .and. a /= primary) tied(a) = all(ranks(a, :) - ranks(primary, :) == ranks(a, 1) - ranks(primary, 1))
        in_table(a) = (varies(a) .and. a /= primary .and. .not. tied(a))
        do j = 2, n
            if (types(a, j)%s /= types(a, 1)%s) in_table(a) = .true.
        end do
    end do
    if (.not. any(in_table) .and. primary > 0) in_table(primary) = .true.
    do a = 1, m
        offset(a) = 0
        if (tied(a)) offset(a) = ranks(a, 1) - ranks(primary, 1)
    end do
    do j = 1, n
        do a = 1, m
            call rank_label(types(a, j)%s, ranks(a, j), a == primary, tied(a), relative, &
                            offset(a), labels(a, j)%s)
        end do
    end do
    if (has_result) then
        call label_results(ranks, primary, relative, result_types, result_ranks, result_labels)
    end if

    ! a row for each combination of types
    num_rows = 0
    do j = 1, n
        key = ''
        do a = 1, m
            if (in_table(a)) key = key//labels(a, j)%s//'|'
        end do
        if (has_result) key = key//result_labels(j)%s
        if (primary == 0) key = key//'|'//trim(int_text(j))
        new = .true.
        do r = 1, num_rows
            if (rows(r)%s /= key) cycle
            row_of(j) = r
            new = .false.
        end do
        if (new) then
            num_rows = num_rows + 1
            rows(num_rows)%s = key
            row_of(j) = num_rows
        end if
    end do

    ! a column for each rank, in order
    allocate (columns(0))
    if (primary > 0) then
        do j = 1, n
            if (.not. any(columns == ranks(primary, j))) call push_int(columns, ranks(primary, j))
        end do
        call sort_ints(columns)
    end if

    call add(b, '<div class="form">'//achar(10)//'<div class="sig">')
    call call_text(list, name, ids(1), has_result, b)
    if (elemental) call add(b, ' <span class="attr attr-elemental">elemental</span>')
    call add(b, '</div>'//achar(10))
    call shared_summary(list, ids, b)
    call add(b, '<table class="forms">'//achar(10)//'<thead><tr>')
    do a = 1, m
        if (.not. in_table(a)) cycle
        call add(b, '<th>')
        call html_escape(list%box(list%box(ids(1))%e%more%arg_ids(a))%e%name, b, .false.)
        call add(b, '</th>')
    end do
    if (primary == 0) call add(b, '<th>Procedure</th>')
    do c = 1, size(columns)
        call add(b, '<th class="rank">')
        call html_escape(relative, b, .false.)
        call add(b, ' = ')
        if (columns(c) == ANY_RANK) then
            call add(b, 'any')
        else
            call add(b, trim(int_text(columns(c))))
        end if
        call add(b, '</th>')
    end do
    if (has_result) call add(b, '<th>Result</th>')
    call add(b, '</tr></thead>'//achar(10)//'<tbody>'//achar(10))
    do r = 1, num_rows
        j = findloc(row_of, r, 1)
        call add(b, '<tr>')
        do a = 1, m
            if (.not. in_table(a)) cycle
            call add(b, '<td class="type">')
            call html_escape(labels(a, j)%s, b, .false.)
            call add(b, '</td>')
        end do
        if (primary == 0) then
            call add(b, '<td class="name">')
            call specific_link(list, ids(j), list%box(ids(j))%e%name, b)
            call add(b, '</td>')
        end if
        do c = 1, size(columns)
            call add(b, '<td class="rank">')
            do column = 1, n
                if (row_of(column) /= r) cycle
                if (ranks(primary, column) == columns(c)) call specific_link(list, ids(column), '&#10003;', b)
            end do
            call add(b, '</td>')
        end do
        if (has_result) then
            call add(b, '<td class="type">')
            call html_escape(result_labels(j)%s, b, .false.)
            call add(b, '</td>')
        end if
        call add(b, '</tr>'//achar(10))
    end do
    call add(b, '</tbody>'//achar(10)//'</table>'//achar(10))

    ! what is the same in every specific procedure of the form
    new = .true.
    do a = 1, m
        if (in_table(a) .or. a == primary) cycle
        if (new) then
            call add(b, '<p class="fixed">')
        else
            call add(b, ', ')
        end if
        new = .false.
        call add(b, '<code>')
        call html_escape(list%box(list%box(ids(1))%e%more%arg_ids(a))%e%name, b, .false.)
        call add(b, '</code> is ')
        call html_escape(labels(a, 1)%s, b, .false.)
    end do
    if (.not. new) call add(b, '</p>'//achar(10))
    call add(b, '</div>'//achar(10))
end subroutine write_form