#:include "common.fypp"
module stdlib_bitsets
!! Implements zero based bitsets of size up to `huge(0_int32)`.
!! The current code uses 64 bit integers to store the bits and uses all 64 bits.
!! The code assumes two's complement integers, and treats negative integers as
!! having the sign bit set.
!!([Specification](../page/specs/stdlib_bitsets.html))
use :: stdlib_kinds, only: &
bits_kind => int32, & ! If changed change also max_digits, and
block_kind => int64, & ! overflow_bits
int8, &
int16, &
int32, &
int64
use stdlib_optval, only : optval
use, intrinsic :: &
iso_fortran_env, only: &
error_unit
implicit none
private
integer(bits_kind), parameter :: &
block_size = bit_size(0_block_kind)
public :: max_digits, overflow_bits
integer, parameter :: &
max_digits = 10 ! bits_kind == int32
! max_digits = 19 ! bits_kind == int64
integer(bits_kind), parameter :: &
overflow_bits = 2_bits_kind**30/5 ! bits_kind == int32
! overflow_bits = 2_bits_kind**62/5 ! bits_kind == int64
integer(block_kind), parameter :: all_zeros = 0_block_kind
integer(block_kind), parameter :: all_ones = not(all_zeros)
character(*), parameter :: module_name = "STDLIB_BITSETS"
integer, parameter :: &
ia0 = iachar('0'), &
ia9 = iachar('9')
integer, parameter, public :: success = 0
!! Error flag indicating no errors
integer, parameter, public :: alloc_fault = 1
!! Error flag indicating a memory allocation failure
integer, parameter, public :: array_size_invalid_error = 2
!! Error flag indicating an invalid bits value
integer, parameter, public :: char_string_invalid_error = 3
!! Error flag indicating an invalid character string
integer, parameter, public :: char_string_too_large_error = 4
!! Error flag indicating a too large character string
integer, parameter, public :: char_string_too_small_error = 5
!! Error flag indicating a too small character string
integer, parameter, public :: eof_failure = 6
!! Error flag indicating unexpected End-of-File on a READ
integer, parameter, public :: index_invalid_error = 7
!! Error flag indicating an invalid index
integer, parameter, public :: integer_overflow_error = 8
!! Error flag indicating integer overflow
integer, parameter, public :: read_failure = 9
!! Error flag indicating failure of a READ statement
integer, parameter, public :: write_failure = 10
!! Error flag indicating a failure on a WRITE statement
public :: bits_kind
! Public constant
public :: &
bitset_type, &
bitset_large, &
bitset_64
! Public types
public :: &
assignment(=), &
and, &
and_not, &
bits, &
extract, &
operator(==), &
operator(/=), &
operator(>), &
operator(>=), &
operator(<), &
operator(<=), &
or, &
xor
!! Public procedures
public :: error_handler
type, abstract :: bitset_type
!! version: experimental
!!
!! Parent type for bitset_64 and bitset_large ([Specification](../page/specs/stdlib_bitsets.html#the-stdlib_bitsets-derived-types))
private
integer(bits_kind) :: num_bits = 0_bits_kind
contains
procedure(all_abstract), deferred, pass(self) :: all
procedure(any_abstract), deferred, pass(self) :: any
procedure(bit_count_abstract), deferred, pass(self) :: bit_count
procedure, pass(self) :: bits
procedure(clear_bit_abstract), deferred, pass(self) :: clear_bit
procedure(clear_range_abstract), deferred, pass(self) :: clear_range
generic :: clear => clear_bit, clear_range
procedure(flip_bit_abstract), deferred, pass(self) :: flip_bit
procedure(flip_range_abstract), deferred, pass(self) :: flip_range
generic :: flip => flip_bit, flip_range
procedure(from_string_abstract), deferred, pass(self) :: from_string
procedure(init_zero_abstract), deferred, pass(self) :: init_zero
generic :: init => init_zero
procedure(input_abstract), deferred, pass(self) :: input
procedure(none_abstract), deferred, pass(self) :: none
procedure(not_abstract), deferred, pass(self) :: not
procedure(output_abstract), deferred, pass(self) :: output
procedure(read_bitset_string_abstract), deferred, pass(self) :: &
read_bitset_string
procedure(read_bitset_unit_abstract), deferred, pass(self) :: &
read_bitset_unit
generic :: read_bitset => read_bitset_string, read_bitset_unit
procedure(set_bit_abstract), deferred, pass(self) :: set_bit
procedure(set_range_abstract), deferred, pass(self) :: set_range
generic :: set => set_bit, set_range
procedure(test_abstract), deferred, pass(self) :: test
procedure(to_string_abstract), deferred, pass(self) :: to_string
procedure(value_abstract), deferred, pass(self) :: value
procedure(write_bitset_string_abstract), deferred, pass(self) :: &
write_bitset_string
procedure(write_bitset_unit_abstract), deferred, pass(self) :: &
write_bitset_unit
generic :: write_bitset => write_bitset_string, write_bitset_unit
end type bitset_type
abstract interface
elemental function all_abstract( self ) result(all)
!! Version: experimental
!!
!! Returns `.true.` if all bits in `self` are 1, `.false.` otherwise.
!!
!!#### Example
!!
!!```fortran
!! program example_all
!! use stdlib_bitsets
!! character(*), parameter :: &
!! bits_all = '111111111111111111111111111111111'
!! type(bitset_64) :: set0
!! call set0 % from_string( bits_all )
!! if ( bits(set0) /= 33 ) then
!! error stop "FROM_STRING failed to interpret " // &
!! 'BITS_ALL's size properly."
!! else if ( .not. set0 % all() ) then
!! error stop "FROM_STRING failed to interpret" // &
!! "BITS_ALL's value properly."
!! else
!! write(*,*) "FROM_STRING transferred BITS_ALL properly" // &
!! " into set0."
!! end if
!! end program example_all
!!```
import :: bitset_type
logical :: all
class(bitset_type), intent(in) :: self
end function all_abstract
elemental function any_abstract(self) result(any)
!! Version: experimental
!!
!! Returns `.true.` if any bit in `self` is 1, `.false.` otherwise.
!!
!!#### Example
!!
!!```fortran
!! program example_any
!! use stdlib_bitsets
!! character(*), parameter :: &
!! bits_0 = '0000000000000000000'
!! type(bitset_64) :: set0
!! call set0 % from_string( bits_0 )
!! if ( .not. set0 % any() ) then
!! write(*,*) "FROM_STRING interpreted " // &
!! "BITS_0's value properly."
!! end if
!! call set0 % set(5)
!! if ( set0 % any() ) then
!! write(*,*) "ANY interpreted SET0's value properly."
!! end if
!! end program example_any
!!```
import :: bitset_type
logical :: any
class(bitset_type), intent(in) :: self
end function any_abstract
elemental function bit_count_abstract(self) result(bit_count)
!! Version: experimental
!!
!! Returns the number of non-zero bits in `self`.
!!
!!#### Example
!!
!!```fortran
!! program example_bit_count
!! use stdlib_bitsets
!! character(*), parameter :: &
!! bits_0 = '0000000000000000000'
!! type(bitset_64) :: set0
!! call set0 % from_string( bits_0 )
!! if ( set0 % bit_count() == 0 ) then
!! write(*,*) "FROM_STRING interpreted " // &
!! "BITS_0's value properly."
!! end if
!! call set0 % set(5)
!! if ( set0 % bit_count() == 1 ) then
!! write(*,*) "BIT_COUNT interpreted SET0's value properly."
!! end if
!! end program example_bit_count
!!```
import :: bitset_type, bits_kind
integer(bits_kind) :: bit_count
class(bitset_type), intent(in) :: self
end function bit_count_abstract
elemental subroutine clear_bit_abstract(self, pos)
!! Version: experimental
!!
!! Sets to zero the `pos` position in `self`. If `pos` is less than zero or
!! greater than `bits(self)-1` it is ignored.
!!
!!#### Example
!!
!!```fortran
!! program example_clear
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init(166)
!! call set0 % not()
!! if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
!! call set0 % clear(165)
!! if ( .not. set0 % test(165) ) write(*,*) 'Bit 165 is cleared.'
!! call set0 % clear(0,164)
!! if ( set0 % none() ) write(*,*) 'All bits are cleared.'
!! end program example_clear
!!```
import :: bitset_type, bits_kind
class(bitset_type), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine clear_bit_abstract
pure subroutine clear_range_abstract(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Sets to zero all bits from the `start_pos` to `stop_pos` positions in `set`.
!! If `stop_pos < start_pos` then no bits are modified. Positions outside
!! the range 0 to `bits(self)-1` are ignored.
import :: bitset_type, bits_kind
class(bitset_type), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine clear_range_abstract
elemental subroutine flip_bit_abstract(self, pos)
!! Version: experimental
!!
!! Flips the value at the `pos` position in `self`, provided the position is
!! valid. If `pos` is less than 0 or greater than `bits(self)-1`, no value is
!! changed.
!!
!!#### Example
!!
!!```fortran
!! program example_flip
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init(166)
!! if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
!! call set0 % flip(165)
!! if ( set0 % test(165) ) write(*,*) 'Bit 165 is flipped.'
!! call set0 % flip(0,164)
!! if ( set0 % all() ) write(*,*) 'All bits are flipped.'
!! end program example_flip
!!```
import :: bitset_type, bits_kind
class(bitset_type), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine flip_bit_abstract
pure subroutine flip_range_abstract(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Flips all valid bits from the `start_pos` to the `stop_pos` positions in
!! `self`. If `stop_pos < start_pos` no bits are flipped. Positions less than
!! 0 or greater than `bits(self)-1` are ignored.
import :: bitset_type, bits_kind
class(bitset_type), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine flip_range_abstract
subroutine from_string_abstract(self, string, status)
!! Version: experimental
!!
!! Initializes the bitset `self` treating `string` as a binary literal
!! `status` may have the values:
!! * `success` - if no problems were found,
!! * `alloc_fault` - if allocation of the bitset failed
!! * `char_string_too_large_error` - if `string` was too large, or
!! * `char_string_invalid_error` - if string had an invalid character.
!!
!!#### Example
!!
!!```fortran
!! program example_from_string
!! use stdlib_bitsets
!! character(*), parameter :: &
!! bits_all = '111111111111111111111111111111111'
!! type(bitset_64) :: set0
!! call set0 % from_string( bits_all )
!! if ( bits(set0) /= 33 ) then
!! error stop "FROM_STRING failed to interpret " // &
!! 'BITS_ALL's size properly."
!! else if ( .not. set0 % all() ) then
!! error stop "FROM_STRING failed to interpret" // &
!! "BITS_ALL's value properly."
!! else
!! write(*,*) "FROM_STRING transferred BITS_ALL properly" // &
!! " into set0."
!! end if
!! end program example_from_string
!!```
import :: bitset_type
class(bitset_type), intent(out) :: self
character(*), intent(in) :: string
integer, intent(out), optional :: status
end subroutine from_string_abstract
subroutine init_zero_abstract(self, bits, status)
!! Creates the bitset, `self`, of size `bits`, with all bits initialized to
!! zero. `bits` must be non-negative. If an error occurs and `status` is
!! absent then processing stops with an informative stop code. `status`
!! will have one of the values;
!! * `success` - if no problems were found,
!! * `alloc_fault` - if memory allocation failed
!! * `array_size_invalid_error` - if `bits` is either negative or larger
!! than 64 with `self` of class `bitset_64`, or
!!
!!#### Example
!!
!!```fortran
!! program example_init
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init(166)
!! if ( set0 % bits() == 166 ) &
!! write(*,*) `SET0 has the proper size.'
!! if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
!! end program example_init
!!```
import :: bitset_type, bits_kind
class(bitset_type), intent(out) :: self
integer(bits_kind), intent(in) :: bits
integer, intent(out), optional :: status
end subroutine init_zero_abstract
subroutine input_abstract(self, unit, status)
!! Version: experimental
!!
!! Reads the components of the bitset, `self`, from the unformatted I/O
!! unit, `unit`, assuming that the components were written using `output`.
!! If an error occurs and `status` is absent then processing stops with
!! an informative stop code. `status` has one of the values:
!! * `success` - if no problem was found
!! * `alloc_fault` - if it failed allocating memory for `self`, or
!! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
!! or greater than 64 for a `bitset_64` input.
!! * `read_failure` - if it failed during the reads from `unit`
!!
!!#### Example
!!
!!```fortran
!! program example_input
!! character(*), parameter :: &
!! bits_0 = '000000000000000000000000000000000', &
!! bits_1 = '000000000000000000000000000000001', &
!! bits_33 = '100000000000000000000000000000000'
!! integer :: unit
!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
!! call set0 % from_string( bits_0 )
!! call set1 % from_string( bits_1 )
!! call set2 % from_string( bits_33 )
!! open( newunit=unit, file='test.bin', status='replace', &
!! form='unformatted', action='write' )
!! call set2 % output(unit)
!! call set1 % output(unit)
!! call set0 % output(unit)
!! close( unit )
!! open( newunit=unit, file='test.bin', status='old', &
!! form='unformatted', action='read' )
!! call set5 % input(unit)
!! call set4 % input(unit)
!! call set3 % input(unit)
!! close( unit )
!! if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
!! error stop 'Transfer to and from units using ' // &
!! ' output and input failed.'
!! else
!! write(*,*) 'Transfer to and from units using ' // &
!! 'output and input succeeded.'
!! end if
!! end program example_input
!!```
import :: bitset_type
class(bitset_type), intent(out) :: self
integer, intent(in) :: unit
integer, intent(out), optional :: status
end subroutine input_abstract
elemental function none_abstract(self) result(none)
!! Version: experimental
!!
!! Returns `.true.` if none of the bits in `self` have the value 1.
!!
!!#### Example
!!
!!```fortran
!! program example_none
!! use stdlib_bitsets
!! character(*), parameter :: &
!! bits_0 = '0000000000000000000'
!! type(bitset_large) :: set0
!! call set0 % from_string( bits_0 )
!! if ( set0 % none() ) then
!! write(*,*) "FROM_STRING interpreted " // &
!! "BITS_0's value properly."
!! end if
!! call set0 % set(5)
!! if ( .not. set0 % none() ) then
!! write(*,*) "NONE interpreted SET0's value properly."
!! end if
!! end program example_none
!!```
import :: bitset_type
logical :: none
class(bitset_type), intent(in) :: self
end function none_abstract
elemental subroutine not_abstract(self)
!! Version: experimental
!!
!! Sets the bits in `self` to their logical complement
!!
!!#### Example
!!
!!```fortran
!! program example_not
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init( 155 )
!! if ( set0 % none() ) then
!! write(*,*) "FROM_STRING interpreted " // &
!! "BITS_0's value properly."
!! end if
!! call set0 % not()
!! if ( set0 % all() ) then
!! write(*,*) "ALL interpreted SET0's value properly."
!! end if
!! end program example_not
!!```
import :: bitset_type
class(bitset_type), intent(inout) :: self
end subroutine not_abstract
subroutine output_abstract(self, unit, status)
!! Version: experimental
!!
!! Writes the components of the bitset, `self`, to the unformatted I/O
!! unit, `unit`, in a unformatted sequence compatible with `input`. If
!! `status` is absent an error results in an error stop with an
!! informative stop code. If `status` is present it has the default
!! value of `success`, or the value `write_failure` if the write failed.
!!
!!#### Example
!!
!!```fortran
!! program example_output
!! character(*), parameter :: &
!! bits_0 = '000000000000000000000000000000000', &
!! bits_1 = '000000000000000000000000000000001', &
!! bits_33 = '100000000000000000000000000000000'
!! integer :: unit
!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
!! call set0 % from_string( bits_0 )
!! call set1 % from_string( bits_1 )
!! call set2 % from_string( bits_33 )
!! open( newunit=unit, file='test.bin', status='replace', &
!! form='unformatted', action='write' )
!! call set2 % output(unit)
!! call set1 % output(unit)
!! call set0 % output(unit)
!! close( unit )
!! open( newunit=unit, file='test.bin', status='old', &
!! form='unformatted', action='read' )
!! call set5 % input(unit)
!! call set4 % input(unit)
!! call set3 % input(unit)
!! close( unit )
!! if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
!! error stop 'Transfer to and from units using ' // &
!! ' output and input failed.'
!! else
!! write(*,*) 'Transfer to and from units using ' // &
!! 'output and input succeeded.'
!! end if
!! end program example_output
!!```
import :: bitset_type
class(bitset_type), intent(in) :: self
integer, intent(in) :: unit
integer, intent(out), optional :: status
end subroutine output_abstract
subroutine read_bitset_string_abstract(self, string, status)
!! Version: experimental
!!
!! Uses the bitset literal in the default character `string`, to define
!! the bitset, `self`. The literal may be preceded by an an arbitrary
!! sequence of blank characters. If `status` is absent an error results
!! in an error stop with an informative stop code. If `status`
!! is present it has one of the values
!! * `success` - if no problems occurred,
!! * `alloc_fault` - if allocation of memory for SELF failed,
!! * `array_size_invalid_error - if `bits(self)` in `string` is greater
!! than 64 for a `bitset_64`,
!! * `char_string_invalid_error` - if the bitset literal has an invalid
!! character,
!! * `char_string_too_small_error - if the string ends before all the bits
!! are read.
!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
!! value too large to be represented,
!!
!!#### Example
!!
!!```fortran
!! program example_read_bitset
!! character(*), parameter :: &
!! bits_0 = 'S33B000000000000000000000000000000000', &
!! bits_1 = 'S33B000000000000000000000000000000001', &
!! bits_33 = 'S33B100000000000000000000000000000000'
!! character(:), allocatable :: test_0, test_1, test_2
!! integer :: unit
!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
!! call set0 % read_bitset( bits_0, status )
!! call set1 % read_bitset( bits_1, status )
!! call set2 % read_bitset( bits_2, status )
!! call set0 % write_bitset( test_0, status )
!! call set1 % write_bitset( test_1, status )
!! call set2 % write_bitset( test_2, status )
!! if ( bits_0 == test_0 .and. bits_1 == test_1 .and. &
!! bits_2 == test_2 ) then
!! write(*,*) 'READ_BITSET to WRITE_BITSET strings worked.'
!! end if
!! open( newunit=unit, file='test.txt', status='replace', &
!! form='formatted', action='write' )
!! call set2 % write_bitset(unit, advance='no')
!! call set1 % write_bitset(unit, advance='no')
!! call set0 % write_bitset(unit)
!! close( unit )
!! open( newunit=unit, file='test.txt', status='old', &
!! form='formatted', action='read' )
!! call set3 % read_bitset(unit, advance='no')
!! call set4 % read_bitset(unit, advance='no')
!! call set5 % read_bitset(unit)
!! if ( set3 == set0 .and. set4 == set1 .and. set5 == set2 ) then
!! write(*,*) WRITE_BITSET to READ_BITSET through unit worked.'
!! end if
!! end program example_read_bitset
!!```
import :: bitset_type
class(bitset_type), intent(out) :: self
character(len=*), intent(in) :: string
integer, intent(out), optional :: status
end subroutine read_bitset_string_abstract
subroutine read_bitset_unit_abstract(self, unit, advance, status)
!! Version: experimental
!!
!! Uses the bitset literal at the current position in the formatted
!! file with I/O unit, `unit`, to define the bitset, `self`. The literal
!! may be preceded by an an arbitrary sequence of blank characters.
!! If `advance` is present it must be either 'YES' or 'NO'. If absent
!! it has the default value of 'YES' to determine whether advancing
!! I/O occurs. If `status` is absent an error results in an error stop
!! with an informative stop code. If `status` is present it has one of
!! the values:
!! * `success` - if no problem occurred,
!! * `alloc_fault` - if allocation of `self` failed,
!! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
!! is greater than 64 for a `bitset_64`,
!! * `char_string_invalid_error` - if the read of the bitset literal found
!! an invalid character,
!! * `eof_failure` - if a `read` statement reached an end-of-file before
!! completing the read of the bitset literal,
!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
!! value too large to be represented,
!! * `read_failure` - if a `read` statement fails,
!
import :: bitset_type
class(bitset_type), intent(out) :: self
integer, intent(in) :: unit
character(*), intent(in), optional :: advance
integer, intent(out), optional :: status
end subroutine read_bitset_unit_abstract
elemental subroutine set_bit_abstract(self, pos)
!! Version: experimental
!!
!! Sets the value at the `pos` position in `self`, provided the position is
!! valid. If the position is less than 0 or greater than `bits(self)-1`
!! then `self` is unchanged.
!!
!!#### Example
!!
!!```fortran
!! program example_set
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init(166)
!! if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
!! call set0 % set(165)
!! if ( set0 % test(165) ) write(*,*) 'Bit 165 is set.'
!! call set0 % set(0,164)
!! if ( set0 % all() ) write(*,*) 'All bits are set.'
!! end program example_set
!!```
import :: bitset_type, bits_kind
class(bitset_type), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine set_bit_abstract
pure subroutine set_range_abstract(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Sets all valid bits to 1 from the `start_pos` to the `stop_pos` positions
!! in `self`. If `stop_pos < start_pos` no bits are changed. Positions outside
!! the range 0 to `bits(self)-1` are ignored.
import :: bitset_type, bits_kind
class(bitset_type), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine set_range_abstract
elemental function test_abstract(self, pos) result(test)
!! Version: experimental
!!
!! Returns `.true.` if the `pos` position is set, `.false.` otherwise. If `pos`
!! is negative or greater than `bits(self) - 1` the result is `.false.`.
!!
!!#### Example
!!
!!```fortran
!! program example_test
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init(166)
!! call set0 % not()
!! if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
!! call set0 % clear(165)
!! if ( .not. set0 % test(165) ) write(*,*) 'Bit 165 is cleared.'
!! call set0 % set(165)
!! if ( set0 % test(165) ) write(*,*) 'Bit 165 is set.'
!! end program example_test
!!```
import :: bitset_type, bits_kind
logical :: test
class(bitset_type), intent(in) :: self
integer(bits_kind), intent(in) :: pos
end function test_abstract
subroutine to_string_abstract(self, string, status)
!! Version: experimental
!!
!! Represents the value of `self` as a binary literal in `string`
!! Status may have the values `success` or `alloc_fault`.
!!
!!#### Example
!!
!!```fortran
!! program example_to_string
!! use stdlib_bitsets
!! character(*), parameter :: &
!! bits_all = '111111111111111111111111111111111'
!! type(bitset_64) :: set0
!! character(:), allocatable :: new_string
!! call set0 % init(33)
!! call set0 % not()
!! call set0 % to_string( new_string )
!! if ( new_string == bits_all ) then
!! write(*,*) "TO_STRING transferred BITS0 properly" // &
!! " into NEW_STRING."
!! end if
!! end program example_to_string
!!```
import :: bitset_type
class(bitset_type), intent(in) :: self
character(:), allocatable, intent(out) :: string
integer, intent(out), optional :: status
end subroutine to_string_abstract
elemental function value_abstract(self, pos) result(value)
!! Version: experimental
!!
!! Returns 1 if the `pos` position is set, 0 otherwise. If `pos` is negative
!! or greater than `bits(set) - 1` the result is 0.
!!
!!#### Example
!!
!!```fortran
!! program example_value
!! use stdlib_bitsets
!! type(bitset_large) :: set0
!! call set0 % init(166)
!! call set0 % not()
!! if ( set0 % all() ) write(*,*) 'SET0 is properly initialized.'
!! call set0 % clear(165)
!! if ( set0 % value(165) == 0 ) write(*,*) 'Bit 165 is cleared.'
!! call set0 % set(165)
!! if ( set0 % value(165) == 1 ) write(*,*) 'Bit 165 is set.'
!! end program example_value
!!```
import :: bitset_type, bits_kind
integer :: value
class(bitset_type), intent(in) :: self
integer(bits_kind), intent(in) :: pos
end function value_abstract
subroutine write_bitset_string_abstract(self, string, status)
!! Version: experimental
!!
!! Writes a bitset literal to the allocatable default character `string`,
!! representing the individual bit values in the `bitset_type`, `self`.
!! If `status` is absent an error results in an error stop with an
!! informative stop code. If `status` is present it has the default
!! value of `success`, or the value `alloc_fault` if allocation of
!! the output string failed.
!!
!!#### Example
!!
!!```fortran
!! program example_write_bitset
!! character(*), parameter :: &
!! bits_0 = 'S33B000000000000000000000000000000000', &
!! bits_1 = 'S33B000000000000000000000000000000001', &
!! bits_33 = 'S33B100000000000000000000000000000000'
!! character(:), allocatable :: test_0, test_1, test_2
!! integer :: unit
!! type(bitset_64) :: set0, set1, set2, set3, set4, set5
!! call set0 % read_bitset( bits_0, status )
!! call set1 % read_bitset( bits_1, status )
!! call set2 % read_bitset( bits_2, status )
!! call set0 % write_bitset( test_0, status )
!! call set1 % write_bitset( test_1, status )
!! call set2 % write_bitset( test_2, status )
!! if ( bits_0 == test_0 .and. bits_1 == test_1 .and. &
!! bits_2 == test_2 ) then
!! write(*,*) 'READ_BITSET to WRITE_BITSET strings worked.'
!! end if
!! open( newunit=unit, file='test.txt', status='replace', &
!! form='formatted', action='write' )
!! call set2 % write_bitset(unit, advance='no')
!! call set1 % write_bitset(unit, advance='no')
!! call set0 % write_bitset(unit)
!! close( unit )
!! open( newunit=unit, file='test.txt', status='old', &
!! form='formatted', action='read' )
!! call set3 % read_bitset(unit, advance='no')
!! call set4 % read_bitset(unit, advance='no')
!! call set5 % read_bitset(unit)
!! if ( set3 == set0 .and. set4 == set1 .and. set5 == set2 ) then
!! write(*,*) WRITE_BITSET to READ_BITSET through unit worked.'
!! end if
!! end program example_write_bitset
!!```
import :: bitset_type
class(bitset_type), intent(in) :: self
character(len=:), allocatable, intent(out) :: string
integer, intent(out), optional :: status
end subroutine write_bitset_string_abstract
subroutine write_bitset_unit_abstract(self, unit, advance, &
status)
!! Version: experimental
!!
!! Writes a bitset literal to the I/O unit, `unit`, representing the
!! individual bit values in the `bitset_t`, `self`. If an error occurs then
!! processing stops with a message to `error_unit`. By default or if
!! `advance` is present with the value 'YES', advancing output is used.
!! If `advance` is present with the value 'NO', then the current record
!! is not advanced by the write. If `status` is absent, an error results
!! in an error stop with an informative stop code. If `status` is
!! present it has the default value of `success`, the value
!! `alloc_fault` if allocation of the output string failed,
!! `write_failure` if the `write` statement outputting the literal failed.
import :: bitset_type
class(bitset_type), intent(in) :: self
integer, intent(in) :: unit
character(len=*), intent(in), optional :: advance
integer, intent(out), optional :: status
end subroutine write_bitset_unit_abstract
end interface
type, extends(bitset_type) :: bitset_large
!! Version: experimental
!!
!! Type for bitsets with more than 64 bits ([Specification](../page/specs/stdlib_bitsets.html#the-stdlib_bitsets-derived-types))
private
integer(block_kind), private, allocatable :: blocks(:)
contains
procedure, pass(self) :: all => all_large
procedure, pass(self) :: any => any_large
procedure, pass(self) :: bit_count => bit_count_large
procedure, pass(self) :: clear_bit => clear_bit_large
procedure, pass(self) :: clear_range => clear_range_large
procedure, pass(self) :: flip_bit => flip_bit_large
procedure, pass(self) :: flip_range => flip_range_large
procedure, pass(self) :: from_string => from_string_large
procedure, pass(self) :: init_zero => init_zero_large
procedure, pass(self) :: input => input_large
procedure, pass(self) :: none => none_large
procedure, pass(self) :: not => not_large
procedure, pass(self) :: output => output_large
procedure, pass(self) :: &
read_bitset_string => read_bitset_string_large
procedure, pass(self) :: read_bitset_unit => read_bitset_unit_large
procedure, pass(self) :: set_bit => set_bit_large
procedure, pass(self) :: set_range => set_range_large
procedure, pass(self) :: test => test_large
procedure, pass(self) :: to_string => to_string_large
procedure, pass(self) :: value => value_large
procedure, pass(self) :: &
write_bitset_string => write_bitset_string_large
procedure, pass(self) :: write_bitset_unit => write_bitset_unit_large
end type bitset_large
interface
elemental module function all_large( self ) result(all)
!! Version: experimental
!!
!! Returns `.true.` if all bits in `self` are 1, `.false.` otherwise.
logical :: all
class(bitset_large), intent(in) :: self
end function all_large
elemental module function any_large(self) result(any)
!! Version: experimental
!!
!! Returns `.true.` if any bit in `self` is 1, `.false.` otherwise.
logical :: any
class(bitset_large), intent(in) :: self
end function any_large
elemental module function bit_count_large(self) result(bit_count)
!! Version: experimental
!!
!! Returns the number of non-zero bits in `self`.
integer(bits_kind) :: bit_count
class(bitset_large), intent(in) :: self
end function bit_count_large
elemental module subroutine clear_bit_large(self, pos)
!! Version: experimental
!!
!! Sets to zero the bit at `pos` position in `self`. If `pos` is less than
!! zero or greater than `bits(self)-1` it is ignored.
class(bitset_large), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine clear_bit_large
pure module subroutine clear_range_large(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Sets to zero all bits from the `start_pos` to `stop_pos` positions in `self`.
!! If `stop_pos < start_pos` then no bits are modified. Positions outside
!! the range 0 to `bits(set)-1` are ignored.
class(bitset_large), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine clear_range_large
elemental module subroutine flip_bit_large(self, pos)
!! Version: experimental
!!
!! Flips the bit value at the `pos` position in `self`, provided the position is
!! valid. If `pos` is less than 0 or greater than `bits(self)-1`, no value is
!! changed.
class(bitset_large), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine flip_bit_large
pure module subroutine flip_range_large(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Flips all valid bits from the `start_pos` to the `stop_pos` positions in
!! `self`. If `stop_pos < start_pos` no bits are flipped. Positions less than
!! 0 or greater than `bits(self)-1` are ignored.
class(bitset_large), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine flip_range_large
module subroutine from_string_large(self, string, status)
!! Version: experimental
!!
!! Initializes the bitset `self` treating `string` as a binary literal
!! `status` may have the values:
!! * `success` - if no problems were found,
!! * `alloc_fault` - if allocation of the bitset failed
!! * `char_string_too_large_error` - if `string` was too large, or
!! * `char_string_invalid_error` - if string had an invalid character.
class(bitset_large), intent(out) :: self
character(*), intent(in) :: string
integer, intent(out), optional :: status
end subroutine from_string_large
module subroutine init_zero_large(self, bits, status)
!! Version: experimental
!!
!! Creates the bitset, `self`, of size `bits`, with all bits initialized to
!! zero. `bits` must be non-negative. If an error occurs and `status` is
!! absent then processing stops with an informative stop code. `status`
!! will have one of the values;
!! * `success` - if no problems were found,
!! * `alloc_fault` - if memory allocation failed
!! * `array_size_invalid_error` - if `bits` is either negative or larger
!! than 64 with `self` of class `bitset_64`, or
class(bitset_large), intent(out) :: self
integer(bits_kind), intent(in) :: bits
integer, intent(out), optional :: status
end subroutine init_zero_large
module subroutine input_large(self, unit, status)
!! Version: experimental
!!
!! Reads the components of the bitset, `self`, from the unformatted I/O
!! unit, `unit`, assuming that the components were written using `output`.
!! If an error occurs and `status` is absent then processing stops with
!! an informative stop code. `status` has one of the values:
!! * `success` - if no problem was found
!! * `alloc_fault` - if it failed allocating memory for `self`, or
!! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
!! or greater than 64 for a `bitset_64` input.
!! * `read_failure` - if it failed during the reads from `unit`
class(bitset_large), intent(out) :: self
integer, intent(in) :: unit
integer, intent(out), optional :: status
end subroutine input_large
elemental module function none_large(self) result(none)
!! Version: experimental
!!
!! Returns `.true.` if none of the bits in `self` have the value 1.
logical :: none
class(bitset_large), intent(in) :: self
end function none_large
elemental module subroutine not_large(self)
!! Version: experimental
!!
!! Sets the bits in `self` to their logical complement
class(bitset_large), intent(inout) :: self
end subroutine not_large
module subroutine output_large(self, unit, status)
!! Version: experimental
!!
!! Writes the components of the bitset, `self`, to the unformatted I/O
!! unit, `unit`, in a unformatted sequence compatible with `input`. If
!! `status` is absent an error results in an error stop with an
!! informative stop code. If `status` is present it has the default
!! value of `success`, or the value `write_failure` if the write failed.
class(bitset_large), intent(in) :: self
integer, intent(in) :: unit
integer, intent(out), optional :: status
end subroutine output_large
module subroutine read_bitset_string_large(self, string, status)
!! Version: experimental
!!
!! Uses the bitset literal in the default character `string`, to define
!! the bitset, `self`. The literal may be preceded by an an arbitrary
!! sequence of blank characters. If `status` is absent an error results
!! in an error stop with an informative stop code. If `status`
!! is present it has one of the values
!! * `success` - if no problems occurred,
!! * `alloc_fault` - if allocation of memory for SELF failed,
!! * `array_size_invalid_error - if `bits(self)` in `string` is greater
!! than 64 for a `bitset_64`,
!! * `char_string_invalid_error` - if the bitset literal has an invalid
!! character,
!! * `char_string_too_small_error - if the string ends before all the bits
!! are read.
!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
!! value too large to be represented,
class(bitset_large), intent(out) :: self
character(len=*), intent(in) :: string
integer, intent(out), optional :: status
end subroutine read_bitset_string_large
module subroutine read_bitset_unit_large(self, unit, advance, status)
!! Version: experimental
!!
!! Uses the bitset literal at the current position in the formatted
!! file with I/O unit, `unit`, to define the bitset, `self`. The literal
!! may be preceded by an an arbitrary sequence of blank characters.
!! If `advance` is present it must be either 'YES' or 'NO'. If absent
!! it has the default value of 'YES' to determine whether advancing
!! I/O occurs. If `status` is absent an error results in an error stop
!! with an informative stop code. If `status` is present it has one of
!! the values:
!! * `success` - if no problem occurred,
!! * `alloc_fault` - if allocation of `self` failed,
!! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
!! is greater than 64 for a `bitset_64`,
!! * `char_string_invalid_error` - if the read of the bitset literal found
!! an invalid character,
!! * `eof_failure` - if a `read` statement reached an end-of-file before
!! completing the read of the bitset literal,
!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
!! value too large to be represented,
!! * `read_failure` - if a `read` statement fails,
class(bitset_large), intent(out) :: self
integer, intent(in) :: unit
character(*), intent(in), optional :: advance
integer, intent(out), optional :: status
end subroutine read_bitset_unit_large
elemental module subroutine set_bit_large(self, pos)
!! Version: experimental
!!
!! Sets the value at the `pos` position in `self`, provided the position is
!! valid. If the position is less than 0 or greater than `bits(self)-1`
!! then `self` is unchanged.
class(bitset_large), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine set_bit_large
pure module subroutine set_range_large(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Sets all valid bits to 1 from the `start_pos` to the `stop_pos` positions
!! in `self`. If `stop_pos < start_pos` no bits are changed. Positions outside
!! the range 0 to `bits(self)-1` are ignored.
class(bitset_large), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine set_range_large
elemental module function test_large(self, pos) result(test)
!! Version: experimental
!!
!! Returns `.true.` if the `pos` position is set, `.false.` otherwise. If `pos`
!! is negative or greater than `bits(self) - 1` the result is `.false.`.
logical :: test
class(bitset_large), intent(in) :: self
integer(bits_kind), intent(in) :: pos
end function test_large
module subroutine to_string_large(self, string, status)
!! Version: experimental
!!
!! Represents the value of `self` as a binary literal in `string`
!! Status may have the values `success` or `alloc_fault`.
class(bitset_large), intent(in) :: self
character(len=:), allocatable, intent(out) :: string
integer, intent(out), optional :: status
end subroutine to_string_large
elemental module function value_large(self, pos) result(value)
!! Version: experimental
!!
!! Returns 1 if the `pos` position is set, 0 otherwise. If `pos` is negative
!! or greater than `bits(set) - 1` the result is 0.
integer :: value
class(bitset_large), intent(in) :: self
integer(bits_kind), intent(in) :: pos
end function value_large
module subroutine write_bitset_string_large(self, string, status)
!! Version: experimental
!!
!! Writes a bitset literal to the allocatable default character `string`,
!! representing the individual bit values in the bitset_large, `self`.
!! If `status` is absent an error results in an error stop with an
!! informative stop code. If `status` is present it has the default
!! value of `success, or the value `alloc_fault` if allocation of
!! the output string failed.
class(bitset_large), intent(in) :: self
character(len=:), allocatable, intent(out) :: string
integer, intent(out), optional :: status
end subroutine write_bitset_string_large
module subroutine write_bitset_unit_large(self, unit, advance, status)
!! Version: experimental
!!
!! Writes a bitset literal to the I/O unit, `unit`, representing the
!! individual bit values in the bitset, `self`. By default or if
!! `advance` is present with the value 'YES', advancing output is used.
!! If `advance` is present with the value 'NO', then the current record
!! is not advanced by the write. If `status` is absent an error results
!! in an error stop with an informative stop code. If `status` is
!! present it has the default value of `success`, the value
!! `alloc_fault` if allocation of the output string failed, or
!! `write_failure` if the `write` statement outputting the literal failed.
class(bitset_large), intent(in) :: self
integer, intent(in) :: unit
character(len=*), intent(in), optional :: advance
integer, intent(out), optional :: status
end subroutine write_bitset_unit_large
end interface
interface assignment(=)
!! Version: experimental
!!
!! Used to define assignment for `bitset_large`.
!! ([Specification](../page/specs/stdlib_bitsets.html#-compare-two-bitsets-to-determine-whether-the-bits-have-the-same-value))
!!
!!#### Example
!!
!!```fortran
!! program example_assignment
!! use stdlib_bitsets
!! logical(int8) :: logical1(64) = .true.
!! logical(int32), allocatable :: logical2(:)
!! type(bitset_64) :: set0, set1
!! set0 = logical1
!! if ( set0 % bits() /= 64 ) then
!! error stop procedure // &
!! ' initialization with logical(int8) failed to set' // &
!! ' the right size.'
!! else if ( .not. set0 % all() ) then
!! error stop procedure // ' initialization with' // &
!! ' logical(int8) failed to set the right values.'
!! else
!! write(*,*) 'Initialization with logical(int8) succeeded.'
!! end if
!! set1 = set0
!! if ( set1 == set0 ) &
!! write(*,*) 'Initialization by assignment succeeded'
!! logical2 = set1
!! if ( all( logical2 ) ) then
!! write(*,*) 'Initialization of logical(int32) succeeded.'
!! end if
!! end program example_assignment
!!```
#:for k1 in INT_KINDS
pure module subroutine assign_log${k1}$_large( self, logical_vector )
!! Version: experimental
!!
!! Used to define assignment from an array of type `logical(${k1}$)` to a
!! `bitset_large`.
type(bitset_large), intent(out) :: self
logical(${k1}$), intent(in) :: logical_vector(:)
end subroutine assign_log${k1}$_large
pure module subroutine log${k1}$_assign_large( logical_vector, set )
!! Version: experimental
!!
!! Used to define assignment to an array of type `logical(${k1}$)` from a
!! `bitset_large`.
logical(${k1}$), intent(out), allocatable :: logical_vector(:)
type(bitset_large), intent(in) :: set
end subroutine log${k1}$_assign_large
#:endfor
end interface assignment(=)
type, extends(bitset_type) :: bitset_64
!! Version: experimental
!!
!! Type for bitsets with no more than 64 bits ([Specification](../page/specs/stdlib_bitsets.html#the-stdlib_bitsets-derived-types))
private
integer(block_kind), private :: block = 0
contains
procedure, pass(self) :: all => all_64
procedure, pass(self) :: any => any_64
procedure, pass(self) :: bit_count => bit_count_64
procedure, pass(self) :: clear_bit => clear_bit_64
procedure, pass(self) :: clear_range => clear_range_64
procedure, pass(self) :: flip_bit => flip_bit_64
procedure, pass(self) :: flip_range => flip_range_64
procedure, pass(self) :: from_string => from_string_64
procedure, pass(self) :: init_zero => init_zero_64
procedure, pass(self) :: input => input_64
procedure, pass(self) :: none => none_64
procedure, pass(self) :: not => not_64
procedure, pass(self) :: output => output_64
procedure, pass(self) :: read_bitset_string => read_bitset_string_64
procedure, pass(self) :: read_bitset_unit => read_bitset_unit_64
procedure, pass(self) :: set_bit => set_bit_64
procedure, pass(self) :: set_range => set_range_64
procedure, pass(self) :: test => test_64
procedure, pass(self) :: to_string => to_string_64
procedure, pass(self) :: value => value_64
procedure, pass(self) :: write_bitset_string => write_bitset_string_64
procedure, pass(self) :: write_bitset_unit => write_bitset_unit_64
end type bitset_64
interface
elemental module function all_64( self ) result(all)
!! Version: experimental
!!
!! Returns `.true.` if all bits in `self` are 1, `.false.` otherwise.
logical :: all
class(bitset_64), intent(in) :: self
end function all_64
elemental module function any_64(self) result(any)
!! Version: experimental
!!
!! Returns `.true.` if any bit in `self` is 1, `.false.` otherwise.
logical :: any
class(bitset_64), intent(in) :: self
end function any_64
elemental module function bit_count_64(self) result(bit_count)
!! Version: experimental
!!
!! Returns the number of non-zero bits in `self`.
integer(bits_kind) :: bit_count
class(bitset_64), intent(in) :: self
end function bit_count_64
elemental module subroutine clear_bit_64(self, pos)
!! Version: experimental
!!
!! Sets to zero the bit at `pos` position in `self`. If `pos` is less than
!! zero or greater than `bits(self)-1` it is ignored.
class(bitset_64), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine clear_bit_64
pure module subroutine clear_range_64(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Sets to zero all bits from the `start_pos` to `stop_pos` positions in `self`.
!! If `stop_pos < start_pos` then no bits are modified. Positions outside
!! the range 0 to `bits(set)-1` are ignored.
class(bitset_64), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine clear_range_64
elemental module subroutine flip_bit_64(self, pos)
!! Version: experimental
!!
!! Flips the bit value at the `pos` position in `self`, provided the position is
!! valid. If `pos` is less than 0 or greater than `bits(self)-1`, no value is
!! changed.
class(bitset_64), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine flip_bit_64
pure module subroutine flip_range_64(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Flips all valid bits from the `start_pos` to the `stop_pos` positions in
!! `self`. If `stop_pos < start_pos` no bits are flipped. Positions less than
!! 0 or greater than `bits(self)-1` are ignored.
class(bitset_64), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine flip_range_64
module subroutine from_string_64(self, string, status)
!! Version: experimental
!!
!! Initializes the bitset `self` treating `string` as a binary literal
!! `status` may have the values:
!! * `success` - if no problems were found,
!! * `alloc_fault` - if allocation of the bitset failed
!! * `char_string_too_large_error` - if `string` was too large, or
!! * `char_string_invalid_error` - if string had an invalid character.
class(bitset_64), intent(out) :: self
character(*), intent(in) :: string
integer, intent(out), optional :: status
end subroutine from_string_64
module subroutine init_zero_64(self, bits, status)
!! Version: experimental
!!
!! Creates the bitset, `self`, of size `bits`, with all bits initialized to
!! zero. `bits` must be non-negative. If an error occurs and `status` is
!! absent then processing stops with an informative stop code. `status`
!! will have one of the values:
!! * `success` - if no problems were found,
!! * `alloc_fault` - if memory allocation failed
!! * `array_size_invalid_error` - if `bits` is either negative or larger
!! than 64 with `self` of class `bitset_64`.
class(bitset_64), intent(out) :: self
integer(bits_kind), intent(in) :: bits
integer, intent(out), optional :: status
end subroutine init_zero_64
module subroutine input_64(self, unit, status)
!! Version: experimental
!!
!! Reads the components of the bitset, `self`, from the unformatted I/O
!! unit, `unit`, assuming that the components were written using `output`.
!! If an error occurs and `status` is absent then processing stops with
!! an informative stop code. `status` has one of the values:
!! * `success` - if no problem was found
!! * `alloc_fault` - if it failed allocating memory for `self`, or
!! * `array_size_invalid_error` if the `bits(self)` in `unit` is negative
!! or greater than 64 for a `bitset_64` input.
!! * `read_failure` - if it failed during the reads from `unit`
class(bitset_64), intent(out) :: self
integer, intent(in) :: unit
integer, intent(out), optional :: status
end subroutine input_64
elemental module function none_64(self) result(none)
!! Version: experimental
!!
!! Returns `.true.` if none of the bits in `self` have the value 1.
logical :: none
class(bitset_64), intent(in) :: self
end function none_64
elemental module subroutine not_64(self)
!! Version: experimental
!!
!! Sets the bits in `self` to their logical complement.
class(bitset_64), intent(inout) :: self
end subroutine not_64
module subroutine output_64(self, unit, status)
!! Version: experimental
!!
!! Writes the components of the bitset, `self`, to the unformatted I/O
!! unit, `unit`, in a unformatted sequence compatible with `input`. If
!! `status` is absent an error results in an error stop with an
!! informative stop code. If `status` is present it has the default
!! value of `success`, or the value `write_failure` if the write failed.
class(bitset_64), intent(in) :: self
integer, intent(in) :: unit
integer, intent(out), optional :: status
end subroutine output_64
module subroutine read_bitset_string_64(self, string, status)
!! Version: experimental
!!
!! Uses the bitset literal in the default character `string`, to define
!! the bitset, `self`. The literal may be preceded by an an arbitrary
!! sequence of blank characters. If `status` is absent an error results
!! in an error stop with an informative stop code. If `status`
!! is present it has one of the values:
!! * `success` - if no problems occurred,
!! * `alloc_fault` - if allocation of memory for SELF failed,
!! * `array_size_invalid_error - if `bits(self)` in `string` is greater
!! than 64 for a `bitset_64`,
!! * `char_string_invalid_error` - if the bitset literal has an invalid
!! character,
!! * `char_string_too_small_error - if the string ends before all the bits
!! are read.
!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
!! value too large to be represented,
class(bitset_64), intent(out) :: self
character(len=*), intent(in) :: string
integer, intent(out), optional :: status
end subroutine read_bitset_string_64
module subroutine read_bitset_unit_64(self, unit, advance, status)
!! Version: experimental
!!
!! Uses the bitset literal at the current position in the formatted
!! file with I/O unit, `unit`, to define the bitset, `self`. The literal
!! may be preceded by an an arbitrary sequence of blank characters.
!! If `advance` is present it must be either 'YES' or 'NO'. If absent
!! it has the default value of 'YES' to determine whether advancing
!! I/O occurs. If `status` is absent an error results in an error stop
!! with an informative stop code. If `status` is present it has one of
!! the values:
!! * `success` - if no problem occurred,
!! * `alloc_fault` - if allocation of `self` failed,
!! * `array_size_invalid_error` - if `bits(self)` in the bitset literal
!! is greater than 64 for a `bitset_64`,
!! * `char_string_invalid_error` - if the read of the bitset literal found
!! an invalid character,
!! * `eof_failure` - if a `read` statement reached an end-of-file before
!! completing the read of the bitset literal,
!! * `integer_overflow_error` - if the bitset literal has a `bits(self)`
!! value too large to be represented,
!! * `read_failure` - if a `read` statement fails,
class(bitset_64), intent(out) :: self
integer, intent(in) :: unit
character(*), intent(in), optional :: advance
integer, intent(out), optional :: status
end subroutine read_bitset_unit_64
elemental module subroutine set_bit_64(self, pos)
!! Version: experimental
!!
!! Sets the value at the `pos` position in `self`, provided the position is
!! valid. If the position is less than 0 or greater than `bits(self)-1`
!! then `self` is unchanged.
class(bitset_64), intent(inout) :: self
integer(bits_kind), intent(in) :: pos
end subroutine set_bit_64
pure module subroutine set_range_64(self, start_pos, stop_pos)
!! Version: experimental
!!
!! Sets all valid bits to 1 from the `start_pos` to the `stop_pos` positions
!! in `self`. If `stop_pos < start_pos` no bits are changed. Positions outside
!! the range 0 to `bits(self)-1` are ignored.
class(bitset_64), intent(inout) :: self
integer(bits_kind), intent(in) :: start_pos, stop_pos
end subroutine set_range_64
elemental module function test_64(self, pos) result(test)
!! Version: experimental
!!
!! Returns `.true.` if the `pos` position is set, `.false.` otherwise. If `pos`
!! is negative or greater than `bits(self)-1` the result is `.false.`.
logical :: test
class(bitset_64), intent(in) :: self
integer(bits_kind), intent(in) :: pos
end function test_64
module subroutine to_string_64(self, string, status)
!! Version: experimental
!!
!! Represents the value of `self` as a binary literal in `string`.
!! Status may have the values `success` or `alloc_fault`
class(bitset_64), intent(in) :: self
character(len=:), allocatable, intent(out) :: string
integer, intent(out), optional :: status
end subroutine to_string_64
elemental module function value_64(self, pos) result(value)
!! Version: experimental
!!
!! Returns 1 if the `pos` position is set, 0 otherwise. If `pos` is negative
!! or greater than `bits(set)-1` the result is 0.
integer :: value
class(bitset_64), intent(in) :: self
integer(bits_kind), intent(in) :: pos
end function value_64
module subroutine write_bitset_string_64(self, string, status)
!! Version: experimental
!!
!! Writes a bitset literal to the allocatable default character `string`,
!! representing the individual bit values in the `bitset_64`, `self`.
!! If `status` is absent an error results in an error stop with an
!! informative stop code. If `status` is present it has the default
!! value of `success`, or the value `alloc_fault` if allocation of
!! the output string failed.
class(bitset_64), intent(in) :: self
character(len=:), allocatable, intent(out) :: string
integer, intent(out), optional :: status
end subroutine write_bitset_string_64
module subroutine write_bitset_unit_64(self, unit, advance, status)
!! Version: experimental
!!
!! Writes a bitset literal to the I/O unit, `unit`, representing the
!! individual bit values in the bitset, `self`. By default or if
!! `advance` is present with the value 'YES', advancing output is used.
!! If `advance` is present with the value 'NO', then the current record
!! is not advanced by the write. If `status` is absent an error results
!! in an error stop with an informative stop code. If `status` is
!! present it has the default value of `success`, the value
!! `alloc_fault` if allocation of the output string failed, or
!! `write_failure` if the `write` statement outputting the literal failed.
class(bitset_64), intent(in) :: self
integer, intent(in) :: unit
character(len=*), intent(in), optional :: advance
integer, intent(out), optional :: status
end subroutine write_bitset_unit_64
end interface
interface assignment(=)
#:for k1 in INT_KINDS
module subroutine assign_log${k1}$_64( self, logical_vector )
!! Version: experimental
!!
!! Used to define assignment from an array of type `logical(${k1}$)` to a
!! `bitset_64`.
type(bitset_64), intent(out) :: self
logical(${k1}$), intent(in) :: logical_vector(:)
end subroutine assign_log${k1}$_64
pure module subroutine log${k1}$_assign_64( logical_vector, set )
!! Version: experimental
!!
!! Used to define assignment to an array of type `logical(${k1}$)` from a
!! `bitset_64`.
logical(${k1}$), intent(out), allocatable :: logical_vector(:)
type(bitset_64), intent(in) :: set
end subroutine log${k1}$_assign_64
#:endfor
end interface assignment(=)
interface and
!! Version: experimental
!!
!! Sets the bits in `set1` to the bitwise `and` of the original bits in `set1`
!! and `set2`. The sets must have the same number of bits
!! otherwise the result is undefined.
!! ([Specification](../page/specs/stdlib_bitsets.html#and-bitwise-and-of-the-bits-of-two-bitsets))
!!
!!#### Example
!!
!!```fortran
!! program example_and
!! use stdlib_bitsets
!! type(bitset_large) :: set0, set1
!! call set0 % init(166)
!! call set1 % init(166)
!! call and( set0, set1 ) ! none none
!! if ( none(set0) ) write(*,*) 'First test of AND worked.'
!! call set0 % not()
!! call and( set0, set1 ) ! all none
!! if ( none(set0) ) write(*,*) 'Second test of AND worked.'
!! call set1 % not()
!! call and( set0, set1 ) ! none all
!! if ( none(set0) ) write(*,*) 'Third test of AND worked.'
!! call set0 % not()
!! call and( set0, set1 ) ! all all
!! if ( all(set0) ) write(*,*) 'Fourth test of AND worked.'
!! end program example_and
!!```
elemental module subroutine and_large(set1, set2)
type(bitset_large), intent(inout) :: set1
type(bitset_large), intent(in) :: set2
end subroutine and_large
elemental module subroutine and_64(set1, set2)
type(bitset_64), intent(inout) :: set1
type(bitset_64), intent(in) :: set2
end subroutine and_64
end interface and
interface and_not
!! Version: experimental
!!
!! Sets the bits in `set1` to the bitwise and of the original bits in `set1`
!! with the bitwise negation of `set2`. The sets must have the same
!! number of bits otherwise the result is undefined.
!!
!! ([Specification](../page/specs/stdlib_bitsets.html#and_not-bitwise-and-of-one-bitset-with-the-negation-of-another))
!!
!!#### Example
!!
!!```fortran
!! program example_and_not
!! use stdlib_bitsets
!! type(bitset_large) :: set0, set1
!! call set0 % init(166)
!! call set1 % init(166)
!! call and_not( set0, set1 ) ! none none
!! if ( none(set0) ) write(*,*) 'First test of AND_NOT worked.'
!! call set0 % not()
!! call and_not( set0, set1 ) ! all none
!! if ( all(set0) ) write(*,*) 'Second test of AND_NOT worked.'
!! call set0 % not()
!! call set1 % not()
!! call and_not( set0, set1 ) ! none all
!! if ( none(set0) ) write(*,*) 'Third test of AND_NOT worked.'
!! call set0 % not()
!! call and_not( set0, set1 ) ! all all
!! if ( none(set0) ) write(*,*) 'Fourth test of AND_NOT worked.'
!! end program example_and_not
!!```
elemental module subroutine and_not_large(set1, set2)
type(bitset_large), intent(inout) :: set1
type(bitset_large), intent(in) :: set2
end subroutine and_not_large
elemental module subroutine and_not_64(set1, set2)
type(bitset_64), intent(inout) :: set1
type(bitset_64), intent(in) :: set2
end subroutine and_not_64
end interface and_not
interface extract
!! Version: experimental
!!
!! Creates a new bitset, `new`, from a range, `start_pos` to `stop_pos`, in
!! bitset `old`. If `start_pos` is greater than `stop_pos` the new bitset is
!! empty. If `start_pos` is less than zero or `stop_pos` is greater than
!! `bits(old)-1` then if `status` is present it has the value
!! `index_invalid_error` and `new` is undefined, otherwise processing stops
!! with an informative message.
!! ([Specification](../page/specs/stdlib_bitsets.html#extract-create-a-new-bitset-from-a-range-in-an-old-bitset))
!!
!!#### Example
!!
!!```fortran
!! program example_extract
!! use stdlib_bitsets
!! type(bitset_large) :: set0, set1
!! call set0 % init(166)
!! call set0 % set(100,150)
!! call extract( set1, set0, 100, 150)
!! if ( set1 % bits() == 51 ) &
!! write(*,*) 'SET1 has the proper size.'
!! if ( set1 % all() ) write(*,*) 'SET1 has the proper values.'
!! end program example_extract
!!```
module subroutine extract_large(new, old, start_pos, stop_pos, status)
type(bitset_large), intent(out) :: new
type(bitset_large), intent(in) :: old
integer(bits_kind), intent(in) :: start_pos, stop_pos
integer, intent(out), optional :: status
end subroutine extract_large
module subroutine extract_64(new, old, start_pos, stop_pos, status)
type(bitset_64), intent(out) :: new
type(bitset_64), intent(in) :: old
integer(bits_kind), intent(in) :: start_pos, stop_pos
integer, intent(out), optional :: status
end subroutine extract_64
end interface extract
interface or
!! Version: experimental
!!
!! Sets the bits in `set1` to the bitwise `or` of the original bits in `set1`
!! and `set2`. The sets must have the same number of bits otherwise
!! the result is undefined.
!! ([Specification](../page/specs/stdlib_bitsets.html#or-bitwise-or-of-the-bits-of-two-bitsets))
!!
!!#### Example
!!
!!```fortran
!! program example_or
!! use stdlib_bitsets
!! type(bitset_large) :: set0, set1
!! call set0 % init(166)
!! call set1 % init(166)
!! call or( set0, set1 ) ! none none
!! if ( none(set0) ) write(*,*) 'First test of OR worked.'
!! call set0 % not()
!! call or( set0, set1 ) ! all none
!! if ( all(set0) ) write(*,*) 'Second test of OR worked.'
!! call set0 % not()
!! call set1 % not()
!! call or( set0, set1 ) ! none all
!! if ( all(set0) ) write(*,*) 'Third test of OR worked.'
!! call set0 % not()
!! call or( set0, set1 ) ! all all
!! if ( all(set0) ) write(*,*) 'Fourth test of OR worked.'
!! end program example_or
!!```
elemental module subroutine or_large(set1, set2)
type(bitset_large), intent(inout) :: set1
type(bitset_large), intent(in) :: set2
end subroutine or_large
elemental module subroutine or_64(set1, set2)
type(bitset_64), intent(inout) :: set1
type(bitset_64), intent(in) :: set2
end subroutine or_64
end interface or
interface xor
!! Version: experimental
!!
!! Sets the bits in `set1` to the bitwise `xor` of the original bits in `set1`
!! and `set2`. The sets must have the same number of bits
!! otherwise the result is undefined.
!!([Specification](../page/specs/stdlib_bitsets.html#xor-bitwise-exclusive-or))
!!
!!#### Example
!!
!!```fortran
!! program example_xor
!! use stdlib_bitsets
!! type(bitset_large) :: set0, set1
!! call set0 % init(166)
!! call set1 % init(166)
!! call xor( set0, set1 ) ! none none
!! if ( none(set0) ) write(*,*) 'First test of XOR worked.'
!! call set0 % not()
!! call xor( set0, set1 ) ! all none
!! if ( all(set0) ) write(*,*) 'Second test of XOR worked.'
!! call set0 % not()
!! call set1 % not()
!! call xor( set0, set1 ) ! none all
!! if ( all(set0) ) write(*,*) 'Third test of XOR worked.'
!! call set0 % not()
!! call xor( set0, set1 ) ! all all
!! if ( none(set0) ) write(*,*) 'Fourth test of XOR worked.'
!! end program example_xor
!!```
elemental module subroutine xor_large(set1, set2)
type(bitset_large), intent(inout) :: set1
type(bitset_large), intent(in) :: set2
end subroutine xor_large
elemental module subroutine xor_64(set1, set2)
type(bitset_64), intent(inout) :: set1
type(bitset_64), intent(in) :: set2
end subroutine xor_64
end interface xor
interface operator(==)
!! Version: experimental
!!
!! Returns `.true.` if all bits in `set1` and `set2` have the same value,
!! `.false.` otherwise. The sets must have the same number of bits
!! otherwise the result is undefined.
!!([Specification](../page/specs/stdlib_bitsets.html#-compare-two-bitsets-to-determine-whether-the-bits-have-the-same-value))
!!
!!#### Example
!!
!!```fortran
!! program example_equality
!! use stdlib_bitsets
!! type(bitset_64) :: set0, set1, set2
!! call set0 % init( 33 )
!! call set1 % init( 33 )
!! call set2 % init( 33 )
!! call set1 % set( 0 )
!! call set2 % set( 32 )
!! if ( set0 == set0 .and. set1 == set1 .and. set2 == set2 .and. &
!! .not. set0 == set1 .and. .not. set0 == set2 .and. .not. &
!! set1 == set2 ) then
!! write(*,*) 'Passed 64 bit equality tests.'
!! else
!! error stop 'Failed 64 bit equality tests.'
!! end if
!! end program example_equality
!!```
elemental module function eqv_large(set1, set2) result(eqv)
logical :: eqv
type(bitset_large), intent(in) :: set1, set2
end function eqv_large
elemental module function eqv_64(set1, set2) result(eqv)
logical :: eqv
type(bitset_64), intent(in) :: set1, set2
end function eqv_64
end interface operator(==)
interface operator(/=)
!! Version: experimental
!!
!! Returns `.true.` if not all bits in `set1` and `set2` have the same value,
!! `.false.` otherwise. The sets must have the same number of bits
!! otherwise the result is undefined.
!!([Specification](../page/specs/stdlib_bitsets.html#-compare-two-bitsets-to-determine-whether-any-bits-differ-in-value))
!!
!!#### Example
!!
!!```fortran
!! program example_inequality
!! use stdlib_bitsets
!! type(bitset_64) :: set0, set1, set2
!! call set0 % init( 33 )
!! call set1 % init( 33 )
!! call set2 % init( 33 )
!! call set1 % set( 0 )
!! call set2 % set( 32 )
!! if ( set0 /= set1 .and. set0 /= set2 .and. set1 /= set2 .and. &
!! .not. set0 /= set0 .and. .not. set1 /= set1 .and. .not. &
!! set2 /= set2 ) then
!! write(*,*) 'Passed 64 bit inequality tests.'
!! else
!! error stop 'Failed 64 bit inequality tests.'
!! end if
!! end program example_inequality
!!```
elemental module function neqv_large(set1, set2) result(neqv)
logical :: neqv
type(bitset_large), intent(in) :: set1, set2
end function neqv_large
elemental module function neqv_64(set1, set2) result(neqv)
logical :: neqv
type(bitset_64), intent(in) :: set1, set2
end function neqv_64
end interface operator(/=)
interface operator(>)
!! Version: experimental
!!
!! Returns `.true.` if the bits in `set1` and `set2` differ and the
!! highest order different bit is set to 1 in `set1` and to 0 in `set2`,
!! `.false.` otherwise. The sets must have the same number of bits
!! otherwise the result is undefined.
!!([Specification](../page/specs/stdlib_bitsets.html#gt-compare-two-bitsets-to-determine-whether-the-first-is-greater-than-the-other))
!!
!!#### Example
!!
!!```fortran
!! program example_gt
!! use stdlib_bitsets
!! type(bitset_64) :: set0, set1, set2
!! call set0 % init( 33 )
!! call set1 % init( 33 )
!! call set2 % init( 33 )
!! call set1 % set( 0 )
!! call set2 % set( 32 )
!! if ( set1 > set0 .and. set2 > set1 .and. set2 > set0 .and. &
!! .not. set0 > set0 .and. .not. set0 > set1 .and. .not. &
!! set1 > set2 ) then
!! write(*,*) 'Passed 64 bit greater than tests.'
!! else
!! error stop 'Failed 64 bit greater than tests.'
!! end if
!! end program example_gt
!!```
elemental module function gt_large(set1, set2) result(gt)
logical :: gt
type(bitset_large), intent(in) :: set1, set2
end function gt_large
elemental module function gt_64(set1, set2) result(gt)
logical :: gt
type(bitset_64), intent(in) :: set1, set2
end function gt_64
end interface operator(>)
interface operator(>=)
!! Version: experimental
!!
!! Returns `.true.` if the bits in `set1` and `set2` are the same or the
!! highest order different bit is set to 1 in `set1` and to 0 in `set2`,
!! `.false.` otherwise. The sets must have the same number of bits
!! otherwise the result is undefined.
!! ([Specification](../page/specs/stdlib_bitsets.html#gt-compare-two-bitsets-to-determine-whether-the-first-is-greater-than-or-equal-to-the-second))
!!
!!#### Example
!!
!!```fortran
!! program example_ge
!! use stdlib_bitsets
!! type(bitset_64) :: set0, set1, set2
!! call set0 % init( 33 )
!! call set1 % init( 33 )
!! call set2 % init( 33 )
!! call set1 % set( 0 )
!! call set2 % set( 32 )
!! if ( set1 >= set0 .and. set2 >= set1 .and. set2 >= set0 .and. &
!! set0 >= set0 .and. set1 >= set1 .and. set2 >= set2 .and. &
!! .not. set0 >= set1 .and. .not. set0 >= set2 .and. .not. &
!! set1 >= set2 ) then
!! write(*,*) 'Passed 64 bit greater than or equals tests.'
!! else
!! error stop 'Failed 64 bit greater than or equals tests.'
!! end if
!! end program example_ge
!!```
elemental module function ge_large(set1, set2) result(ge)
logical :: ge
type(bitset_large), intent(in) :: set1, set2
end function ge_large
elemental module function ge_64(set1, set2) result(ge)
logical :: ge
type(bitset_64), intent(in) :: set1, set2
end function ge_64
end interface operator(>=)
interface operator(<)
!! Version: experimental
!!
!! Returns `.true.` if the bits in `set1` and `set2` differ and the
!! highest order different bit is set to 0 in `set1` and to 1 in `set2`,
!! `.false.` otherwise. The sets must have the same number of bits
!! otherwise the result is undefined.
!!([Specification](../page/specs/stdlib_bitsets.html#lt-compare-two-bitsets-to-determine-whether-the-first-is-less-than-the-other))
!!
!!#### Example
!!
!!```fortran
!! program example_lt
!! use stdlib_bitsets
!! type(bitset_64) :: set0, set1, set2
!! call set0 % init( 33 )
!! call set1 % init( 33 )
!! call set2 % init( 33 )
!! call set1 % set( 0 )
!! call set2 % set( 32 )
!! if ( set0 < set1 .and. set1 < set2 .and. set0 < set2 .and. &
!! .not. set0 < set0 .and. .not. set2 < set0 .and. .not. &
!! set2 < set1 ) then
!! write(*,*) 'Passed 64 bit less than tests.'
!! else
!! error stop 'Failed 64 bit less than tests.'
!! end if
!! end program example_lt
!!```
elemental module function lt_large(set1, set2) result(lt)
logical :: lt
type(bitset_large), intent(in) :: set1, set2
end function lt_large
elemental module function lt_64(set1, set2) result(lt)
logical :: lt
type(bitset_64), intent(in) :: set1, set2
end function lt_64
end interface operator(<)
interface operator(<=)
!! Version: experimental
!!
!! Returns `.true.` if the bits in `set1` and `set2` are the same or the
!! highest order different bit is set to 0 in `set1` and to 1 in `set2`,
!! `.false.` otherwise. The sets must have the same number of bits
!! otherwise the result is undefined.
!!([Specification](../page/specs/stdlib_bitsets.html#lt-compare-two-bitsets-to-determine-whether-the-first-is-less-than-or-equal-to-the-other))
!!
!!#### Example
!!
!!```fortran
!! program example_le
!! use stdlib_bitsets
!! type(bitset_64) :: set0, set1, set2
!! call set0 % init( 33 )
!! call set1 % init( 33 )
!! call set2 % init( 33 )
!! call set1 % set( 0 )
!! call set2 % set( 32 )
!! if ( set0 <= set1 .and. set1 <= set2 .and. set0 <= set2 .and. &
!! set0 <= set0 .and. set1 <= set1 .and. set2 <= set2 .and. &
!! .not. set1 <= set0 .and. .not. set2 <= set0 .and. .not. &
!! set2 <= set1 ) then
!! write(*,*) 'Passed 64 bit less than or equal tests.'
!! else
!! error stop 'Failed 64 bit less than or equal tests.'
!! end if
!! end program example_le
!!```
elemental module function le_large(set1, set2) result(le)
logical :: le
type(bitset_large), intent(in) :: set1, set2
end function le_large
elemental module function le_64(set1, set2) result(le)
logical :: le
type(bitset_64), intent(in) :: set1, set2
end function le_64
end interface operator(<=)
interface error_handler
module subroutine error_handler( message, error, status, &
module, procedure )
character(*), intent(in) :: message
integer, intent(in) :: error
integer, intent(out), optional :: status
character(*), intent(in), optional :: module
character(*), intent(in), optional :: procedure
end subroutine error_handler
end interface error_handler
contains
elemental function bits(self)
!! Version: experimental
!!
!! Returns the number of bit positions in `self`.
integer(bits_kind) :: bits
class(bitset_type), intent(in) :: self
bits = self % num_bits
return
end function bits
module subroutine error_handler( message, error, status, module, procedure )
character(*), intent(in) :: message
integer, intent(in) :: error
integer, intent(out), optional :: status
character(*), intent(in), optional :: module
character(*), intent(in), optional :: procedure
if ( present(status) ) then
status = error
else
if ( present(module) ) then
if ( present(procedure) ) then
write(error_unit, '(a)') trim(module) // ' % ' // &
trim(procedure) // ': ' // trim(message)
else
write(error_unit, '(a)') trim(module) // ' % N/A: ' // &
trim(message)
end if
else if ( present(procedure) ) then
write(error_unit, '(a)') trim(procedure) // ': ' // &
trim(message)
else
write(error_unit, '(a)') trim(message)
end if
select case(error)
case( alloc_fault )
error stop 'A memory allocation failed.'
case( array_size_invalid_error )
error stop "An array size was invalid."
case( char_string_invalid_error )
error stop "A character string had an invalid character."
case( char_string_too_large_error )
error stop "A character string was too large."
case( char_string_too_small_error )
error stop "A character string was too small."
case( eof_failure )
error stop "An End-Of-File failure occurred on a READ " // &
"statement."
case( index_invalid_error )
error stop "An index was invalid."
case( integer_overflow_error )
error stop "An integer overflow error occurred."
case( read_failure )
error stop "A failure occurred in a READ statement."
case( write_failure )
error stop "A failure occurred on a WRITE statement."
end select
end if
end subroutine error_handler
end module stdlib_bitsets
