Derived type IO
Opened this issue · 9 comments
With types like the bitset_type it might be a really useful feature to use them in normal IO (read and write data transfer). The bitset_type for example implements a write_bitset interface, but could as well define the very same function as derived type IO:
An interface to a formatted write usually looks like
subroutine write_formatted(self, unit, iotype, v_list, iostat, iomsg)
!> Instance of the object to write.
class(*), intent(inout) :: self
!> Formatted unit for output.
integer, intent(in) :: unit
!> Type of formatted data transfer, has the value "LISTDIRECTED" for fmt=*, "NAMELIST" for namelist output or starts with "DT" for derived type output.
character(len=*), intent(in) :: iotype
!> Rank one array of default integer type containing the edit descriptors for derived type output.
integer, intent(in) :: v_list(:)
!> Status identifier to indicate success of output operation.
integer, intent(out) :: iostat
!> Buffer to return error message in case of failing output operation.
character(len=*), intent(inout) :: iomsg
end subroutine write_formattedWhile an interface to an unformatted write is given here for short reference
subroutine write_unformatted(self, unit, iostat, iomsg)
!> Instance of the object to write.
class(*), intent(inout) :: self
!> Formatted unit for output.
integer, intent(in) :: unit
!> Status identifier to indicate success of output operation.
integer, intent(out) :: iostat
!> Buffer to return error message in case of failing output operation.
character(len=*), intent(inout) :: iomsg
end subroutine write_unformattedThis would allow to easily write a bitset with
use stdlib_bitset, only : bitset_type
type(bitset_type) :: bitset
! ...
print*, bitset
endYes, this looks like it would be a useful addition.
I agree with @milancurcic: it would be a nice addition.
Just a practical question, how would one document the API of such procedure?
The official name is user defined derived type input output, which shortens to UDDTIO, which is a completely unwieldable abbreviation in my opinion and I'm saying this coming quantum chemistry background ;).
My suggestion would be something along the lines of this:
### Formatted read
#### Description
Read a character sequence from a connected formatted unit into the string.
#### Syntax
`read(unit, fmt, iostat=iostat, iomsg=iomsg) string`
#### Status
Experimental
#### Class
Formatted derived type IO.
#### Argument
- `string`: Instance of the string type to read. This argument is `intent(inout)`.
- `unit`: Formatted unit for input. This argument is `intent(in)`.
- `iotype`: Type of formatted data transfer, has the value `"LISTDIRECTED"` for `fmt=*`,
`"NAMELIST"` for namelist input or starts with `"DT"` for derived type input.
This argument is `intent(in)`.
- `v_list`: Rank one array of default integer type containing the edit descriptors for
derived type input.
This argument is `intent(in)`.
- `iostat`: Status identifier to indicate success of input operation.
This argument is `intent(out)`.
- `iomsg`: Buffer to return error message in case of failing input operation.
This argument is `intent(inout)`.
#### Example
```fortran
use stdlib_string_type
implicit none
type(string_type) :: string
integer :: io
string = "Important saved value"
open(newunit=io, form="formatted", status="scratch")
write(io, *) string
write(io, *)
rewind(io)
read(io, *) string
close(io)
end
```Well, these would be internal so they wouldn't have a user facing API, right? For example, everything in the Arguments section is irrelevant for the user, unless I'm unaware of some feature of UDDTIO. I think the following sentence or similar, in the derived type docstring would suffice:
This derived type also implements I/O procedures, so its instance can be used in
readandwritestatements.
At least v_list and iotype can be used to influence the format when using the dt format specifier, they might be ignored, used to change the width of the output or cause a runtime error (= custom iostat + iomsg) if invalid input is provided. Also in case of unformatted read and write the layout could be described or left implementation defined.
We should of course start simple first, just putting in a note for formatted/unformatted read/write is sufficient for now, but there are details which could become important / useful later.
As long as I am going to address issue #383 for bitsets, I can try to add the appropriate UDDTIO for them. However I have never used or written UDDTIO routines. Does someone have a good reference on how to write and test them?
@wclodius2 , I am only aware of the Section 11.6 "Defined derived-type input/output" in MRC (the red book). You can also follow the string_type module:
stdlib/src/stdlib_string_type.fypp
Line 326 in 8228b94
The formatted interfaces will look like:
interface write(formatted)
module subroutine write_form_bitset_64(bitset, unit, iotype, &
v_list, iostat, iomsg)
class(bitset_64), intent(in) :: bitset
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
end subroutine
module subroutine write_form_bitset_large(bitset, unit, iotype, &
v_list, iostat, iomsg)
class(bitset_large), intent(in) :: bitset
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
end subroutine
end interface
The actual implementation can go in the submodule (only shown here for bitset_64)
module subroutine write_form_bitset_64(bitset, unit, iotype, v_list, &
iostat, iomsg)
class(bitset_64), intent(in) :: bitset
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
character(len=8) :: fmt
write(fmt,'(A2,I0,A1)') '(B', bitset%bits(),')'
select case(iotype)
case("LISTDIRECTED")
write(unit, fmt, iostat=iostat, iomsg=iomsg) bitset%block
case("NAMELIST")
error stop "[Fatal] This implementation does not support namelist output"
case default ! DT*
select case(size(v_list))
case(0) ! DT
write(unit, fmt, iostat=iostat, iomsg=iomsg) bitset%block
case(1)
if (v_list(1) > bitset%bits()) then
write(fmt,'(A4,I0,A1)') '(B0.',v_list(1),')'
end if
write(unit, fmt, iostat=iostat, iomsg=iomsg) bitset%block
case default
error stop "[Fatal] This implementation does not support v_list formatters"
end select
end select
end subroutine
The error checking and messages could use further improving.
Press here for an example
program bitset_example1
use, intrinsic :: iso_fortran_env, only: output_unit
use stdlib_bitsets
implicit none
integer, parameter :: BIT_SZ = 5
type(bitset_64) :: bitvec
character(len=:), allocatable :: bitstr
integer :: i
call bitvec%init(BIT_SZ) ! all zeros by default
call bitvec%set(0)
call bitvec%set(1)
call bitvec%set(4)
write(*,'(*(I1))') (bitvec%value(i), i = 0, BIT_SZ-1)
call bitvec%to_string(bitstr)
write(*,'(A)') bitstr
print *, bitvec
write(*,'(dt(8))') bitvec ! field of width is 8
end program
Output:
$ gfortran -Wall bitset_example1.f90 -o example1 -I "/home/ipribec/.local/include" -L"/home/ipribec/.local/lib" -lfortran_stdlib
$ ./example1
11001
10011
10011
00010011
@ivan-pi thanks! I am a bit busy to have more than one git iron in the fire at a time, but once the sorting PR is approved this will be my next project.
There is no rush, I've been working on some small bitset example programs and I will probably open an issue with other suggestions soon.
With the UDDTIO usage is really simplified and it makes it feel much more natural! No need to use the string conversion routines and look-up the details of which procedure to call. A simple print or write will suffice.